--- /dev/null
+Chris Double
--- /dev/null
+! Copyright (C) 2008 Chris Double, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax peg peg.parsers.private
+unicode.categories ;
+IN: peg.parsers
+
+HELP: 1token
+{ $values
+ { "ch" "a character" }
+ { "parser" "a parser" }
+} { $description
+ "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' } ;
+
+HELP: (list-of)
+{ $values
+ { "items" "a sequence" }
+ { "separator" "a parser" }
+ { "repeat1?" "a boolean" }
+ { "parser" "a parser" }
+} { $description
+ "Returns a parser that returns a list of items separated by the separator parser. Does not hide the separators."
+} { $see-also list-of list-of-many } ;
+
+HELP: list-of
+{ $values
+ { "items" "a sequence" }
+ { "separator" "a parser" }
+ { "parser" "a parser" }
+} { $description
+ "Returns a parser that returns a list of items separated by the separator parser. Hides the separators and matches a list of one or more items."
+} { $notes "Use " { $link list-of-many } " to ensure a list contains two or more items." }
+{ $examples
+ { $example "USING: peg peg.parsers prettyprint ;" "\"a\" \"a\" token \",\" token list-of parse ." "V{ \"a\" }" }
+ { $example "USING: peg peg.parsers prettyprint ;" "\"a,a,a,a\" \"a\" token \",\" token list-of parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+} { $see-also list-of-many } ;
+
+HELP: list-of-many
+{ $values
+ { "items" "a sequence" }
+ { "separator" "a parser" }
+ { "parser" "a parser" }
+} { $description
+ "Returns a parser that returns a list of items separated by the separator parser. Hides the separators and matches a list of two or more items."
+} { $notes "Use " { $link list-of } " to return a list of only one item."
+} { $examples
+ { $code "USING: peg peg.parsers prettyprint ;" "\"a\" \"a\" token \",\" token list-of-many parse => exception" }
+ { $example "USING: peg peg.parsers prettyprint ;" "\"a,a,a,a\" \"a\" token \",\" token list-of-many parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+} { $see-also list-of } ;
+
+HELP: epsilon
+{ $values
+ { "parser" "a parser" }
+} { $description
+ "Returns a parser that matches the empty sequence."
+} ;
+
+HELP: any-char
+{ $values
+ { "parser" "a parser" }
+} { $description
+ "Returns a parser that matches the any single character."
+} ;
+
+HELP: exactly-n
+{ $values
+ { "parser" "a parser" }
+ { "n" "an integer" }
+ { "parser'" "a parser" }
+} { $description
+ "Returns a parser that matches an exact repetition of the input parser."
+} { $examples
+ { $code "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 4 exactly-n parse => exception" }
+ { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 exactly-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+} { $see-also at-least-n at-most-n from-m-to-n } ;
+
+HELP: at-least-n
+{ $values
+ { "parser" "a parser" }
+ { "n" "an integer" }
+ { "parser'" "a parser" }
+} { $description
+ "Returns a parser that matches n or more repetitions of the input parser."
+} { $examples
+ { $code "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 4 at-least-n parse => exception"}
+ { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 at-least-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+ { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 4 at-least-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" \"a\" }" }
+} { $see-also exactly-n at-most-n from-m-to-n } ;
+
+HELP: at-most-n
+{ $values
+ { "parser" "a parser" }
+ { "n" "an integer" }
+ { "parser'" "a parser" }
+} { $description
+ "Returns a parser that matches n or fewer repetitions of the input parser."
+} { $examples
+ { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 at-most-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+ { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 4 at-most-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+} { $see-also exactly-n at-least-n from-m-to-n } ;
+
+HELP: from-m-to-n
+{ $values
+ { "parser" "a parser" }
+ { "m" "an integer" }
+ { "n" "an integer" }
+ { "parser'" "a parser" }
+} { $description
+ "Returns a parser that matches between and including m to n repetitions of the input parser."
+} { $examples
+ { $example "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 3 4 from-m-to-n parse ." "V{ \"a\" \"a\" \"a\" }" }
+ { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 3 4 from-m-to-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+ { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 3 4 from-m-to-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+} { $see-also exactly-n at-most-n at-least-n } ;
+
+HELP: pack
+{ $values
+ { "begin" "a parser" }
+ { "body" "a parser" }
+ { "end" "a parser" }
+ { "parser" "a parser" }
+} { $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" }
+} { $see-also surrounded-by } ;
+
+HELP: surrounded-by
+{ $values
+ { "parser" "a parser" }
+ { "begin" "a string" }
+ { "end" "a string" }
+ { "parser'" "a parser" }
+} { $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" }
+} { $see-also pack } ;
+
+HELP: 'digit'
+{ $values
+ { "parser" "a parser" }
+} { $description
+ "Returns a parser that matches a single digit as defined by the " { $link digit? } " word."
+} { $see-also 'integer' } ;
+
+HELP: 'integer'
+{ $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' } ;
+
+HELP: 'string'
+{ $values
+ { "parser" "a parser" }
+} { $description
+ "Returns a parser that matches an string composed of a \", anything that is not \", and another \"."
+} { $see-also 'integer' } ;
+
+HELP: range-pattern
+{ $values
+ { "pattern" "a string" }
+ { "parser" "a parser" }
+} { $description
+"Returns a parser that matches a single character based on the set "
+"of characters in the pattern string."
+"Any single character in the pattern matches that character. "
+"If the pattern begins with a ^ then the set is negated "
+"(the element matches any character not in the set). Any pair "
+"of characters separated with a dash (-) represents the "
+"range of characters from the first to the second, inclusive."
+{ $examples
+ { $example "USING: peg peg.parsers prettyprint strings ;" "\"a\" \"_a-zA-Z\" range-pattern parse 1string ." "\"a\"" }
+ { $code "USING: peg peg.parsers prettyprint ;\n\"0\" \"^0-9\" range-pattern parse => exception"}
+}
+} ;
--- /dev/null
+USING: kernel peg peg.parsers tools.test accessors ;
+IN: peg.parsers.tests
+
+{ V{ "a" } }
+[ "a" "a" token "," token list-of parse ] unit-test
+
+{ V{ "a" "a" "a" "a" } }
+[ "a,a,a,a" "a" token "," token list-of parse ] unit-test
+
+[ "a" "a" token "," token list-of-many parse ] must-fail
+
+{ V{ "a" "a" "a" "a" } }
+[ "a,a,a,a" "a" token "," token list-of-many parse ] unit-test
+
+[ "aaa" "a" token 4 exactly-n parse ] must-fail
+
+{ V{ "a" "a" "a" "a" } }
+[ "aaaa" "a" token 4 exactly-n parse ] unit-test
+
+[ "aaa" "a" token 4 at-least-n parse ] must-fail
+
+{ V{ "a" "a" "a" "a" } }
+[ "aaaa" "a" token 4 at-least-n parse ] unit-test
+
+{ V{ "a" "a" "a" "a" "a" } }
+[ "aaaaa" "a" token 4 at-least-n parse ] unit-test
+
+{ V{ "a" "a" "a" "a" } }
+[ "aaaa" "a" token 4 at-most-n parse ] unit-test
+
+{ V{ "a" "a" "a" "a" } }
+[ "aaaaa" "a" token 4 at-most-n parse ] unit-test
+
+{ V{ "a" "a" "a" } }
+[ "aaa" "a" token 3 4 from-m-to-n parse ] unit-test
+
+{ V{ "a" "a" "a" "a" } }
+[ "aaaa" "a" token 3 4 from-m-to-n parse ] unit-test
+
+{ V{ "a" "a" "a" "a" } }
+[ "aaaaa" "a" token 3 4 from-m-to-n parse ] unit-test
+
+{ 97 }
+[ "a" any-char parse ] unit-test
+
+{ V{ } }
+[ "" epsilon parse ] unit-test
+
+{ "a" } [
+ "a" "a" token just parse
+] unit-test
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2007, 2008 Chris Double, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences strings namespaces math assocs shuffle
+ vectors arrays math.parser
+ unicode.categories sequences.deep peg peg.private
+ peg.search math.ranges words ;
+IN: peg.parsers
+
+TUPLE: just-parser p1 ;
+
+: just-pattern
+ [
+ execute dup [
+ dup parse-result-remaining empty? [ drop f ] unless
+ ] when
+ ] ;
+
+
+M: just-parser (compile) ( parser -- quot )
+ just-parser-p1 compile-parser just-pattern curry ;
+
+: just ( parser -- parser )
+ just-parser boa wrap-peg ;
+
+: 1token ( ch -- parser ) 1string token ;
+
+: (list-of) ( items separator repeat1? -- parser )
+ >r over 2seq r> [ repeat1 ] [ repeat0 ] if [ concat ] action 2seq
+ [ unclip 1vector swap first append ] action ;
+
+: list-of ( items separator -- parser )
+ hide f (list-of) ;
+
+: list-of-many ( items separator -- parser )
+ hide t (list-of) ;
+
+: epsilon ( -- parser ) V{ } token ;
+
+: any-char ( -- parser ) [ drop t ] satisfy ;
+
+<PRIVATE
+
+: flatten-vectors ( pair -- vector )
+ first2 over push-all ;
+
+PRIVATE>
+
+: exactly-n ( parser n -- parser' )
+ swap <repetition> seq ;
+
+: at-most-n ( parser n -- parser' )
+ dup zero? [
+ 2drop epsilon
+ ] [
+ 2dup exactly-n
+ -rot 1- at-most-n 2choice
+ ] if ;
+
+: at-least-n ( parser n -- parser' )
+ dupd exactly-n swap repeat0 2seq
+ [ flatten-vectors ] action ;
+
+: from-m-to-n ( parser m n -- parser' )
+ >r [ exactly-n ] 2keep r> swap - at-most-n 2seq
+ [ flatten-vectors ] action ;
+
+: pack ( begin body end -- parser )
+ >r >r hide r> r> hide 3seq [ first ] action ;
+
+: surrounded-by ( parser begin end -- parser' )
+ [ token ] bi@ swapd pack ;
+
+: 'digit' ( -- parser )
+ [ digit? ] satisfy [ digit> ] action ;
+
+: 'integer' ( -- parser )
+ 'digit' repeat1 [ 10 digits>integer ] action ;
+
+: 'string' ( -- parser )
+ [
+ [ CHAR: " = ] satisfy hide ,
+ [ CHAR: " = not ] satisfy repeat0 ,
+ [ CHAR: " = ] satisfy hide ,
+ ] seq* [ first >string ] action ;
+
+: (range-pattern) ( pattern -- string )
+ #! Given a range pattern, produce a string containing
+ #! all characters within that range.
+ [
+ any-char ,
+ [ CHAR: - = ] satisfy hide ,
+ any-char ,
+ ] seq* [
+ first2 [a,b] >string
+ ] action
+ replace ;
+
+: range-pattern ( pattern -- parser )
+ #! 'pattern' is a set of characters describing the
+ #! parser to be produced. Any single character in
+ #! the pattern matches that character. If the pattern
+ #! begins with a ^ then the set is negated (the element
+ #! matches any character not in the set). Any pair of
+ #! characters separated with a dash (-) represents the
+ #! range of characters from the first to the second,
+ #! inclusive.
+ dup first CHAR: ^ = [
+ rest (range-pattern) [ member? not ] curry satisfy
+ ] [
+ (range-pattern) [ member? ] curry satisfy
+ ] if ;
--- /dev/null
+! Copyright (C) 2007 Chris Double.\r
+! See http://factorcode.org/license.txt for BSD license.\r
+USING: help.markup help.syntax ;\r
+IN: peg\r
+\r
+HELP: parse\r
+{ $values \r
+ { "input" "a string" } \r
+ { "parser" "a parser" } \r
+ { "ast" "an object" } \r
+}\r
+{ $description \r
+ "Given the input string, parse it using the given parser. The result is the abstract "\r
+ "syntax tree returned by the parser." } \r
+{ $see-also compile } ;\r
+\r
+HELP: compile\r
+{ $values \r
+ { "parser" "a parser" } \r
+ { "word" "a word" } \r
+}\r
+{ $description \r
+ "Compile the parser to a word. The word will have stack effect ( -- ast )."\r
+} \r
+{ $see-also parse } ;\r
+\r
+HELP: token\r
+{ $values \r
+ { "string" "a string" } \r
+ { "parser" "a parser" } \r
+}\r
+{ $description \r
+ "Returns a parser that matches the given string." } ;\r
+\r
+HELP: satisfy\r
+{ $values \r
+ { "quot" "a quotation" } \r
+ { "parser" "a parser" } \r
+}\r
+{ $description \r
+ "Returns a parser that calls the quotation on the first character of the input string, "\r
+ "succeeding if that quotation returns true. The AST is the character from the string." } ;\r
+\r
+HELP: range\r
+{ $values \r
+ { "min" "a character" } \r
+ { "max" "a character" } \r
+ { "parser" "a parser" } \r
+}\r
+{ $description \r
+ "Returns a parser that matches a single character that lies within the range of characters given, inclusive." }\r
+{ $examples { $code ": digit ( -- parser ) CHAR: 0 CHAR: 9 range ;" } } ;\r
+\r
+HELP: seq\r
+{ $values \r
+ { "seq" "a sequence of parsers" } \r
+ { "parser" "a parser" } \r
+}\r
+{ $description \r
+ "Returns a parser that calls all parsers in the given sequence, in order. The parser succeeds if "\r
+ "all the parsers succeed, otherwise it fails. The AST produced is a sequence of the AST produced by "\r
+ "the individual parsers." } ;\r
+\r
+HELP: choice\r
+{ $values \r
+ { "seq" "a sequence of parsers" } \r
+ { "parser" "a parser" } \r
+}\r
+{ $description \r
+ "Returns a parser that will try all the parsers in the sequence, in order, until one succeeds. "\r
+ "The resulting AST is that produced by the successful parser." } ;\r
+\r
+HELP: repeat0\r
+{ $values \r
+ { "parser" "a parser" } \r
+}\r
+{ $description \r
+ "Returns a parser that parses 0 or more instances of the 'p1' parser. The AST produced is "\r
+ "an array of the AST produced by the 'p1' parser. An empty array indicates 0 instances were "\r
+ "parsed." } ;\r
+\r
+HELP: repeat1\r
+{ $values \r
+ { "parser" "a parser" } \r
+}\r
+{ $description \r
+ "Returns a parser that parses 1 or more instances of the 'p1' parser. The AST produced is "\r
+ "an array of the AST produced by the 'p1' parser." } ;\r
+\r
+HELP: optional\r
+{ $values \r
+ { "parser" "a parser" } \r
+}\r
+{ $description \r
+ "Returns a parser that parses 0 or 1 instances of the 'p1' parser. The AST produced is "\r
+ "'f' if 0 instances are parsed the AST produced is 'f', otherwise it is the AST produced by 'p1'." } ;\r
+\r
+HELP: semantic\r
+{ $values \r
+ { "parser" "a parser" } \r
+ { "quot" "a quotation with stack effect ( object -- bool )" } \r
+}\r
+{ $description \r
+ "Returns a parser that succeeds if the 'p1' parser succeeds and the quotation called with "\r
+ "the AST produced by 'p1' on the stack returns true." }\r
+{ $examples \r
+ { $example "USING: kernel math peg prettyprint ;" "\"C\" [ drop t ] satisfy [ 66 > ] semantic parse ." "67" } \r
+} ;\r
+\r
+HELP: ensure\r
+{ $values \r
+ { "parser" "a parser" } \r
+}\r
+{ $description \r
+ "Returns a parser that succeeds if the 'p1' parser succeeds but does not add anything to the "\r
+ "AST and does not move the location in the input string. This can be used for lookahead and "\r
+ "disambiguation, along with the " { $link ensure-not } " word." }\r
+{ $examples { $code "\"0\" token ensure octal-parser" } } ;\r
+\r
+HELP: ensure-not\r
+{ $values \r
+ { "parser" "a parser" } \r
+}\r
+{ $description \r
+ "Returns a parser that succeeds if the 'p1' parser fails but does not add anything to the "\r
+ "AST and does not move the location in the input string. This can be used for lookahead and "\r
+ "disambiguation, along with the " { $link ensure } " word." }\r
+{ $code "\"+\" token \"=\" token ensure-not \"+=\" token 3array seq" } ;\r
+\r
+HELP: action\r
+{ $values \r
+ { "parser" "a parser" } \r
+ { "quot" "a quotation with stack effect ( ast -- ast )" } \r
+}\r
+{ $description \r
+ "Returns a parser that calls the 'p1' parser and applies the quotation to the AST resulting "\r
+ "from that parse. The result of the quotation is then used as the final AST. This can be used "\r
+ "for manipulating the parse tree to produce a AST better suited for the task at hand rather than "\r
+ "the default AST. If the quotation returns " { $link fail } " then the parser fails." }\r
+{ $code "CHAR: 0 CHAR: 9 range [ to-digit ] action" } ;\r
+\r
+HELP: sp\r
+{ $values \r
+ { "parser" "a parser" } \r
+}\r
+{ $description \r
+ "Returns a parser that calls the original parser 'p1' after stripping any whitespace "\r
+ " from the left of the input string." } ;\r
+\r
+HELP: hide\r
+{ $values \r
+ { "parser" "a parser" } \r
+}\r
+{ $description \r
+ "Returns a parser that succeeds if the original parser succeeds, but does not " \r
+ "put any result in the AST. Useful for ignoring 'syntax' in the AST." }\r
+{ $code "\"[\" token hide number \"]\" token hide 3array seq" } ;\r
+\r
+HELP: delay\r
+{ $values \r
+ { "quot" "a quotation" } \r
+ { "parser" "a parser" } \r
+}\r
+{ $description \r
+ "Delays the construction of a parser until it is actually required to parse. This " \r
+ "allows for calling a parser that results in a recursive call to itself. The quotation "\r
+ "should return the constructed parser and is called the first time the parser is run."\r
+ "The compiled result is memoized for future runs. See " { $link box } " for a word "\r
+ "that calls the quotation at compile time." } ;\r
+\r
+HELP: box\r
+{ $values \r
+ { "quot" "a quotation" } \r
+ { "parser" "a parser" } \r
+}\r
+{ $description \r
+ "Delays the construction of a parser until the parser is compiled. The quotation "\r
+ "should return the constructed parser and is called when the parser is compiled."\r
+ "The compiled result is memoized for future runs. See " { $link delay } " for a word "\r
+ "that calls the quotation at runtime." } ;\r
--- /dev/null
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+!
+USING: kernel tools.test strings namespaces arrays sequences
+ peg peg.private accessors words math accessors ;
+IN: peg.tests
+
+[
+ "endbegin" "begin" token parse
+] must-fail
+
+{ "begin" "end" } [
+ "beginend" "begin" token (parse)
+ { ast>> remaining>> } get-slots
+ >string
+] unit-test
+
+[
+ "" CHAR: a CHAR: z range parse
+] must-fail
+
+[
+ "1bcd" CHAR: a CHAR: z range parse
+] must-fail
+
+{ CHAR: a } [
+ "abcd" CHAR: a CHAR: z range parse
+] unit-test
+
+{ CHAR: z } [
+ "zbcd" CHAR: a CHAR: z range parse
+] unit-test
+
+[
+ "bad" "a" token "b" token 2array seq parse
+] must-fail
+
+{ V{ "g" "o" } } [
+ "good" "g" token "o" token 2array seq parse
+] unit-test
+
+{ "a" } [
+ "abcd" "a" token "b" token 2array choice parse
+] unit-test
+
+{ "b" } [
+ "bbcd" "a" token "b" token 2array choice parse
+] unit-test
+
+[
+ "cbcd" "a" token "b" token 2array choice parse
+] must-fail
+
+[
+ "" "a" token "b" token 2array choice parse
+] must-fail
+
+{ 0 } [
+ "" "a" token repeat0 parse length
+] unit-test
+
+{ 0 } [
+ "b" "a" token repeat0 parse length
+] unit-test
+
+{ V{ "a" "a" "a" } } [
+ "aaab" "a" token repeat0 parse
+] unit-test
+
+[
+ "" "a" token repeat1 parse
+] must-fail
+
+[
+ "b" "a" token repeat1 parse
+] must-fail
+
+{ V{ "a" "a" "a" } } [
+ "aaab" "a" token repeat1 parse
+] unit-test
+
+{ V{ "a" "b" } } [
+ "ab" "a" token optional "b" token 2array seq parse
+] unit-test
+
+{ V{ f "b" } } [
+ "b" "a" token optional "b" token 2array seq parse
+] unit-test
+
+[
+ "cb" "a" token optional "b" token 2array seq parse
+] must-fail
+
+{ V{ CHAR: a CHAR: b } } [
+ "ab" "a" token ensure CHAR: a CHAR: z range dup 3array seq parse
+] unit-test
+
+[
+ "bb" "a" token ensure CHAR: a CHAR: z range 2array seq parse
+] must-fail
+
+{ t } [
+ "a+b"
+ "a" token "+" token dup ensure-not 2array seq "++" token 2array choice "b" token 3array seq
+ parse [ t ] [ f ] if
+] unit-test
+
+{ t } [
+ "a++b"
+ "a" token "+" token dup ensure-not 2array seq "++" token 2array choice "b" token 3array seq
+ parse [ t ] [ f ] if
+] unit-test
+
+{ t } [
+ "a+b"
+ "a" token "+" token "++" token 2array choice "b" token 3array seq
+ parse [ t ] [ f ] if
+] unit-test
+
+[
+ "a++b"
+ "a" token "+" token "++" token 2array choice "b" token 3array seq
+ parse [ t ] [ f ] if
+] must-fail
+
+{ 1 } [
+ "a" "a" token [ drop 1 ] action parse
+] unit-test
+
+{ V{ 1 1 } } [
+ "aa" "a" token [ drop 1 ] action dup 2array seq parse
+] unit-test
+
+[
+ "b" "a" token [ drop 1 ] action parse
+] must-fail
+
+[
+ "b" [ CHAR: a = ] satisfy parse
+] must-fail
+
+{ CHAR: a } [
+ "a" [ CHAR: a = ] satisfy parse
+] unit-test
+
+{ "a" } [
+ " a" "a" token sp parse
+] unit-test
+
+{ "a" } [
+ "a" "a" token sp parse
+] unit-test
+
+{ V{ "a" } } [
+ "[a]" "[" token hide "a" token "]" token hide 3array seq parse
+] unit-test
+
+[
+ "a]" "[" token hide "a" token "]" token hide 3array seq parse
+] must-fail
+
+
+{ V{ "1" "-" "1" } V{ "1" "+" "1" } } [
+ [
+ [ "1" token , "-" token , "1" token , ] seq* ,
+ [ "1" token , "+" token , "1" token , ] seq* ,
+ ] choice*
+ "1-1" over parse swap
+ "1+1" swap parse
+] unit-test
+
+: expr ( -- parser )
+ #! Test direct left recursion. Currently left recursion should cause a
+ #! failure of that parser.
+ [ expr ] delay "+" token "1" token 3seq "1" token 2choice ;
+
+{ V{ V{ "1" "+" "1" } "+" "1" } } [
+ "1+1+1" expr parse
+] unit-test
+
+{ t } [
+ #! Ensure a circular parser doesn't loop infinitely
+ [ f , "a" token , ] seq*
+ dup peg>> parsers>>
+ dupd 0 swap set-nth compile word?
+] unit-test
+
+[
+ "A" [ drop t ] satisfy [ 66 >= ] semantic parse
+] must-fail
+
+{ CHAR: B } [
+ "B" [ drop t ] satisfy [ 66 >= ] semantic parse
+] unit-test
+
+{ f } [ \ + T{ parser f f f } equal? ] unit-test
\ No newline at end of file
--- /dev/null
+Parsing Expression Grammar and Packrat Parser
--- /dev/null
+text
+parsing
+++ /dev/null
-Chris Double
+++ /dev/null
-! Copyright (C) 2008 Chris Double, Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax peg peg.parsers.private
-unicode.categories ;
-IN: peg.parsers
-
-HELP: 1token
-{ $values
- { "ch" "a character" }
- { "parser" "a parser" }
-} { $description
- "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' } ;
-
-HELP: (list-of)
-{ $values
- { "items" "a sequence" }
- { "separator" "a parser" }
- { "repeat1?" "a boolean" }
- { "parser" "a parser" }
-} { $description
- "Returns a parser that returns a list of items separated by the separator parser. Does not hide the separators."
-} { $see-also list-of list-of-many } ;
-
-HELP: list-of
-{ $values
- { "items" "a sequence" }
- { "separator" "a parser" }
- { "parser" "a parser" }
-} { $description
- "Returns a parser that returns a list of items separated by the separator parser. Hides the separators and matches a list of one or more items."
-} { $notes "Use " { $link list-of-many } " to ensure a list contains two or more items." }
-{ $examples
- { $example "USING: peg peg.parsers prettyprint ;" "\"a\" \"a\" token \",\" token list-of parse ." "V{ \"a\" }" }
- { $example "USING: peg peg.parsers prettyprint ;" "\"a,a,a,a\" \"a\" token \",\" token list-of parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
-} { $see-also list-of-many } ;
-
-HELP: list-of-many
-{ $values
- { "items" "a sequence" }
- { "separator" "a parser" }
- { "parser" "a parser" }
-} { $description
- "Returns a parser that returns a list of items separated by the separator parser. Hides the separators and matches a list of two or more items."
-} { $notes "Use " { $link list-of } " to return a list of only one item."
-} { $examples
- { $code "USING: peg peg.parsers prettyprint ;" "\"a\" \"a\" token \",\" token list-of-many parse => exception" }
- { $example "USING: peg peg.parsers prettyprint ;" "\"a,a,a,a\" \"a\" token \",\" token list-of-many parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
-} { $see-also list-of } ;
-
-HELP: epsilon
-{ $values
- { "parser" "a parser" }
-} { $description
- "Returns a parser that matches the empty sequence."
-} ;
-
-HELP: any-char
-{ $values
- { "parser" "a parser" }
-} { $description
- "Returns a parser that matches the any single character."
-} ;
-
-HELP: exactly-n
-{ $values
- { "parser" "a parser" }
- { "n" "an integer" }
- { "parser'" "a parser" }
-} { $description
- "Returns a parser that matches an exact repetition of the input parser."
-} { $examples
- { $code "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 4 exactly-n parse => exception" }
- { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 exactly-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
-} { $see-also at-least-n at-most-n from-m-to-n } ;
-
-HELP: at-least-n
-{ $values
- { "parser" "a parser" }
- { "n" "an integer" }
- { "parser'" "a parser" }
-} { $description
- "Returns a parser that matches n or more repetitions of the input parser."
-} { $examples
- { $code "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 4 at-least-n parse => exception"}
- { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 at-least-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
- { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 4 at-least-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" \"a\" }" }
-} { $see-also exactly-n at-most-n from-m-to-n } ;
-
-HELP: at-most-n
-{ $values
- { "parser" "a parser" }
- { "n" "an integer" }
- { "parser'" "a parser" }
-} { $description
- "Returns a parser that matches n or fewer repetitions of the input parser."
-} { $examples
- { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 at-most-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
- { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 4 at-most-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
-} { $see-also exactly-n at-least-n from-m-to-n } ;
-
-HELP: from-m-to-n
-{ $values
- { "parser" "a parser" }
- { "m" "an integer" }
- { "n" "an integer" }
- { "parser'" "a parser" }
-} { $description
- "Returns a parser that matches between and including m to n repetitions of the input parser."
-} { $examples
- { $example "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 3 4 from-m-to-n parse ." "V{ \"a\" \"a\" \"a\" }" }
- { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 3 4 from-m-to-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
- { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 3 4 from-m-to-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
-} { $see-also exactly-n at-most-n at-least-n } ;
-
-HELP: pack
-{ $values
- { "begin" "a parser" }
- { "body" "a parser" }
- { "end" "a parser" }
- { "parser" "a parser" }
-} { $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" }
-} { $see-also surrounded-by } ;
-
-HELP: surrounded-by
-{ $values
- { "parser" "a parser" }
- { "begin" "a string" }
- { "end" "a string" }
- { "parser'" "a parser" }
-} { $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" }
-} { $see-also pack } ;
-
-HELP: 'digit'
-{ $values
- { "parser" "a parser" }
-} { $description
- "Returns a parser that matches a single digit as defined by the " { $link digit? } " word."
-} { $see-also 'integer' } ;
-
-HELP: 'integer'
-{ $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' } ;
-
-HELP: 'string'
-{ $values
- { "parser" "a parser" }
-} { $description
- "Returns a parser that matches an string composed of a \", anything that is not \", and another \"."
-} { $see-also 'integer' } ;
-
-HELP: range-pattern
-{ $values
- { "pattern" "a string" }
- { "parser" "a parser" }
-} { $description
-"Returns a parser that matches a single character based on the set "
-"of characters in the pattern string."
-"Any single character in the pattern matches that character. "
-"If the pattern begins with a ^ then the set is negated "
-"(the element matches any character not in the set). Any pair "
-"of characters separated with a dash (-) represents the "
-"range of characters from the first to the second, inclusive."
-{ $examples
- { $example "USING: peg peg.parsers prettyprint strings ;" "\"a\" \"_a-zA-Z\" range-pattern parse 1string ." "\"a\"" }
- { $code "USING: peg peg.parsers prettyprint ;\n\"0\" \"^0-9\" range-pattern parse => exception"}
-}
-} ;
+++ /dev/null
-USING: kernel peg peg.parsers tools.test accessors ;
-IN: peg.parsers.tests
-
-{ V{ "a" } }
-[ "a" "a" token "," token list-of parse ] unit-test
-
-{ V{ "a" "a" "a" "a" } }
-[ "a,a,a,a" "a" token "," token list-of parse ] unit-test
-
-[ "a" "a" token "," token list-of-many parse ] must-fail
-
-{ V{ "a" "a" "a" "a" } }
-[ "a,a,a,a" "a" token "," token list-of-many parse ] unit-test
-
-[ "aaa" "a" token 4 exactly-n parse ] must-fail
-
-{ V{ "a" "a" "a" "a" } }
-[ "aaaa" "a" token 4 exactly-n parse ] unit-test
-
-[ "aaa" "a" token 4 at-least-n parse ] must-fail
-
-{ V{ "a" "a" "a" "a" } }
-[ "aaaa" "a" token 4 at-least-n parse ] unit-test
-
-{ V{ "a" "a" "a" "a" "a" } }
-[ "aaaaa" "a" token 4 at-least-n parse ] unit-test
-
-{ V{ "a" "a" "a" "a" } }
-[ "aaaa" "a" token 4 at-most-n parse ] unit-test
-
-{ V{ "a" "a" "a" "a" } }
-[ "aaaaa" "a" token 4 at-most-n parse ] unit-test
-
-{ V{ "a" "a" "a" } }
-[ "aaa" "a" token 3 4 from-m-to-n parse ] unit-test
-
-{ V{ "a" "a" "a" "a" } }
-[ "aaaa" "a" token 3 4 from-m-to-n parse ] unit-test
-
-{ V{ "a" "a" "a" "a" } }
-[ "aaaaa" "a" token 3 4 from-m-to-n parse ] unit-test
-
-{ 97 }
-[ "a" any-char parse ] unit-test
-
-{ V{ } }
-[ "" epsilon parse ] unit-test
-
-{ "a" } [
- "a" "a" token just parse
-] unit-test
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2007, 2008 Chris Double, Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences strings namespaces math assocs shuffle
- vectors arrays math.parser
- unicode.categories sequences.deep peg peg.private
- peg.search math.ranges words ;
-IN: peg.parsers
-
-TUPLE: just-parser p1 ;
-
-: just-pattern
- [
- execute dup [
- dup parse-result-remaining empty? [ drop f ] unless
- ] when
- ] ;
-
-
-M: just-parser (compile) ( parser -- quot )
- just-parser-p1 compile-parser just-pattern curry ;
-
-: just ( parser -- parser )
- just-parser boa wrap-peg ;
-
-: 1token ( ch -- parser ) 1string token ;
-
-: (list-of) ( items separator repeat1? -- parser )
- >r over 2seq r> [ repeat1 ] [ repeat0 ] if [ concat ] action 2seq
- [ unclip 1vector swap first append ] action ;
-
-: list-of ( items separator -- parser )
- hide f (list-of) ;
-
-: list-of-many ( items separator -- parser )
- hide t (list-of) ;
-
-: epsilon ( -- parser ) V{ } token ;
-
-: any-char ( -- parser ) [ drop t ] satisfy ;
-
-<PRIVATE
-
-: flatten-vectors ( pair -- vector )
- first2 over push-all ;
-
-PRIVATE>
-
-: exactly-n ( parser n -- parser' )
- swap <repetition> seq ;
-
-: at-most-n ( parser n -- parser' )
- dup zero? [
- 2drop epsilon
- ] [
- 2dup exactly-n
- -rot 1- at-most-n 2choice
- ] if ;
-
-: at-least-n ( parser n -- parser' )
- dupd exactly-n swap repeat0 2seq
- [ flatten-vectors ] action ;
-
-: from-m-to-n ( parser m n -- parser' )
- >r [ exactly-n ] 2keep r> swap - at-most-n 2seq
- [ flatten-vectors ] action ;
-
-: pack ( begin body end -- parser )
- >r >r hide r> r> hide 3seq [ first ] action ;
-
-: surrounded-by ( parser begin end -- parser' )
- [ token ] bi@ swapd pack ;
-
-: 'digit' ( -- parser )
- [ digit? ] satisfy [ digit> ] action ;
-
-: 'integer' ( -- parser )
- 'digit' repeat1 [ 10 digits>integer ] action ;
-
-: 'string' ( -- parser )
- [
- [ CHAR: " = ] satisfy hide ,
- [ CHAR: " = not ] satisfy repeat0 ,
- [ CHAR: " = ] satisfy hide ,
- ] seq* [ first >string ] action ;
-
-: (range-pattern) ( pattern -- string )
- #! Given a range pattern, produce a string containing
- #! all characters within that range.
- [
- any-char ,
- [ CHAR: - = ] satisfy hide ,
- any-char ,
- ] seq* [
- first2 [a,b] >string
- ] action
- replace ;
-
-: range-pattern ( pattern -- parser )
- #! 'pattern' is a set of characters describing the
- #! parser to be produced. Any single character in
- #! the pattern matches that character. If the pattern
- #! begins with a ^ then the set is negated (the element
- #! matches any character not in the set). Any pair of
- #! characters separated with a dash (-) represents the
- #! range of characters from the first to the second,
- #! inclusive.
- dup first CHAR: ^ = [
- rest (range-pattern) [ member? not ] curry satisfy
- ] [
- (range-pattern) [ member? ] curry satisfy
- ] if ;
+++ /dev/null
-! Copyright (C) 2007 Chris Double.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: help.markup help.syntax ;\r
-IN: peg\r
-\r
-HELP: parse\r
-{ $values \r
- { "input" "a string" } \r
- { "parser" "a parser" } \r
- { "ast" "an object" } \r
-}\r
-{ $description \r
- "Given the input string, parse it using the given parser. The result is the abstract "\r
- "syntax tree returned by the parser." } \r
-{ $see-also compile } ;\r
-\r
-HELP: compile\r
-{ $values \r
- { "parser" "a parser" } \r
- { "word" "a word" } \r
-}\r
-{ $description \r
- "Compile the parser to a word. The word will have stack effect ( -- ast )."\r
-} \r
-{ $see-also parse } ;\r
-\r
-HELP: token\r
-{ $values \r
- { "string" "a string" } \r
- { "parser" "a parser" } \r
-}\r
-{ $description \r
- "Returns a parser that matches the given string." } ;\r
-\r
-HELP: satisfy\r
-{ $values \r
- { "quot" "a quotation" } \r
- { "parser" "a parser" } \r
-}\r
-{ $description \r
- "Returns a parser that calls the quotation on the first character of the input string, "\r
- "succeeding if that quotation returns true. The AST is the character from the string." } ;\r
-\r
-HELP: range\r
-{ $values \r
- { "min" "a character" } \r
- { "max" "a character" } \r
- { "parser" "a parser" } \r
-}\r
-{ $description \r
- "Returns a parser that matches a single character that lies within the range of characters given, inclusive." }\r
-{ $examples { $code ": digit ( -- parser ) CHAR: 0 CHAR: 9 range ;" } } ;\r
-\r
-HELP: seq\r
-{ $values \r
- { "seq" "a sequence of parsers" } \r
- { "parser" "a parser" } \r
-}\r
-{ $description \r
- "Returns a parser that calls all parsers in the given sequence, in order. The parser succeeds if "\r
- "all the parsers succeed, otherwise it fails. The AST produced is a sequence of the AST produced by "\r
- "the individual parsers." } ;\r
-\r
-HELP: choice\r
-{ $values \r
- { "seq" "a sequence of parsers" } \r
- { "parser" "a parser" } \r
-}\r
-{ $description \r
- "Returns a parser that will try all the parsers in the sequence, in order, until one succeeds. "\r
- "The resulting AST is that produced by the successful parser." } ;\r
-\r
-HELP: repeat0\r
-{ $values \r
- { "parser" "a parser" } \r
-}\r
-{ $description \r
- "Returns a parser that parses 0 or more instances of the 'p1' parser. The AST produced is "\r
- "an array of the AST produced by the 'p1' parser. An empty array indicates 0 instances were "\r
- "parsed." } ;\r
-\r
-HELP: repeat1\r
-{ $values \r
- { "parser" "a parser" } \r
-}\r
-{ $description \r
- "Returns a parser that parses 1 or more instances of the 'p1' parser. The AST produced is "\r
- "an array of the AST produced by the 'p1' parser." } ;\r
-\r
-HELP: optional\r
-{ $values \r
- { "parser" "a parser" } \r
-}\r
-{ $description \r
- "Returns a parser that parses 0 or 1 instances of the 'p1' parser. The AST produced is "\r
- "'f' if 0 instances are parsed the AST produced is 'f', otherwise it is the AST produced by 'p1'." } ;\r
-\r
-HELP: semantic\r
-{ $values \r
- { "parser" "a parser" } \r
- { "quot" "a quotation with stack effect ( object -- bool )" } \r
-}\r
-{ $description \r
- "Returns a parser that succeeds if the 'p1' parser succeeds and the quotation called with "\r
- "the AST produced by 'p1' on the stack returns true." }\r
-{ $examples \r
- { $example "USING: kernel math peg prettyprint ;" "\"C\" [ drop t ] satisfy [ 66 > ] semantic parse ." "67" } \r
-} ;\r
-\r
-HELP: ensure\r
-{ $values \r
- { "parser" "a parser" } \r
-}\r
-{ $description \r
- "Returns a parser that succeeds if the 'p1' parser succeeds but does not add anything to the "\r
- "AST and does not move the location in the input string. This can be used for lookahead and "\r
- "disambiguation, along with the " { $link ensure-not } " word." }\r
-{ $examples { $code "\"0\" token ensure octal-parser" } } ;\r
-\r
-HELP: ensure-not\r
-{ $values \r
- { "parser" "a parser" } \r
-}\r
-{ $description \r
- "Returns a parser that succeeds if the 'p1' parser fails but does not add anything to the "\r
- "AST and does not move the location in the input string. This can be used for lookahead and "\r
- "disambiguation, along with the " { $link ensure } " word." }\r
-{ $code "\"+\" token \"=\" token ensure-not \"+=\" token 3array seq" } ;\r
-\r
-HELP: action\r
-{ $values \r
- { "parser" "a parser" } \r
- { "quot" "a quotation with stack effect ( ast -- ast )" } \r
-}\r
-{ $description \r
- "Returns a parser that calls the 'p1' parser and applies the quotation to the AST resulting "\r
- "from that parse. The result of the quotation is then used as the final AST. This can be used "\r
- "for manipulating the parse tree to produce a AST better suited for the task at hand rather than "\r
- "the default AST. If the quotation returns " { $link fail } " then the parser fails." }\r
-{ $code "CHAR: 0 CHAR: 9 range [ to-digit ] action" } ;\r
-\r
-HELP: sp\r
-{ $values \r
- { "parser" "a parser" } \r
-}\r
-{ $description \r
- "Returns a parser that calls the original parser 'p1' after stripping any whitespace "\r
- " from the left of the input string." } ;\r
-\r
-HELP: hide\r
-{ $values \r
- { "parser" "a parser" } \r
-}\r
-{ $description \r
- "Returns a parser that succeeds if the original parser succeeds, but does not " \r
- "put any result in the AST. Useful for ignoring 'syntax' in the AST." }\r
-{ $code "\"[\" token hide number \"]\" token hide 3array seq" } ;\r
-\r
-HELP: delay\r
-{ $values \r
- { "quot" "a quotation" } \r
- { "parser" "a parser" } \r
-}\r
-{ $description \r
- "Delays the construction of a parser until it is actually required to parse. This " \r
- "allows for calling a parser that results in a recursive call to itself. The quotation "\r
- "should return the constructed parser and is called the first time the parser is run."\r
- "The compiled result is memoized for future runs. See " { $link box } " for a word "\r
- "that calls the quotation at compile time." } ;\r
-\r
-HELP: box\r
-{ $values \r
- { "quot" "a quotation" } \r
- { "parser" "a parser" } \r
-}\r
-{ $description \r
- "Delays the construction of a parser until the parser is compiled. The quotation "\r
- "should return the constructed parser and is called when the parser is compiled."\r
- "The compiled result is memoized for future runs. See " { $link delay } " for a word "\r
- "that calls the quotation at runtime." } ;\r
+++ /dev/null
-! Copyright (C) 2007 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-!
-USING: kernel tools.test strings namespaces arrays sequences
- peg peg.private accessors words math accessors ;
-IN: peg.tests
-
-[
- "endbegin" "begin" token parse
-] must-fail
-
-{ "begin" "end" } [
- "beginend" "begin" token (parse)
- { ast>> remaining>> } get-slots
- >string
-] unit-test
-
-[
- "" CHAR: a CHAR: z range parse
-] must-fail
-
-[
- "1bcd" CHAR: a CHAR: z range parse
-] must-fail
-
-{ CHAR: a } [
- "abcd" CHAR: a CHAR: z range parse
-] unit-test
-
-{ CHAR: z } [
- "zbcd" CHAR: a CHAR: z range parse
-] unit-test
-
-[
- "bad" "a" token "b" token 2array seq parse
-] must-fail
-
-{ V{ "g" "o" } } [
- "good" "g" token "o" token 2array seq parse
-] unit-test
-
-{ "a" } [
- "abcd" "a" token "b" token 2array choice parse
-] unit-test
-
-{ "b" } [
- "bbcd" "a" token "b" token 2array choice parse
-] unit-test
-
-[
- "cbcd" "a" token "b" token 2array choice parse
-] must-fail
-
-[
- "" "a" token "b" token 2array choice parse
-] must-fail
-
-{ 0 } [
- "" "a" token repeat0 parse length
-] unit-test
-
-{ 0 } [
- "b" "a" token repeat0 parse length
-] unit-test
-
-{ V{ "a" "a" "a" } } [
- "aaab" "a" token repeat0 parse
-] unit-test
-
-[
- "" "a" token repeat1 parse
-] must-fail
-
-[
- "b" "a" token repeat1 parse
-] must-fail
-
-{ V{ "a" "a" "a" } } [
- "aaab" "a" token repeat1 parse
-] unit-test
-
-{ V{ "a" "b" } } [
- "ab" "a" token optional "b" token 2array seq parse
-] unit-test
-
-{ V{ f "b" } } [
- "b" "a" token optional "b" token 2array seq parse
-] unit-test
-
-[
- "cb" "a" token optional "b" token 2array seq parse
-] must-fail
-
-{ V{ CHAR: a CHAR: b } } [
- "ab" "a" token ensure CHAR: a CHAR: z range dup 3array seq parse
-] unit-test
-
-[
- "bb" "a" token ensure CHAR: a CHAR: z range 2array seq parse
-] must-fail
-
-{ t } [
- "a+b"
- "a" token "+" token dup ensure-not 2array seq "++" token 2array choice "b" token 3array seq
- parse [ t ] [ f ] if
-] unit-test
-
-{ t } [
- "a++b"
- "a" token "+" token dup ensure-not 2array seq "++" token 2array choice "b" token 3array seq
- parse [ t ] [ f ] if
-] unit-test
-
-{ t } [
- "a+b"
- "a" token "+" token "++" token 2array choice "b" token 3array seq
- parse [ t ] [ f ] if
-] unit-test
-
-[
- "a++b"
- "a" token "+" token "++" token 2array choice "b" token 3array seq
- parse [ t ] [ f ] if
-] must-fail
-
-{ 1 } [
- "a" "a" token [ drop 1 ] action parse
-] unit-test
-
-{ V{ 1 1 } } [
- "aa" "a" token [ drop 1 ] action dup 2array seq parse
-] unit-test
-
-[
- "b" "a" token [ drop 1 ] action parse
-] must-fail
-
-[
- "b" [ CHAR: a = ] satisfy parse
-] must-fail
-
-{ CHAR: a } [
- "a" [ CHAR: a = ] satisfy parse
-] unit-test
-
-{ "a" } [
- " a" "a" token sp parse
-] unit-test
-
-{ "a" } [
- "a" "a" token sp parse
-] unit-test
-
-{ V{ "a" } } [
- "[a]" "[" token hide "a" token "]" token hide 3array seq parse
-] unit-test
-
-[
- "a]" "[" token hide "a" token "]" token hide 3array seq parse
-] must-fail
-
-
-{ V{ "1" "-" "1" } V{ "1" "+" "1" } } [
- [
- [ "1" token , "-" token , "1" token , ] seq* ,
- [ "1" token , "+" token , "1" token , ] seq* ,
- ] choice*
- "1-1" over parse swap
- "1+1" swap parse
-] unit-test
-
-: expr ( -- parser )
- #! Test direct left recursion. Currently left recursion should cause a
- #! failure of that parser.
- [ expr ] delay "+" token "1" token 3seq "1" token 2choice ;
-
-{ V{ V{ "1" "+" "1" } "+" "1" } } [
- "1+1+1" expr parse
-] unit-test
-
-{ t } [
- #! Ensure a circular parser doesn't loop infinitely
- [ f , "a" token , ] seq*
- dup peg>> parsers>>
- dupd 0 swap set-nth compile word?
-] unit-test
-
-[
- "A" [ drop t ] satisfy [ 66 >= ] semantic parse
-] must-fail
-
-{ CHAR: B } [
- "B" [ drop t ] satisfy [ 66 >= ] semantic parse
-] unit-test
-
-{ f } [ \ + T{ parser f f f } equal? ] unit-test
\ No newline at end of file
+++ /dev/null
-Parsing Expression Grammar and Packrat Parser
+++ /dev/null
-text
-parsing
projects / factor.git / commitdiff