steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

peg: 'convention' -> convention-parser for Factor word names. In EBNF DSL, 'convention' is obviously still allowed.

db4
Doug Coleman 2015-08-15 18:10:13 -07:00
parent 8e09ee0266
commit be82224fe9
8 changed files with 194 additions and 194 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

148
basis/http/parsers/parsers.factor
View File

@ -14,7 +14,7 @@ IN: http.parsers
: tspecial? ( ch -- ? ) : tspecial? ( ch -- ? )
"()<>@,;:\\\"/[]?={} \t" member? ; "()<>@,;:\\\"/[]?={} \t" member? ;
: 'token' ( -- parser ) : token-parser ( -- parser )
{ [ control? ] [ tspecial? ] } except-these repeat1 ; { [ control? ] [ tspecial? ] } except-these repeat1 ;
: case-insensitive ( parser -- parser' ) : case-insensitive ( parser -- parser' )
@ -23,157 +23,157 @@ IN: http.parsers
: case-sensitive ( parser -- parser' ) : case-sensitive ( parser -- parser' )
[ flatten >string ] action ; [ flatten >string ] action ;
: 'space' ( -- parser ) : space-parser ( -- parser )
[ " \t" member? ] satisfy repeat0 hide ; [ " \t" member? ] satisfy repeat0 hide ;
: one-of ( strings -- parser ) : one-of ( strings -- parser )
[ token ] map choice ; [ token ] map choice ;
: 'http-method' ( -- parser ) : http-method-parser ( -- parser )
{ "OPTIONS" "GET" "HEAD" "POST" "PUT" "DELETE" "TRACE" "CONNECT" } one-of ; { "OPTIONS" "GET" "HEAD" "POST" "PUT" "DELETE" "TRACE" "CONNECT" } one-of ;
: 'url' ( -- parser ) : url-parser ( -- parser )
[ " \t\r\n" member? ] except repeat1 case-sensitive ; [ " \t\r\n" member? ] except repeat1 case-sensitive ;
: 'http-version' ( -- parser ) : http-version-parser ( -- parser )
[ [
"HTTP" token hide , "HTTP" token hide ,
'space' , space-parser ,
"/" token hide , "/" token hide ,
'space' , space-parser ,
"1" token , "1" token ,
"." token , "." token ,
{ "0" "1" } one-of , { "0" "1" } one-of ,
] seq* [ "" concat-as ] action ; ] seq* [ "" concat-as ] action ;
: 'full-request' ( -- parser ) : full-request-parser ( -- parser )
[ [
'space' , space-parser ,
'http-method' , http-method-parser ,
'space' , space-parser ,
'url' , url-parser ,
'space' , space-parser ,
'http-version' , http-version-parser ,
'space' , space-parser ,
] seq* ; ] seq* ;
: 'simple-request' ( -- parser ) : simple-request-parser ( -- parser )
[ [
'space' , space-parser ,
"GET" token , "GET" token ,
'space' , space-parser ,
'url' , url-parser ,
'space' , space-parser ,
] seq* [ "1.0" suffix! ] action ; ] seq* [ "1.0" suffix! ] action ;
PEG: parse-request-line ( string -- triple ) PEG: parse-request-line ( string -- triple )
#! Triple is { method url version } #! 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 ; [ control? ] except ;
: 'response-code' ( -- parser ) : response-code-parser ( -- parser )
[ digit? ] satisfy 3 exactly-n [ string>number ] action ; [ digit? ] satisfy 3 exactly-n [ string>number ] action ;
: 'response-message' ( -- parser ) : response-message-parser ( -- parser )
'text' repeat0 case-sensitive ; text-parser repeat0 case-sensitive ;
PEG: parse-response-line ( string -- triple ) PEG: parse-response-line ( string -- triple )
#! Triple is { version code message } #! Triple is { version code message }
[ [
'space' , space-parser ,
'http-version' , http-version-parser ,
'space' , space-parser ,
'response-code' , response-code-parser ,
'space' , space-parser ,
'response-message' , response-message-parser ,
] seq* just ; ] seq* just ;
: 'crlf' ( -- parser ) : crlf-parser ( -- parser )
"\r\n" token ; "\r\n" token ;
: 'lws' ( -- parser ) : lws-parser ( -- parser )
[ " \t" member? ] satisfy repeat1 ; [ " \t" member? ] satisfy repeat1 ;
: 'qdtext' ( -- parser ) : qdtext-parser ( -- parser )
{ [ CHAR: " = ] [ control? ] } except-these ; { [ CHAR: " = ] [ control? ] } except-these ;
: 'quoted-char' ( -- parser ) : quoted-char-parser ( -- parser )
"\\" token hide any-char 2seq ; "\\" token hide any-char 2seq ;
: 'quoted-string' ( -- parser ) : quoted-string-parser ( -- parser )
'quoted-char' 'qdtext' 2choice repeat0 "\"" "\"" surrounded-by ; quoted-char-parser qdtext-parser 2choice repeat0 "\"" "\"" surrounded-by ;
: 'ctext' ( -- parser ) : ctext-parser ( -- parser )
{ [ control? ] [ "()" member? ] } except-these ; { [ control? ] [ "()" member? ] } except-these ;
: 'comment' ( -- parser ) : comment-parser ( -- parser )
'ctext' 'comment' 2choice repeat0 "(" ")" surrounded-by ; ctext-parser comment-parser 2choice repeat0 "(" ")" surrounded-by ;
: 'field-name' ( -- parser ) : field-name-parser ( -- parser )
'token' case-insensitive ; token-parser case-insensitive ;
: 'field-content' ( -- parser ) : field-content-parser ( -- parser )
'quoted-string' case-sensitive quoted-string-parser case-sensitive
'text' repeat0 case-sensitive text-parser repeat0 case-sensitive
2choice ; 2choice ;
PEG: parse-header-line ( string -- pair ) PEG: parse-header-line ( string -- pair )
#! Pair is either { name value } or { f value }. If f, its a #! Pair is either { name value } or { f value }. If f, its a
#! continuation of the previous header line. #! continuation of the previous header line.
[ [
'field-name' , field-name-parser ,
'space' , space-parser ,
":" token hide , ":" token hide ,
'space' , space-parser ,
'field-content' , field-content-parser ,
] seq* ] seq*
[ [
'lws' [ drop f ] action , lws-parser [ drop f ] action ,
'field-content' , field-content-parser ,
] seq* ] seq*
2choice ; 2choice ;
: 'word' ( -- parser ) : word-parser ( -- parser )
'token' 'quoted-string' 2choice ; token-parser quoted-string-parser 2choice ;
: 'value' ( -- parser ) : value-parser ( -- parser )
'quoted-string' quoted-string-parser
[ ";" member? ] except repeat0 [ ";" member? ] except repeat0
2choice case-sensitive ; 2choice case-sensitive ;
: 'attr' ( -- parser ) : attr-parser ( -- parser )
'token' case-sensitive ; token-parser case-sensitive ;
: 'av-pair' ( -- parser ) : av-pair-parser ( -- parser )
[ [
'space' , space-parser ,
'attr' , attr-parser ,
'space' , space-parser ,
[ "=" token , 'space' , 'value' , ] seq* [ last ] action optional , [ "=" token , space-parser , value-parser , ] seq* [ last ] action optional ,
'space' , space-parser ,
] seq* ; ] seq* ;
: 'av-pairs' ( -- parser ) : av-pairs-parser ( -- parser )
'av-pair' ";" token list-of optional ; av-pair-parser ";" token list-of optional ;
PEG: (parse-set-cookie) ( string -- alist ) 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' , space-parser ,
'attr' , attr-parser ,
'space' , space-parser ,
"=" token hide , "=" token hide ,
'space' , space-parser ,
'value' , value-parser ,
'space' , space-parser ,
] seq* ] seq*
[ ";,=" member? not ] satisfy repeat0 [ drop f ] action [ ";,=" member? not ] satisfy repeat0 [ drop f ] action
2choice ; 2choice ;
PEG: (parse-cookie) ( string -- alist ) PEG: (parse-cookie) ( string -- alist )
'cookie-value' [ ";," member? ] satisfy list-of cookie-value-parser [ ";," member? ] satisfy list-of
optional just [ sift ] action ; optional just [ sift ] action ;

