: tspecial? ( ch -- ? )
"()<>@,;:\\\"/[]?={} \t" member? ;
-: 'token' ( -- parser )
+: token-parser ( -- parser )
{ [ control? ] [ tspecial? ] } except-these repeat1 ;
: case-insensitive ( parser -- parser' )
: 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 ;
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? ;
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
{
}
}
} [
- "digit = '1' | '2'" 'rule' parse
+ "digit = '1' | '2'" rule-parser parse
] unit-test
{
}
}
} [
- "digit = '1' '2'" 'rule' parse
+ "digit = '1' '2'" rule-parser parse
] unit-test
{
}
}
} [
- "one two | three" 'choice' parse
+ "one two | three" choice-parser parse
] unit-test
{
}
}
} [
- "one {two | three}" 'choice' parse
+ "one {two | three}" choice-parser parse
] unit-test
{
}
}
} [
- "one ((two | three) four)*" 'choice' parse
+ "one ((two | three) four)*" choice-parser parse
] unit-test
{
}
}
} [
- "one ((two | three) four)~" 'choice' parse
+ "one ((two | three) four)~" choice-parser parse
] unit-test
{
}
}
} [
- "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" } } [
] 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
] 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
<<
{ 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
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 ;
"\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
[ 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.
} 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
[
{
} 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 ,
"]" 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
[
[
[
- '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 ,
] 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
#! 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 ,
"?" 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 )
] [ ] make box ;
: transform-ebnf ( string -- object )
- 'ebnf' parse transform ;
+ ebnf-parser parse transform ;
ERROR: unable-to-fully-parse-ebnf remaining ;
] 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
"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
} { $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
} { $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
[ 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 ,
"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
"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 } ;
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
projects / factor.git / commitdiff