peg: 'convention' -> convention-parser for Factor word names. In EBNF DSL, 'convention' is obviously still allowed.
Doug Coleman
parent
8e09ee0266
commit
be82224fe9
|
|
@ -14,7 +14,7 @@ IN: http.parsers
|
|||
: tspecial? ( ch -- ? )
|
||||
"()<>@,;:\\\"/[]?={} \t" member? ;
|
||||
|
||||
: 'token' ( -- parser )
|
||||
: token-parser ( -- parser )
|
||||
{ [ control? ] [ tspecial? ] } except-these repeat1 ;
|
||||
|
||||
: case-insensitive ( parser -- parser' )
|
||||
|
|
@ -23,157 +23,157 @@ IN: http.parsers
|
|||
: case-sensitive ( parser -- parser' )
|
||||
[ flatten >string ] action ;
|
||||
|
||||
: 'space' ( -- parser )
|
||||
: space-parser ( -- parser )
|
||||
[ " \t" member? ] satisfy repeat0 hide ;
|
||||
|
||||
: one-of ( strings -- parser )
|
||||
[ token ] map choice ;
|
||||
|
||||
: 'http-method' ( -- parser )
|
||||
: http-method-parser ( -- parser )
|
||||
{ "OPTIONS" "GET" "HEAD" "POST" "PUT" "DELETE" "TRACE" "CONNECT" } one-of ;
|
||||
|
||||
: 'url' ( -- parser )
|
||||
: url-parser ( -- parser )
|
||||
[ " \t\r\n" member? ] except repeat1 case-sensitive ;
|
||||
|
||||
: 'http-version' ( -- parser )
|
||||
: http-version-parser ( -- parser )
|
||||
[
|
||||
"HTTP" token hide ,
|
||||
'space' ,
|
||||
space-parser ,
|
||||
"/" token hide ,
|
||||
'space' ,
|
||||
space-parser ,
|
||||
"1" token ,
|
||||
"." token ,
|
||||
{ "0" "1" } one-of ,
|
||||
] seq* [ "" concat-as ] action ;
|
||||
|
||||
: 'full-request' ( -- parser )
|
||||
: full-request-parser ( -- parser )
|
||||
[
|
||||
'space' ,
|
||||
'http-method' ,
|
||||
'space' ,
|
||||
'url' ,
|
||||
'space' ,
|
||||
'http-version' ,
|
||||
'space' ,
|
||||
space-parser ,
|
||||
http-method-parser ,
|
||||
space-parser ,
|
||||
url-parser ,
|
||||
space-parser ,
|
||||
http-version-parser ,
|
||||
space-parser ,
|
||||
] seq* ;
|
||||
|
||||
: 'simple-request' ( -- parser )
|
||||
: simple-request-parser ( -- parser )
|
||||
[
|
||||
'space' ,
|
||||
space-parser ,
|
||||
"GET" token ,
|
||||
'space' ,
|
||||
'url' ,
|
||||
'space' ,
|
||||
space-parser ,
|
||||
url-parser ,
|
||||
space-parser ,
|
||||
] seq* [ "1.0" suffix! ] action ;
|
||||
|
||||
PEG: parse-request-line ( string -- triple )
|
||||
#! Triple is { method url version }
|
||||
'full-request' 'simple-request' 2array choice ;
|
||||
full-request-parser simple-request-parser 2array choice ;
|
||||
|
||||
: 'text' ( -- parser )
|
||||
: text-parser ( -- parser )
|
||||
[ control? ] except ;
|
||||
|
||||
: 'response-code' ( -- parser )
|
||||
: response-code-parser ( -- parser )
|
||||
[ digit? ] satisfy 3 exactly-n [ string>number ] action ;
|
||||
|
||||
: 'response-message' ( -- parser )
|
||||
'text' repeat0 case-sensitive ;
|
||||
: response-message-parser ( -- parser )
|
||||
text-parser repeat0 case-sensitive ;
|
||||
|
||||
PEG: parse-response-line ( string -- triple )
|
||||
#! Triple is { version code message }
|
||||
[
|
||||
'space' ,
|
||||
'http-version' ,
|
||||
'space' ,
|
||||
'response-code' ,
|
||||
'space' ,
|
||||
'response-message' ,
|
||||
space-parser ,
|
||||
http-version-parser ,
|
||||
space-parser ,
|
||||
response-code-parser ,
|
||||
space-parser ,
|
||||
response-message-parser ,
|
||||
] seq* just ;
|
||||
|
||||
: 'crlf' ( -- parser )
|
||||
: crlf-parser ( -- parser )
|
||||
"\r\n" token ;
|
||||
|
||||
: 'lws' ( -- parser )
|
||||
: lws-parser ( -- parser )
|
||||
[ " \t" member? ] satisfy repeat1 ;
|
||||
|
||||
: 'qdtext' ( -- parser )
|
||||
: qdtext-parser ( -- parser )
|
||||
{ [ CHAR: " = ] [ control? ] } except-these ;
|
||||
|
||||
: 'quoted-char' ( -- parser )
|
||||
: quoted-char-parser ( -- parser )
|
||||
"\\" token hide any-char 2seq ;
|
||||
|
||||
: 'quoted-string' ( -- parser )
|
||||
'quoted-char' 'qdtext' 2choice repeat0 "\"" "\"" surrounded-by ;
|
||||
: quoted-string-parser ( -- parser )
|
||||
quoted-char-parser qdtext-parser 2choice repeat0 "\"" "\"" surrounded-by ;
|
||||
|
||||
: 'ctext' ( -- parser )
|
||||
: ctext-parser ( -- parser )
|
||||
{ [ control? ] [ "()" member? ] } except-these ;
|
||||
|
||||
: 'comment' ( -- parser )
|
||||
'ctext' 'comment' 2choice repeat0 "(" ")" surrounded-by ;
|
||||
: comment-parser ( -- parser )
|
||||
ctext-parser comment-parser 2choice repeat0 "(" ")" surrounded-by ;
|
||||
|
||||
: 'field-name' ( -- parser )
|
||||
'token' case-insensitive ;
|
||||
: field-name-parser ( -- parser )
|
||||
token-parser case-insensitive ;
|
||||
|
||||
: 'field-content' ( -- parser )
|
||||
'quoted-string' case-sensitive
|
||||
'text' repeat0 case-sensitive
|
||||
: field-content-parser ( -- parser )
|
||||
quoted-string-parser case-sensitive
|
||||
text-parser repeat0 case-sensitive
|
||||
2choice ;
|
||||
|
||||
PEG: parse-header-line ( string -- pair )
|
||||
#! Pair is either { name value } or { f value }. If f, its a
|
||||
#! continuation of the previous header line.
|
||||
[
|
||||
'field-name' ,
|
||||
'space' ,
|
||||
field-name-parser ,
|
||||
space-parser ,
|
||||
":" token hide ,
|
||||
'space' ,
|
||||
'field-content' ,
|
||||
space-parser ,
|
||||
field-content-parser ,
|
||||
] seq*
|
||||
[
|
||||
'lws' [ drop f ] action ,
|
||||
'field-content' ,
|
||||
lws-parser [ drop f ] action ,
|
||||
field-content-parser ,
|
||||
] seq*
|
||||
2choice ;
|
||||
|
||||
: 'word' ( -- parser )
|
||||
'token' 'quoted-string' 2choice ;
|
||||
: word-parser ( -- parser )
|
||||
token-parser quoted-string-parser 2choice ;
|
||||
|
||||
: 'value' ( -- parser )
|
||||
'quoted-string'
|
||||
: value-parser ( -- parser )
|
||||
quoted-string-parser
|
||||
[ ";" member? ] except repeat0
|
||||
2choice case-sensitive ;
|
||||
|
||||
: 'attr' ( -- parser )
|
||||
'token' case-sensitive ;
|
||||
: attr-parser ( -- parser )
|
||||
token-parser case-sensitive ;
|
||||
|
||||
: 'av-pair' ( -- parser )
|
||||
: av-pair-parser ( -- parser )
|
||||
[
|
||||
'space' ,
|
||||
'attr' ,
|
||||
'space' ,
|
||||
[ "=" token , 'space' , 'value' , ] seq* [ last ] action optional ,
|
||||
'space' ,
|
||||
space-parser ,
|
||||
attr-parser ,
|
||||
space-parser ,
|
||||
[ "=" token , space-parser , value-parser , ] seq* [ last ] action optional ,
|
||||
space-parser ,
|
||||
] seq* ;
|
||||
|
||||
: 'av-pairs' ( -- parser )
|
||||
'av-pair' ";" token list-of optional ;
|
||||
: av-pairs-parser ( -- parser )
|
||||
av-pair-parser ";" token list-of optional ;
|
||||
|
||||
PEG: (parse-set-cookie) ( string -- alist )
|
||||
'av-pairs' just [ sift ] action ;
|
||||
av-pairs-parser just [ sift ] action ;
|
||||
|
||||
: 'cookie-value' ( -- parser )
|
||||
: cookie-value-parser ( -- parser )
|
||||
[
|
||||
'space' ,
|
||||
'attr' ,
|
||||
'space' ,
|
||||
space-parser ,
|
||||
attr-parser ,
|
||||
space-parser ,
|
||||
"=" token hide ,
|
||||
'space' ,
|
||||
'value' ,
|
||||
'space' ,
|
||||
space-parser ,
|
||||
value-parser ,
|
||||
space-parser ,
|
||||
] seq*
|
||||
[ ";,=" member? not ] satisfy repeat0 [ drop f ] action
|
||||
2choice ;
|
||||
|
||||
PEG: (parse-cookie) ( string -- alist )
|
||||
'cookie-value' [ ";," member? ] satisfy list-of
|
||||
cookie-value-parser [ ";," member? ] satisfy list-of
|
||||
optional just [ sift ] action ;
|
||||
|
|
|
|||
|
|
@ -13,44 +13,44 @@ TUPLE: log-entry date level word-name message ;
|
|||
|
||||
SYMBOL: multiline
|
||||
|
||||
: 'date' ( -- parser )
|
||||
: date-parser ( -- parser )
|
||||
[ "]" member? not ] string-of [
|
||||
dup multiline-header =
|
||||
[ drop multiline ] [ rfc3339>timestamp ] if
|
||||
] action
|
||||
"[" "]" surrounded-by ;
|
||||
|
||||
: 'log-level' ( -- parser )
|
||||
: log-level-parser ( -- parser )
|
||||
log-levels keys [
|
||||
[ name>> token ] keep [ nip ] curry action
|
||||
] map choice ;
|
||||
|
||||
: 'word-name' ( -- parser )
|
||||
: word-name-parser ( -- parser )
|
||||
[ " :" member? not ] string-of ;
|
||||
|
||||
SYMBOL: malformed
|
||||
|
||||
: 'malformed-line' ( -- parser )
|
||||
: malformed-line-parser ( -- parser )
|
||||
[ drop t ] string-of
|
||||
[ log-entry new swap >>message malformed >>level ] action ;
|
||||
|
||||
: 'log-message' ( -- parser )
|
||||
: log-message-parser ( -- parser )
|
||||
[ drop t ] string-of
|
||||
[ 1vector ] action ;
|
||||
|
||||
: 'log-line' ( -- parser )
|
||||
: log-line-parser ( -- parser )
|
||||
[
|
||||
'date' ,
|
||||
date-parser ,
|
||||
" " token hide ,
|
||||
'log-level' ,
|
||||
log-level-parser ,
|
||||
" " token hide ,
|
||||
'word-name' ,
|
||||
word-name-parser ,
|
||||
": " token hide ,
|
||||
'log-message' ,
|
||||
log-message-parser ,
|
||||
] seq* [ first4 log-entry boa ] action
|
||||
'malformed-line' 2choice ;
|
||||
malformed-line-parser 2choice ;
|
||||
|
||||
PEG: parse-log-line ( string -- entry ) 'log-line' ;
|
||||
PEG: parse-log-line ( string -- entry ) log-line-parser ;
|
||||
|
||||
: malformed? ( line -- ? )
|
||||
level>> malformed eq? ;
|
||||
|
|
|
|||
|
|
@ -7,11 +7,11 @@ namespaces arrays strings eval unicode.data multiline ;
|
|||
IN: peg.ebnf.tests
|
||||
|
||||
{ T{ ebnf-non-terminal f "abc" } } [
|
||||
"abc" 'non-terminal' parse
|
||||
"abc" non-terminal-parser parse
|
||||
] unit-test
|
||||
|
||||
{ T{ ebnf-terminal f "55" } } [
|
||||
"'55'" 'terminal' parse
|
||||
"'55'" terminal-parser parse
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
|
@ -22,7 +22,7 @@ IN: peg.ebnf.tests
|
|||
}
|
||||
}
|
||||
} [
|
||||
"digit = '1' | '2'" 'rule' parse
|
||||
"digit = '1' | '2'" rule-parser parse
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
|
@ -33,7 +33,7 @@ IN: peg.ebnf.tests
|
|||
}
|
||||
}
|
||||
} [
|
||||
"digit = '1' '2'" 'rule' parse
|
||||
"digit = '1' '2'" rule-parser parse
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
|
@ -46,7 +46,7 @@ IN: peg.ebnf.tests
|
|||
}
|
||||
}
|
||||
} [
|
||||
"one two | three" 'choice' parse
|
||||
"one two | three" choice-parser parse
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
|
@ -61,7 +61,7 @@ IN: peg.ebnf.tests
|
|||
}
|
||||
}
|
||||
} [
|
||||
"one {two | three}" 'choice' parse
|
||||
"one {two | three}" choice-parser parse
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
|
@ -81,7 +81,7 @@ IN: peg.ebnf.tests
|
|||
}
|
||||
}
|
||||
} [
|
||||
"one ((two | three) four)*" 'choice' parse
|
||||
"one ((two | three) four)*" choice-parser parse
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
|
@ -101,7 +101,7 @@ IN: peg.ebnf.tests
|
|||
}
|
||||
}
|
||||
} [
|
||||
"one ((two | three) four)~" 'choice' parse
|
||||
"one ((two | three) four)~" choice-parser parse
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
|
@ -113,23 +113,23 @@ IN: peg.ebnf.tests
|
|||
}
|
||||
}
|
||||
} [
|
||||
"one ( two )? three" 'choice' parse
|
||||
"one ( two )? three" choice-parser parse
|
||||
] unit-test
|
||||
|
||||
{ "foo" } [
|
||||
"\"foo\"" 'identifier' parse
|
||||
"\"foo\"" identifier-parser parse
|
||||
] unit-test
|
||||
|
||||
{ "foo" } [
|
||||
"'foo'" 'identifier' parse
|
||||
"'foo'" identifier-parser parse
|
||||
] unit-test
|
||||
|
||||
{ "foo" } [
|
||||
"foo" 'non-terminal' parse symbol>>
|
||||
"foo" non-terminal-parser parse symbol>>
|
||||
] unit-test
|
||||
|
||||
{ "foo" } [
|
||||
"foo]" 'non-terminal' parse symbol>>
|
||||
"foo]" non-terminal-parser parse symbol>>
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "b" } } [
|
||||
|
|
@ -272,7 +272,7 @@ IN: peg.ebnf.tests
|
|||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"abcd='9' | ('8'):x => [[ x ]]" 'ebnf' (parse) remaining>> empty?
|
||||
"abcd='9' | ('8'):x => [[ x ]]" ebnf-parser (parse) remaining>> empty?
|
||||
] unit-test
|
||||
|
||||
EBNF: primary
|
||||
|
|
@ -431,29 +431,29 @@ main = Primary
|
|||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"number=(digit)+:n 'a'" 'ebnf' (parse) remaining>> length zero?
|
||||
"number=(digit)+:n 'a'" ebnf-parser (parse) remaining>> length zero?
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"number=(digit)+ 'a'" 'ebnf' (parse) remaining>> length zero?
|
||||
"number=(digit)+ 'a'" ebnf-parser (parse) remaining>> length zero?
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"number=digit+ 'a'" 'ebnf' (parse) remaining>> length zero?
|
||||
"number=digit+ 'a'" ebnf-parser (parse) remaining>> length zero?
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"number=digit+:n 'a'" 'ebnf' (parse) remaining>> length zero?
|
||||
"number=digit+:n 'a'" ebnf-parser (parse) remaining>> length zero?
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"foo=(name):n !(keyword) => [[ n ]]" 'rule' parse
|
||||
"foo=name:n !(keyword) => [[ n ]]" 'rule' parse =
|
||||
"foo=(name):n !(keyword) => [[ n ]]" rule-parser parse
|
||||
"foo=name:n !(keyword) => [[ n ]]" rule-parser parse =
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"foo=!(keyword) (name):n => [[ n ]]" 'rule' parse
|
||||
"foo=!(keyword) name:n => [[ n ]]" 'rule' parse =
|
||||
"foo=!(keyword) (name):n => [[ n ]]" rule-parser parse
|
||||
"foo=!(keyword) name:n => [[ n ]]" rule-parser parse =
|
||||
] unit-test
|
||||
|
||||
<<
|
||||
|
|
@ -501,7 +501,7 @@ foo=<foreign any-char> 'd'
|
|||
{ t } [
|
||||
#! Rule lookup occurs in a namespace. This causes an incorrect duplicate rule
|
||||
#! if a var in a namespace is set. This unit test is to remind me to fix this.
|
||||
[ "fail" "foo" set "foo='a'" 'ebnf' parse transform drop t ] with-scope
|
||||
[ "fail" "foo" set "foo='a'" ebnf-parser parse transform drop t ] with-scope
|
||||
] unit-test
|
||||
|
||||
#! Tokenizer tests
|
||||
|
|
|
|||
|
|
@ -103,7 +103,7 @@ C: <ebnf> ebnf
|
|||
token sp hide ;
|
||||
|
||||
: syntax-pack ( begin parser end -- parser )
|
||||
#! Parse 'parser' surrounded by syntax elements
|
||||
#! Parse parser-parser surrounded by syntax elements
|
||||
#! begin and end.
|
||||
[ syntax ] 2dip syntax pack ;
|
||||
|
||||
|
|
@ -114,7 +114,7 @@ C: <ebnf> ebnf
|
|||
"\r" token [ drop "\\r" ] action ,
|
||||
] choice* replace ;
|
||||
|
||||
: 'identifier' ( -- parser )
|
||||
: identifier-parser ( -- parser )
|
||||
#! Return a parser that parses an identifer delimited by
|
||||
#! a quotation character. The quotation can be single
|
||||
#! or double quotes. The AST produced is the identifier
|
||||
|
|
@ -124,7 +124,7 @@ C: <ebnf> ebnf
|
|||
[ CHAR: ' = not ] satisfy repeat1 "'" "'" surrounded-by ,
|
||||
] choice* [ >string unescape-string ] action ;
|
||||
|
||||
: 'non-terminal' ( -- parser )
|
||||
: non-terminal-parser ( -- parser )
|
||||
#! A non-terminal is the name of another rule. It can
|
||||
#! be any non-blank character except for characters used
|
||||
#! in the EBNF syntax itself.
|
||||
|
|
@ -154,12 +154,12 @@ C: <ebnf> ebnf
|
|||
} 1|| not
|
||||
] satisfy repeat1 [ >string <ebnf-non-terminal> ] action ;
|
||||
|
||||
: 'terminal' ( -- parser )
|
||||
: terminal-parser ( -- parser )
|
||||
#! A terminal is an identifier enclosed in quotations
|
||||
#! and it represents the literal value of the identifier.
|
||||
'identifier' [ <ebnf-terminal> ] action ;
|
||||
identifier-parser [ <ebnf-terminal> ] action ;
|
||||
|
||||
: 'foreign-name' ( -- parser )
|
||||
: foreign-name-parser ( -- parser )
|
||||
#! Parse a valid foreign parser name
|
||||
[
|
||||
{
|
||||
|
|
@ -168,20 +168,20 @@ C: <ebnf> ebnf
|
|||
} 1|| not
|
||||
] satisfy repeat1 [ >string ] action ;
|
||||
|
||||
: 'foreign' ( -- parser )
|
||||
: foreign-parser ( -- parser )
|
||||
#! A foreign call is a call to a rule in another ebnf grammar
|
||||
[
|
||||
"<foreign" syntax ,
|
||||
'foreign-name' sp ,
|
||||
'foreign-name' sp optional ,
|
||||
foreign-name-parser sp ,
|
||||
foreign-name-parser sp optional ,
|
||||
">" syntax ,
|
||||
] seq* [ first2 <ebnf-foreign> ] action ;
|
||||
|
||||
: 'any-character' ( -- parser )
|
||||
: any-character-parser ( -- parser )
|
||||
#! A parser to match the symbol for any character match.
|
||||
[ CHAR: . = ] satisfy [ drop <ebnf-any-character> ] action ;
|
||||
|
||||
: 'range-parser' ( -- parser )
|
||||
: range-parser-parser ( -- parser )
|
||||
#! Match the syntax for declaring character ranges
|
||||
[
|
||||
[ "[" syntax , "[" token ensure-not , ] seq* hide ,
|
||||
|
|
@ -189,7 +189,7 @@ C: <ebnf> ebnf
|
|||
"]" syntax ,
|
||||
] seq* [ first >string unescape-string <ebnf-range> ] action ;
|
||||
|
||||
: ('element') ( -- parser )
|
||||
: (element-parser) ( -- parser )
|
||||
#! An element of a rule. It can be a terminal or a
|
||||
#! non-terminal but must not be followed by a "=".
|
||||
#! The latter indicates that it is the beginning of a
|
||||
|
|
@ -197,11 +197,11 @@ C: <ebnf> ebnf
|
|||
[
|
||||
[
|
||||
[
|
||||
'non-terminal' ,
|
||||
'terminal' ,
|
||||
'foreign' ,
|
||||
'range-parser' ,
|
||||
'any-character' ,
|
||||
non-terminal-parser ,
|
||||
terminal-parser ,
|
||||
foreign-parser ,
|
||||
range-parser-parser ,
|
||||
any-character-parser ,
|
||||
] choice*
|
||||
[ dup , "~" token hide , ] seq* [ first <ebnf-ignore> ] action ,
|
||||
[ dup , "*" token hide , ] seq* [ first <ebnf-repeat0> ] action ,
|
||||
|
|
@ -215,19 +215,19 @@ C: <ebnf> ebnf
|
|||
] choice* ,
|
||||
] seq* [ first ] action ;
|
||||
|
||||
DEFER: 'action'
|
||||
DEFER: action-parser
|
||||
|
||||
: 'element' ( -- parser )
|
||||
: element-parser ( -- parser )
|
||||
[
|
||||
[
|
||||
('element') , ":" syntax ,
|
||||
(element-parser) , ":" syntax ,
|
||||
"a-zA-Z_" range-pattern
|
||||
"a-zA-Z0-9_-" range-pattern repeat1 2seq [ first2 swap prefix >string ] action ,
|
||||
] seq* [ first2 <ebnf-var> ] action ,
|
||||
('element') ,
|
||||
(element-parser) ,
|
||||
] choice* ;
|
||||
|
||||
DEFER: 'choice'
|
||||
DEFER: choice-parser
|
||||
|
||||
: grouped ( quot suffix -- parser )
|
||||
#! Parse a group of choices, with a suffix indicating
|
||||
|
|
@ -235,15 +235,15 @@ DEFER: 'choice'
|
|||
#! an quot that is the action that produces the AST.
|
||||
2dup
|
||||
[
|
||||
"(" [ 'choice' sp ] delay ")" syntax-pack
|
||||
"(" [ choice-parser sp ] delay ")" syntax-pack
|
||||
swap 2seq
|
||||
[ first ] rot compose action ,
|
||||
"{" [ 'choice' sp ] delay "}" syntax-pack
|
||||
"{" [ choice-parser sp ] delay "}" syntax-pack
|
||||
swap 2seq
|
||||
[ first <ebnf-whitespace> ] rot compose action ,
|
||||
] choice* ;
|
||||
|
||||
: 'group' ( -- parser )
|
||||
: group-parser ( -- parser )
|
||||
#! A grouping with no suffix. Used for precedence.
|
||||
[ ] [
|
||||
"~" token sp ensure-not ,
|
||||
|
|
@ -252,115 +252,115 @@ DEFER: 'choice'
|
|||
"?" token sp ensure-not ,
|
||||
] seq* hide grouped ;
|
||||
|
||||
: 'ignore' ( -- parser )
|
||||
: ignore-parser ( -- parser )
|
||||
[ <ebnf-ignore> ] "~" syntax grouped ;
|
||||
|
||||
: 'repeat0' ( -- parser )
|
||||
: repeat0-parser ( -- parser )
|
||||
[ <ebnf-repeat0> ] "*" syntax grouped ;
|
||||
|
||||
: 'repeat1' ( -- parser )
|
||||
: repeat1-parser ( -- parser )
|
||||
[ <ebnf-repeat1> ] "+" syntax grouped ;
|
||||
|
||||
: 'optional' ( -- parser )
|
||||
: optional-parser ( -- parser )
|
||||
[ <ebnf-optional> ] "?" syntax grouped ;
|
||||
|
||||
: 'factor-code' ( -- parser )
|
||||
: factor-code-parser ( -- parser )
|
||||
[
|
||||
"]]" token ensure-not ,
|
||||
"]?" token ensure-not ,
|
||||
[ drop t ] satisfy ,
|
||||
] seq* repeat0 [ "" concat-as ] action ;
|
||||
|
||||
: 'ensure-not' ( -- parser )
|
||||
: ensure-not-parser ( -- parser )
|
||||
#! Parses the '!' syntax to ensure that
|
||||
#! something that matches the following elements do
|
||||
#! not exist in the parse stream.
|
||||
[
|
||||
"!" syntax ,
|
||||
'group' sp ,
|
||||
group-parser sp ,
|
||||
] seq* [ first <ebnf-ensure-not> ] action ;
|
||||
|
||||
: 'ensure' ( -- parser )
|
||||
: ensure-parser ( -- parser )
|
||||
#! Parses the '&' syntax to ensure that
|
||||
#! something that matches the following elements does
|
||||
#! exist in the parse stream.
|
||||
[
|
||||
"&" syntax ,
|
||||
'group' sp ,
|
||||
group-parser sp ,
|
||||
] seq* [ first <ebnf-ensure> ] action ;
|
||||
|
||||
: ('sequence') ( -- parser )
|
||||
: (sequence-parser) ( -- parser )
|
||||
#! A sequence of terminals and non-terminals, including
|
||||
#! groupings of those.
|
||||
[
|
||||
[
|
||||
'ensure-not' sp ,
|
||||
'ensure' sp ,
|
||||
'element' sp ,
|
||||
'group' sp ,
|
||||
'ignore' sp ,
|
||||
'repeat0' sp ,
|
||||
'repeat1' sp ,
|
||||
'optional' sp ,
|
||||
ensure-not-parser sp ,
|
||||
ensure-parser sp ,
|
||||
element-parser sp ,
|
||||
group-parser sp ,
|
||||
ignore-parser sp ,
|
||||
repeat0-parser sp ,
|
||||
repeat1-parser sp ,
|
||||
optional-parser sp ,
|
||||
] choice*
|
||||
[ dup , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 <ebnf-var> ] action ,
|
||||
,
|
||||
] choice* ;
|
||||
|
||||
: 'action' ( -- parser )
|
||||
"[[" 'factor-code' "]]" syntax-pack ;
|
||||
: action-parser ( -- parser )
|
||||
"[[" factor-code-parser "]]" syntax-pack ;
|
||||
|
||||
: 'semantic' ( -- parser )
|
||||
"?[" 'factor-code' "]?" syntax-pack ;
|
||||
: semantic-parser ( -- parser )
|
||||
"?[" factor-code-parser "]?" syntax-pack ;
|
||||
|
||||
: 'sequence' ( -- parser )
|
||||
: sequence-parser ( -- parser )
|
||||
#! A sequence of terminals and non-terminals, including
|
||||
#! groupings of those.
|
||||
[
|
||||
[ ('sequence') , 'action' , ] seq*
|
||||
[ (sequence-parser) , action-parser , ] seq*
|
||||
[ first2 <ebnf-action> ] action ,
|
||||
|
||||
[ ('sequence') , 'semantic' , ] seq*
|
||||
[ (sequence-parser) , semantic-parser , ] seq*
|
||||
[ first2 <ebnf-semantic> ] action ,
|
||||
|
||||
('sequence') ,
|
||||
(sequence-parser) ,
|
||||
] choice* repeat1 [
|
||||
dup length 1 = [ first ] [ <ebnf-sequence> ] if
|
||||
] action ;
|
||||
|
||||
: 'actioned-sequence' ( -- parser )
|
||||
: actioned-sequence-parser ( -- parser )
|
||||
[
|
||||
[ 'sequence' , "=>" syntax , 'action' , ] seq*
|
||||
[ sequence-parser , "=>" syntax , action-parser , ] seq*
|
||||
[ first2 <ebnf-action> ] action ,
|
||||
'sequence' ,
|
||||
sequence-parser ,
|
||||
] choice* ;
|
||||
|
||||
: 'choice' ( -- parser )
|
||||
'actioned-sequence' sp repeat1 [
|
||||
: choice-parser ( -- parser )
|
||||
actioned-sequence-parser sp repeat1 [
|
||||
dup length 1 = [ first ] [ <ebnf-sequence> ] if
|
||||
] action "|" token sp list-of [
|
||||
dup length 1 = [ first ] [ <ebnf-choice> ] if
|
||||
] action ;
|
||||
|
||||
: 'tokenizer' ( -- parser )
|
||||
: tokenizer-parser ( -- parser )
|
||||
[
|
||||
"tokenizer" syntax ,
|
||||
"=" syntax ,
|
||||
">" token ensure-not ,
|
||||
[ "default" token sp , 'choice' , ] choice* ,
|
||||
[ "default" token sp , choice-parser , ] choice* ,
|
||||
] seq* [ first <ebnf-tokenizer> ] action ;
|
||||
|
||||
: 'rule' ( -- parser )
|
||||
: rule-parser ( -- parser )
|
||||
[
|
||||
"tokenizer" token ensure-not ,
|
||||
'non-terminal' [ symbol>> ] action ,
|
||||
non-terminal-parser [ symbol>> ] action ,
|
||||
"=" syntax ,
|
||||
">" token ensure-not ,
|
||||
'choice' ,
|
||||
choice-parser ,
|
||||
] seq* [ first2 <ebnf-rule> ] action ;
|
||||
|
||||
: 'ebnf' ( -- parser )
|
||||
[ 'tokenizer' sp , 'rule' sp , ] choice* repeat1 [ <ebnf> ] action ;
|
||||
: ebnf-parser ( -- parser )
|
||||
[ tokenizer-parser sp , rule-parser sp , ] choice* repeat1 [ <ebnf> ] action ;
|
||||
|
||||
GENERIC: (transform) ( ast -- parser )
|
||||
|
||||
|
|
@ -530,7 +530,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
|
|||
] [ ] make box ;
|
||||
|
||||
: transform-ebnf ( string -- object )
|
||||
'ebnf' parse transform ;
|
||||
ebnf-parser parse transform ;
|
||||
|
||||
ERROR: unable-to-fully-parse-ebnf remaining ;
|
||||
|
||||
|
|
@ -546,7 +546,7 @@ ERROR: could-not-parse-ebnf ;
|
|||
] if* ;
|
||||
|
||||
: parse-ebnf ( string -- hashtable )
|
||||
'ebnf' (parse) check-parse-result ast>> transform ;
|
||||
ebnf-parser (parse) check-parse-result ast>> transform ;
|
||||
|
||||
: ebnf>quot ( string -- hashtable quot )
|
||||
parse-ebnf dup dup parser [ main of compile ] with-variable
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ HELP: 1token
|
|||
"Calls 1string on a character and returns a parser that matches that character."
|
||||
} { $examples
|
||||
{ $example "USING: peg peg.parsers prettyprint ;" "\"a\" CHAR: a 1token parse ." "\"a\"" }
|
||||
} { $see-also 'string' } ;
|
||||
} { $see-also string-parser } ;
|
||||
|
||||
HELP: (list-of)
|
||||
{ $values
|
||||
|
|
@ -124,7 +124,7 @@ HELP: pack
|
|||
} { $description
|
||||
"Returns a parser that parses the begin, body, and end parsers in order. The begin and end parsers are hidden."
|
||||
} { $examples
|
||||
{ $example "USING: peg peg.parsers prettyprint ;" "\"hi123bye\" \"hi\" token 'integer' \"bye\" token pack parse ." "123" }
|
||||
{ $example "USING: peg peg.parsers prettyprint ;" "\"hi123bye\" \"hi\" token integer-parser \"bye\" token pack parse ." "123" }
|
||||
} { $see-also surrounded-by } ;
|
||||
|
||||
HELP: surrounded-by
|
||||
|
|
@ -136,29 +136,29 @@ HELP: surrounded-by
|
|||
} { $description
|
||||
"Calls token on begin and end to make them into string parsers. Returns a parser that parses the begin, body, and end parsers in order. The begin and end parsers are hidden."
|
||||
} { $examples
|
||||
{ $example "USING: peg peg.parsers prettyprint ;" "\"hi123bye\" 'integer' \"hi\" \"bye\" surrounded-by parse ." "123" }
|
||||
{ $example "USING: peg peg.parsers prettyprint ;" "\"hi123bye\" integer-parser \"hi\" \"bye\" surrounded-by parse ." "123" }
|
||||
} { $see-also pack } ;
|
||||
|
||||
HELP: 'digit'
|
||||
HELP: digit-parser
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
} { $description
|
||||
"Returns a parser that matches a single digit as defined by the " { $link digit? } " word."
|
||||
} { $see-also 'integer' } ;
|
||||
} { $see-also integer-parser } ;
|
||||
|
||||
HELP: 'integer'
|
||||
HELP: integer-parser
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
} { $description
|
||||
"Returns a parser that matches an integer composed of digits, as defined by the " { $link 'digit' } " word."
|
||||
} { $see-also 'digit' 'string' } ;
|
||||
"Returns a parser that matches an integer composed of digits, as defined by the " { $link digit-parser } " word."
|
||||
} { $see-also digit-parser string-parser } ;
|
||||
|
||||
HELP: 'string'
|
||||
HELP: string-parser
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
} { $description
|
||||
"Returns a parser that matches an string composed of a \", anything that is not \", and another \"."
|
||||
} { $see-also 'integer' } ;
|
||||
} { $see-also integer-parser } ;
|
||||
|
||||
HELP: range-pattern
|
||||
{ $values
|
||||
|
|
|
|||
|
|
@ -62,18 +62,18 @@ PRIVATE>
|
|||
[ flatten-vectors ] action ;
|
||||
|
||||
: pack ( begin body end -- parser )
|
||||
[ hide ] 2dip hide 3seq [ first ] action ;
|
||||
[ hide ] [ ] [ hide ] tri* 3seq [ first ] action ;
|
||||
|
||||
: surrounded-by ( parser begin end -- parser' )
|
||||
[ token ] bi@ swapd pack ;
|
||||
|
||||
: 'digit' ( -- parser )
|
||||
: digit-parser ( -- parser )
|
||||
[ digit? ] satisfy [ digit> ] action ;
|
||||
|
||||
: 'integer' ( -- parser )
|
||||
: integer-parser ( -- parser )
|
||||
[ digit? ] satisfy repeat1 [ string>number ] action ;
|
||||
|
||||
: 'string' ( -- parser )
|
||||
: string-parser ( -- parser )
|
||||
[
|
||||
[ CHAR: " = ] satisfy hide ,
|
||||
[ CHAR: " = not ] satisfy repeat0 ,
|
||||
|
|
|
|||
|
|
@ -24,8 +24,8 @@ HELP: search
|
|||
"parser."
|
||||
}
|
||||
|
||||
{ $example "USING: peg.parsers peg.search prettyprint ;" "\"one 123 two 456\" 'integer' search ." "V{ 123 456 }" }
|
||||
{ $example "USING: peg peg.parsers peg.search prettyprint ;" "\"one 123 \\\"hello\\\" two 456\" 'integer' 'string' 2choice search ." "V{ 123 \"hello\" 456 }" }
|
||||
{ $example "USING: peg.parsers peg.search prettyprint ;" "\"one 123 two 456\" integer-parser search ." "V{ 123 456 }" }
|
||||
{ $example "USING: peg peg.parsers peg.search prettyprint ;" "\"one 123 \\\"hello\\\" two 456\" integer-parser string-parser 2choice search ." "V{ 123 \"hello\" 456 }" }
|
||||
{ $see-also replace } ;
|
||||
|
||||
HELP: replace
|
||||
|
|
@ -39,5 +39,5 @@ HELP: replace
|
|||
"successfully parse with the given parser replaced with "
|
||||
"the result of that parser."
|
||||
}
|
||||
{ $example "USING: math math.parser peg peg.parsers peg.search prettyprint ;" "\"one 123 two 456\" 'integer' [ 2 * number>string ] action replace ." "\"one 246 two 912\"" }
|
||||
{ $example "USING: math math.parser peg peg.parsers peg.search prettyprint ;" "\"one 123 two 456\" integer-parser [ 2 * number>string ] action replace ." "\"one 246 two 912\"" }
|
||||
{ $see-also search } ;
|
||||
|
|
|
|||
|
|
@ -6,13 +6,13 @@ peg.search ;
|
|||
IN: peg.search.tests
|
||||
|
||||
{ V{ 123 456 } } [
|
||||
"abc 123 def 456" 'integer' search
|
||||
"abc 123 def 456" integer-parser search
|
||||
] unit-test
|
||||
|
||||
{ V{ 123 "hello" 456 } } [
|
||||
"one 123 \"hello\" two 456" 'integer' 'string' 2array choice search
|
||||
"one 123 \"hello\" two 456" integer-parser string-parser 2array choice search
|
||||
] unit-test
|
||||
|
||||
{ "abc 246 def 912" } [
|
||||
"abc 123 def 456" 'integer' [ 2 * number>string ] action replace
|
||||
"abc 123 def 456" integer-parser [ 2 * number>string ] action replace
|
||||
] unit-test
|
||||
|
|
|
|||
Loading…
Reference in New Issue