24
basis/logging/parser/parser.factor
View File

@ -13,44 +13,44 @@ TUPLE: log-entry date level word-name message ;
SYMBOL: multiline SYMBOL: multiline
: 'date' ( -- parser ) : date-parser ( -- parser )
[ "]" member? not ] string-of [ [ "]" member? not ] string-of [
dup multiline-header = dup multiline-header =
[ drop multiline ] [ rfc3339>timestamp ] if [ drop multiline ] [ rfc3339>timestamp ] if
] action ] action
"[" "]" surrounded-by ; "[" "]" surrounded-by ;
: 'log-level' ( -- parser ) : log-level-parser ( -- parser )
log-levels keys [ log-levels keys [
[ name>> token ] keep [ nip ] curry action [ name>> token ] keep [ nip ] curry action
] map choice ; ] map choice ;
: 'word-name' ( -- parser ) : word-name-parser ( -- parser )
[ " :" member? not ] string-of ; [ " :" member? not ] string-of ;
SYMBOL: malformed SYMBOL: malformed
: 'malformed-line' ( -- parser ) : malformed-line-parser ( -- parser )
[ drop t ] string-of [ drop t ] string-of
[ log-entry new swap >>message malformed >>level ] action ; [ log-entry new swap >>message malformed >>level ] action ;
: 'log-message' ( -- parser ) : log-message-parser ( -- parser )
[ drop t ] string-of [ drop t ] string-of
[ 1vector ] action ; [ 1vector ] action ;
: 'log-line' ( -- parser ) : log-line-parser ( -- parser )
[ [
'date' , date-parser ,
" " token hide , " " token hide ,
'log-level' , log-level-parser ,
" " token hide , " " token hide ,
'word-name' , word-name-parser ,
": " token hide , ": " token hide ,
'log-message' , log-message-parser ,
] seq* [ first4 log-entry boa ] action ] 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 -- ? ) : malformed? ( line -- ? )
level>> malformed eq? ; level>> malformed eq? ;

46
basis/peg/ebnf/ebnf-tests.factor
View File

@ -7,11 +7,11 @@ namespaces arrays strings eval unicode.data multiline ;
IN: peg.ebnf.tests IN: peg.ebnf.tests
{ T{ ebnf-non-terminal f "abc" } } [ { T{ ebnf-non-terminal f "abc" } } [
"abc" 'non-terminal' parse "abc" non-terminal-parser parse
] unit-test ] unit-test
{ T{ ebnf-terminal f "55" } } [ { T{ ebnf-terminal f "55" } } [
"'55'" 'terminal' parse "'55'" terminal-parser parse
] unit-test ] unit-test
{ {
@ -22,7 +22,7 @@ IN: peg.ebnf.tests
} }
} }
} [ } [
"digit = '1' | '2'" 'rule' parse "digit = '1' | '2'" rule-parser parse
] unit-test ] unit-test
{ {
@ -33,7 +33,7 @@ IN: peg.ebnf.tests
} }
} }
} [ } [
"digit = '1' '2'" 'rule' parse "digit = '1' '2'" rule-parser parse
] unit-test ] unit-test
{ {
@ -46,7 +46,7 @@ IN: peg.ebnf.tests
} }
} }
} [ } [
"one two | three" 'choice' parse "one two | three" choice-parser parse
] unit-test ] unit-test
{ {
@ -61,7 +61,7 @@ IN: peg.ebnf.tests
} }
} }
} [ } [
"one {two | three}" 'choice' parse "one {two | three}" choice-parser parse
] unit-test ] 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 ] 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 ] unit-test
{ {
@ -113,23 +113,23 @@ IN: peg.ebnf.tests
} }
} }
} [ } [
"one ( two )? three" 'choice' parse "one ( two )? three" choice-parser parse
] unit-test ] unit-test
{ "foo" } [ { "foo" } [
"\"foo\"" 'identifier' parse "\"foo\"" identifier-parser parse
] unit-test ] unit-test
{ "foo" } [ { "foo" } [
"'foo'" 'identifier' parse "'foo'" identifier-parser parse
] unit-test ] unit-test
{ "foo" } [ { "foo" } [
"foo" 'non-terminal' parse symbol>> "foo" non-terminal-parser parse symbol>>
] unit-test ] unit-test
{ "foo" } [ { "foo" } [
"foo]" 'non-terminal' parse symbol>> "foo]" non-terminal-parser parse symbol>>
] unit-test ] unit-test
{ V{ "a" "b" } } [ { V{ "a" "b" } } [
@ -272,7 +272,7 @@ IN: peg.ebnf.tests
] unit-test ] unit-test
{ t } [ { t } [
"abcd='9' | ('8'):x => [[ x ]]" 'ebnf' (parse) remaining>> empty? "abcd='9' | ('8'):x => [[ x ]]" ebnf-parser (parse) remaining>> empty?
] unit-test ] unit-test
EBNF: primary EBNF: primary
@ -431,29 +431,29 @@ main = Primary
] unit-test ] unit-test
{ t } [ { t } [
"number=(digit)+:n 'a'" 'ebnf' (parse) remaining>> length zero? "number=(digit)+:n 'a'" ebnf-parser (parse) remaining>> length zero?
] unit-test ] unit-test
{ t } [ { t } [
"number=(digit)+ 'a'" 'ebnf' (parse) remaining>> length zero? "number=(digit)+ 'a'" ebnf-parser (parse) remaining>> length zero?
] unit-test ] unit-test
{ t } [ { t } [
"number=digit+ 'a'" 'ebnf' (parse) remaining>> length zero? "number=digit+ 'a'" ebnf-parser (parse) remaining>> length zero?
] unit-test ] unit-test
{ t } [ { t } [
"number=digit+:n 'a'" 'ebnf' (parse) remaining>> length zero? "number=digit+:n 'a'" ebnf-parser (parse) remaining>> length zero?
] unit-test ] unit-test
{ t } [ { t } [
"foo=(name):n !(keyword) => [[ n ]]" 'rule' parse "foo=(name):n !(keyword) => [[ n ]]" rule-parser parse
"foo=name:n !(keyword) => [[ n ]]" 'rule' parse = "foo=name:n !(keyword) => [[ n ]]" rule-parser parse =
] unit-test ] unit-test
{ t } [ { t } [
"foo=!(keyword) (name):n => [[ n ]]" 'rule' parse "foo=!(keyword) (name):n => [[ n ]]" rule-parser parse
"foo=!(keyword) name:n => [[ n ]]" 'rule' parse = "foo=!(keyword) name:n => [[ n ]]" rule-parser parse =
] unit-test ] unit-test
<< <<
@ -501,7 +501,7 @@ foo=<foreign any-char> 'd'
{ t } [ { t } [
#! Rule lookup occurs in a namespace. This causes an incorrect duplicate rule #! 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. #! 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 ] unit-test
#! Tokenizer tests #! Tokenizer tests

130
basis/peg/ebnf/ebnf.factor
View File

@ -103,7 +103,7 @@ C: <ebnf> ebnf
token sp hide ; token sp hide ;
: syntax-pack ( begin parser end -- parser ) : syntax-pack ( begin parser end -- parser )
#! Parse 'parser' surrounded by syntax elements #! Parse parser-parser surrounded by syntax elements
#! begin and end. #! begin and end.
[ syntax ] 2dip syntax pack ; [ syntax ] 2dip syntax pack ;
@ -114,7 +114,7 @@ C: <ebnf> ebnf
"\r" token [ drop "\\r" ] action , "\r" token [ drop "\\r" ] action ,
] choice* replace ; ] choice* replace ;
: 'identifier' ( -- parser ) : identifier-parser ( -- parser )
#! Return a parser that parses an identifer delimited by #! Return a parser that parses an identifer delimited by
#! a quotation character. The quotation can be single #! a quotation character. The quotation can be single
#! or double quotes. The AST produced is the identifier #! or double quotes. The AST produced is the identifier
@ -124,7 +124,7 @@ C: <ebnf> ebnf
[ CHAR: ' = not ] satisfy repeat1 "'" "'" surrounded-by , [ CHAR: ' = not ] satisfy repeat1 "'" "'" surrounded-by ,
] choice* [ >string unescape-string ] action ; ] choice* [ >string unescape-string ] action ;
: 'non-terminal' ( -- parser ) : non-terminal-parser ( -- parser )
#! A non-terminal is the name of another rule. It can #! A non-terminal is the name of another rule. It can
#! be any non-blank character except for characters used #! be any non-blank character except for characters used
#! in the EBNF syntax itself. #! in the EBNF syntax itself.
@ -154,12 +154,12 @@ C: <ebnf> ebnf
} 1|| not } 1|| not
] satisfy repeat1 [ >string <ebnf-non-terminal> ] action ; ] satisfy repeat1 [ >string <ebnf-non-terminal> ] action ;
: 'terminal' ( -- parser ) : terminal-parser ( -- parser )
#! A terminal is an identifier enclosed in quotations #! A terminal is an identifier enclosed in quotations
#! and it represents the literal value of the identifier. #! 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 #! Parse a valid foreign parser name
[ [
{ {
@ -168,20 +168,20 @@ C: <ebnf> ebnf
} 1|| not } 1|| not
] satisfy repeat1 [ >string ] action ; ] satisfy repeat1 [ >string ] action ;
: 'foreign' ( -- parser ) : foreign-parser ( -- parser )
#! A foreign call is a call to a rule in another ebnf grammar #! A foreign call is a call to a rule in another ebnf grammar
[ [
"<foreign" syntax , "<foreign" syntax ,
'foreign-name' sp , foreign-name-parser sp ,
'foreign-name' sp optional , foreign-name-parser sp optional ,
">" syntax , ">" syntax ,
] seq* [ first2 <ebnf-foreign> ] action ; ] seq* [ first2 <ebnf-foreign> ] action ;
: 'any-character' ( -- parser ) : any-character-parser ( -- parser )
#! A parser to match the symbol for any character match. #! A parser to match the symbol for any character match.
[ CHAR: . = ] satisfy [ drop <ebnf-any-character> ] action ; [ CHAR: . = ] satisfy [ drop <ebnf-any-character> ] action ;
: 'range-parser' ( -- parser ) : range-parser-parser ( -- parser )
#! Match the syntax for declaring character ranges #! Match the syntax for declaring character ranges
[ [
[ "[" syntax , "[" token ensure-not , ] seq* hide , [ "[" syntax , "[" token ensure-not , ] seq* hide ,
@ -189,7 +189,7 @@ C: <ebnf> ebnf
"]" syntax , "]" syntax ,
] seq* [ first >string unescape-string <ebnf-range> ] action ; ] 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 #! An element of a rule. It can be a terminal or a
#! non-terminal but must not be followed by a "=". #! non-terminal but must not be followed by a "=".
#! The latter indicates that it is the beginning of a #! The latter indicates that it is the beginning of a
@ -197,11 +197,11 @@ C: <ebnf> ebnf
[ [
[ [
[ [
'non-terminal' , non-terminal-parser ,
'terminal' , terminal-parser ,
'foreign' , foreign-parser ,
'range-parser' , range-parser-parser ,
'any-character' , any-character-parser ,
] choice* ] choice*
[ dup , "~" token hide , ] seq* [ first <ebnf-ignore> ] action , [ dup , "~" token hide , ] seq* [ first <ebnf-ignore> ] action ,
[ dup , "*" token hide , ] seq* [ first <ebnf-repeat0> ] action , [ dup , "*" token hide , ] seq* [ first <ebnf-repeat0> ] action ,
@ -215,19 +215,19 @@ C: <ebnf> ebnf
] choice* , ] choice* ,
] seq* [ first ] action ; ] 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-Z_" range-pattern
"a-zA-Z0-9_-" range-pattern repeat1 2seq [ first2 swap prefix >string ] action , "a-zA-Z0-9_-" range-pattern repeat1 2seq [ first2 swap prefix >string ] action ,
] seq* [ first2 <ebnf-var> ] action , ] seq* [ first2 <ebnf-var> ] action ,
('element') , (element-parser) ,
] choice* ; ] choice* ;
DEFER: 'choice' DEFER: choice-parser
: grouped ( quot suffix -- parser ) : grouped ( quot suffix -- parser )
#! Parse a group of choices, with a suffix indicating #! 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. #! an quot that is the action that produces the AST.
2dup 2dup
[ [
"(" [ 'choice' sp ] delay ")" syntax-pack "(" [ choice-parser sp ] delay ")" syntax-pack
swap 2seq swap 2seq
[ first ] rot compose action , [ first ] rot compose action ,
"{" [ 'choice' sp ] delay "}" syntax-pack "{" [ choice-parser sp ] delay "}" syntax-pack
swap 2seq swap 2seq
[ first <ebnf-whitespace> ] rot compose action , [ first <ebnf-whitespace> ] rot compose action ,
] choice* ; ] choice* ;
: 'group' ( -- parser ) : group-parser ( -- parser )
#! A grouping with no suffix. Used for precedence. #! A grouping with no suffix. Used for precedence.
[ ] [ [ ] [
"~" token sp ensure-not , "~" token sp ensure-not ,
@ -252,115 +252,115 @@ DEFER: 'choice'
"?" token sp ensure-not , "?" token sp ensure-not ,
] seq* hide grouped ; ] seq* hide grouped ;
: 'ignore' ( -- parser ) : ignore-parser ( -- parser )
[ <ebnf-ignore> ] "~" syntax grouped ; [ <ebnf-ignore> ] "~" syntax grouped ;
: 'repeat0' ( -- parser ) : repeat0-parser ( -- parser )
[ <ebnf-repeat0> ] "*" syntax grouped ; [ <ebnf-repeat0> ] "*" syntax grouped ;
: 'repeat1' ( -- parser ) : repeat1-parser ( -- parser )
[ <ebnf-repeat1> ] "+" syntax grouped ; [ <ebnf-repeat1> ] "+" syntax grouped ;
: 'optional' ( -- parser ) : optional-parser ( -- parser )
[ <ebnf-optional> ] "?" syntax grouped ; [ <ebnf-optional> ] "?" syntax grouped ;
: 'factor-code' ( -- parser ) : factor-code-parser ( -- parser )
[ [
"]]" token ensure-not , "]]" token ensure-not ,
"]?" token ensure-not , "]?" token ensure-not ,
[ drop t ] satisfy , [ drop t ] satisfy ,
] seq* repeat0 [ "" concat-as ] action ; ] seq* repeat0 [ "" concat-as ] action ;
: 'ensure-not' ( -- parser ) : ensure-not-parser ( -- parser )
#! Parses the '!' syntax to ensure that #! Parses the '!' syntax to ensure that
#! something that matches the following elements do #! something that matches the following elements do
#! not exist in the parse stream. #! not exist in the parse stream.
[ [
"!" syntax , "!" syntax ,
'group' sp , group-parser sp ,
] seq* [ first <ebnf-ensure-not> ] action ; ] seq* [ first <ebnf-ensure-not> ] action ;
: 'ensure' ( -- parser ) : ensure-parser ( -- parser )
#! Parses the '&' syntax to ensure that #! Parses the '&' syntax to ensure that
#! something that matches the following elements does #! something that matches the following elements does
#! exist in the parse stream. #! exist in the parse stream.
[ [
"&" syntax , "&" syntax ,
'group' sp , group-parser sp ,
] seq* [ first <ebnf-ensure> ] action ; ] seq* [ first <ebnf-ensure> ] action ;
: ('sequence') ( -- parser ) : (sequence-parser) ( -- parser )
#! A sequence of terminals and non-terminals, including #! A sequence of terminals and non-terminals, including
#! groupings of those. #! groupings of those.
[ [
[ [
'ensure-not' sp , ensure-not-parser sp ,
'ensure' sp , ensure-parser sp ,
'element' sp , element-parser sp ,
'group' sp , group-parser sp ,
'ignore' sp , ignore-parser sp ,
'repeat0' sp , repeat0-parser sp ,
'repeat1' sp , repeat1-parser sp ,
'optional' sp , optional-parser sp ,
] choice* ] choice*
[ dup , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 <ebnf-var> ] action , [ dup , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 <ebnf-var> ] action ,
, ,
] choice* ; ] choice* ;
: 'action' ( -- parser ) : action-parser ( -- parser )
"[[" 'factor-code' "]]" syntax-pack ; "[[" factor-code-parser "]]" syntax-pack ;
: 'semantic' ( -- parser ) : semantic-parser ( -- parser )
"?[" 'factor-code' "]?" syntax-pack ; "?[" factor-code-parser "]?" syntax-pack ;
: 'sequence' ( -- parser ) : sequence-parser ( -- parser )
#! A sequence of terminals and non-terminals, including #! A sequence of terminals and non-terminals, including
#! groupings of those. #! groupings of those.
[ [
[ ('sequence') , 'action' , ] seq* [ (sequence-parser) , action-parser , ] seq*
[ first2 <ebnf-action> ] action , [ first2 <ebnf-action> ] action ,
[ ('sequence') , 'semantic' , ] seq* [ (sequence-parser) , semantic-parser , ] seq*
[ first2 <ebnf-semantic> ] action , [ first2 <ebnf-semantic> ] action ,
('sequence') , (sequence-parser) ,
] choice* repeat1 [ ] choice* repeat1 [
dup length 1 = [ first ] [ <ebnf-sequence> ] if dup length 1 = [ first ] [ <ebnf-sequence> ] if
] action ; ] action ;
: 'actioned-sequence' ( -- parser ) : actioned-sequence-parser ( -- parser )
[ [
[ 'sequence' , "=>" syntax , 'action' , ] seq* [ sequence-parser , "=>" syntax , action-parser , ] seq*
[ first2 <ebnf-action> ] action , [ first2 <ebnf-action> ] action ,
'sequence' , sequence-parser ,
] choice* ; ] choice* ;
: 'choice' ( -- parser ) : choice-parser ( -- parser )
'actioned-sequence' sp repeat1 [ actioned-sequence-parser sp repeat1 [
dup length 1 = [ first ] [ <ebnf-sequence> ] if dup length 1 = [ first ] [ <ebnf-sequence> ] if
] action "|" token sp list-of [ ] action "|" token sp list-of [
dup length 1 = [ first ] [ <ebnf-choice> ] if dup length 1 = [ first ] [ <ebnf-choice> ] if
] action ; ] action ;
: 'tokenizer' ( -- parser ) : tokenizer-parser ( -- parser )
[ [
"tokenizer" syntax , "tokenizer" syntax ,
"=" syntax , "=" syntax ,
">" token ensure-not , ">" token ensure-not ,
[ "default" token sp , 'choice' , ] choice* , [ "default" token sp , choice-parser , ] choice* ,
] seq* [ first <ebnf-tokenizer> ] action ; ] seq* [ first <ebnf-tokenizer> ] action ;
: 'rule' ( -- parser ) : rule-parser ( -- parser )
[ [
"tokenizer" token ensure-not , "tokenizer" token ensure-not ,
'non-terminal' [ symbol>> ] action , non-terminal-parser [ symbol>> ] action ,
"=" syntax , "=" syntax ,
">" token ensure-not , ">" token ensure-not ,
'choice' , choice-parser ,
] seq* [ first2 <ebnf-rule> ] action ; ] seq* [ first2 <ebnf-rule> ] action ;
: 'ebnf' ( -- parser ) : ebnf-parser ( -- parser )
[ 'tokenizer' sp , 'rule' sp , ] choice* repeat1 [ <ebnf> ] action ; [ tokenizer-parser sp , rule-parser sp , ] choice* repeat1 [ <ebnf> ] action ;
GENERIC: (transform) ( ast -- parser ) GENERIC: (transform) ( ast -- parser )
@ -530,7 +530,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
] [ ] make box ; ] [ ] make box ;
: transform-ebnf ( string -- object ) : transform-ebnf ( string -- object )
'ebnf' parse transform ; ebnf-parser parse transform ;
ERROR: unable-to-fully-parse-ebnf remaining ; ERROR: unable-to-fully-parse-ebnf remaining ;
@ -546,7 +546,7 @@ ERROR: could-not-parse-ebnf ;
] if* ; ] if* ;
: parse-ebnf ( string -- hashtable ) : parse-ebnf ( string -- hashtable )
'ebnf' (parse) check-parse-result ast>> transform ; ebnf-parser (parse) check-parse-result ast>> transform ;
: ebnf>quot ( string -- hashtable quot ) : ebnf>quot ( string -- hashtable quot )
parse-ebnf dup dup parser [ main of compile ] with-variable parse-ebnf dup dup parser [ main of compile ] with-variable

20
basis/peg/parsers/parsers-docs.factor
View File

@ -12,7 +12,7 @@ HELP: 1token
"Calls 1string on a character and returns a parser that matches that character." "Calls 1string on a character and returns a parser that matches that character."
} { $examples } { $examples
{ $example "USING: peg peg.parsers prettyprint ;" "\"a\" CHAR: a 1token parse ." "\"a\"" } { $example "USING: peg peg.parsers prettyprint ;" "\"a\" CHAR: a 1token parse ." "\"a\"" }
} { $see-also 'string' } ; } { $see-also string-parser } ;
HELP: (list-of) HELP: (list-of)
{ $values { $values
@ -124,7 +124,7 @@ HELP: pack
} { $description } { $description
"Returns a parser that parses the begin, body, and end parsers in order. The begin and end parsers are hidden." "Returns a parser that parses the begin, body, and end parsers in order. The begin and end parsers are hidden."
} { $examples } { $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 } ; } { $see-also surrounded-by } ;
HELP: surrounded-by HELP: surrounded-by
@ -136,29 +136,29 @@ HELP: surrounded-by
} { $description } { $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." "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 } { $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 } ; } { $see-also pack } ;
HELP: 'digit' HELP: digit-parser
{ $values { $values
{ "parser" "a parser" } { "parser" "a parser" }
} { $description } { $description
"Returns a parser that matches a single digit as defined by the " { $link digit? } " word." "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 { $values
{ "parser" "a parser" } { "parser" "a parser" }
} { $description } { $description
"Returns a parser that matches an integer composed of digits, as defined by the " { $link 'digit' } " word." "Returns a parser that matches an integer composed of digits, as defined by the " { $link digit-parser } " word."
} { $see-also 'digit' 'string' } ; } { $see-also digit-parser string-parser } ;
HELP: 'string' HELP: string-parser
{ $values { $values
{ "parser" "a parser" } { "parser" "a parser" }
} { $description } { $description
"Returns a parser that matches an string composed of a \", anything that is not \", and another \"." "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 HELP: range-pattern
{ $values { $values

8
basis/peg/parsers/parsers.factor
View File

@ -62,18 +62,18 @@ PRIVATE>
[ flatten-vectors ] action ; [ flatten-vectors ] action ;
: pack ( begin body end -- parser ) : pack ( begin body end -- parser )
[ hide ] 2dip hide 3seq [ first ] action ; [ hide ] [ ] [ hide ] tri* 3seq [ first ] action ;
: surrounded-by ( parser begin end -- parser' ) : surrounded-by ( parser begin end -- parser' )
[ token ] bi@ swapd pack ; [ token ] bi@ swapd pack ;
: 'digit' ( -- parser ) : digit-parser ( -- parser )
[ digit? ] satisfy [ digit> ] action ; [ digit? ] satisfy [ digit> ] action ;
: 'integer' ( -- parser ) : integer-parser ( -- parser )
[ digit? ] satisfy repeat1 [ string>number ] action ; [ digit? ] satisfy repeat1 [ string>number ] action ;
: 'string' ( -- parser ) : string-parser ( -- parser )
[ [
[ CHAR: " = ] satisfy hide , [ CHAR: " = ] satisfy hide ,
[ CHAR: " = not ] satisfy repeat0 , [ CHAR: " = not ] satisfy repeat0 ,

6
basis/peg/search/search-docs.factor
View File

@ -24,8 +24,8 @@ HELP: search
"parser." "parser."
} }
{ $example "USING: peg.parsers peg.search prettyprint ;" "\"one 123 two 456\" 'integer' search ." "V{ 123 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' 'string' 2choice search ." "V{ 123 \"hello\" 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 } ; { $see-also replace } ;
HELP: replace HELP: replace
@ -39,5 +39,5 @@ HELP: replace
"successfully parse with the given parser replaced with " "successfully parse with the given parser replaced with "
"the result of that parser." "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 } ; { $see-also search } ;

6
basis/peg/search/search-tests.factor
View File

@ -6,13 +6,13 @@ peg.search ;
IN: peg.search.tests IN: peg.search.tests
{ V{ 123 456 } } [ { V{ 123 456 } } [
"abc 123 def 456" 'integer' search "abc 123 def 456" integer-parser search
] unit-test ] unit-test
{ V{ 123 "hello" 456 } } [ { 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 ] unit-test
{ "abc 246 def 912" } [ { "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 ] unit-test