move non-core peg parsers to peg.parsers

document and unit test peg.parsers
add just parser
db4
Doug Coleman 2008-03-03 13:28:53 -06:00
parent 8733b2e08b
commit 2f48327b47
4 changed files with 287 additions and 23 deletions

View File

@ -0,0 +1,149 @@
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax peg peg.parsers.private
unicode.categories ;
IN: peg.parsers
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" }
} { $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 "\"a\" \"a\" token \",\" token list-of parse parse-result-ast ." "V{ \"a\" }" }
{ $example "\"a,a,a,a\" \"a\" token \",\" token list-of parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
} { $see-also list-of-many } ;
HELP: list-of-many
{ $values
{ "items" "a sequence" }
{ "separator" "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
{ $example "\"a\" \"a\" token \",\" token list-of-many parse ." "f" }
{ $example "\"a,a,a,a\" \"a\" token \",\" token list-of-many parse parse-result-ast ." "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
{ $example "\"aaa\" \"a\" token 4 exactly-n parse ." "f" }
{ $example "\"aaaa\" \"a\" token 4 exactly-n parse parse-result-ast ." "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
{ $example "\"aaa\" \"a\" token 4 at-least-n parse ." "f" }
{ $example "\"aaaa\" \"a\" token 4 at-least-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
{ $example "\"aaaaa\" \"a\" token 4 at-least-n parse parse-result-ast ." "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 "\"aaaa\" \"a\" token 4 at-most-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
{ $example "\"aaaaa\" \"a\" token 4 at-most-n parse parse-result-ast ." "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 "\"aaa\" \"a\" token 3 4 from-m-to-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" }" }
{ $example "\"aaaa\" \"a\" token 3 4 from-m-to-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
{ $example "\"aaaaa\" \"a\" token 3 4 from-m-to-n parse parse-result-ast ." "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 "\"hi123bye\" \"hi\" token 'integer' \"bye\" token pack parse parse-result-ast ." "V{ 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 "\"hi123bye\" 'integer' \"hi\" \"bye\" surrounded-by parse parse-result-ast ." "V{ 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' } ;

View File

@ -0,0 +1,50 @@
USING: kernel peg peg.parsers tools.test ;
IN: peg.parsers.tests
[ V{ "a" } ]
[ "a" "a" token "," token list-of parse parse-result-ast ] unit-test
[ V{ "a" "a" "a" "a" } ]
[ "a,a,a,a" "a" token "," token list-of parse parse-result-ast ] unit-test
[ f ]
[ "a" "a" token "," token list-of-many parse ] unit-test
[ V{ "a" "a" "a" "a" } ]
[ "a,a,a,a" "a" token "," token list-of-many parse parse-result-ast ] unit-test
[ f ]
[ "aaa" "a" token 4 exactly-n parse ] unit-test
[ V{ "a" "a" "a" "a" } ]
[ "aaaa" "a" token 4 exactly-n parse parse-result-ast ] unit-test
[ f ]
[ "aaa" "a" token 4 at-least-n parse ] unit-test
[ V{ "a" "a" "a" "a" } ]
[ "aaaa" "a" token 4 at-least-n parse parse-result-ast ] unit-test
[ V{ "a" "a" "a" "a" "a" } ]
[ "aaaaa" "a" token 4 at-least-n parse parse-result-ast ] unit-test
[ V{ "a" "a" "a" "a" } ]
[ "aaaa" "a" token 4 at-most-n parse parse-result-ast ] unit-test
[ V{ "a" "a" "a" "a" } ]
[ "aaaaa" "a" token 4 at-most-n parse parse-result-ast ] unit-test
[ V{ "a" "a" "a" } ]
[ "aaa" "a" token 3 4 from-m-to-n parse parse-result-ast ] unit-test
[ V{ "a" "a" "a" "a" } ]
[ "aaaa" "a" token 3 4 from-m-to-n parse parse-result-ast ] unit-test
[ V{ "a" "a" "a" "a" } ]
[ "aaaaa" "a" token 3 4 from-m-to-n parse parse-result-ast ] unit-test
[ 97 ]
[ "a" any-char parse parse-result-ast ] unit-test
[ V{ } ]
[ "" epsilon parse parse-result-ast ] unit-test

View File

@ -0,0 +1,67 @@
! 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 combinators.lib memoize math.parser match
unicode.categories sequences.deep peg ;
IN: peg.parsers
<PRIVATE
MEMO: (list-of) ( items separator repeat1? -- parser )
>r over 2seq r> [ repeat1 ] [ repeat0 ] if [ concat ] action 2seq
[ unclip 1vector swap first append ] action ;
PRIVATE>
MEMO: list-of ( items separator -- parser )
hide f (list-of) ;
MEMO: list-of-many ( items separator -- parser )
hide t (list-of) ;
MEMO: epsilon ( -- parser ) V{ } token ;
MEMO: any-char ( -- parser ) [ drop t ] satisfy ;
<PRIVATE
: flatten-vectors ( pair -- vector )
first2 over push-all ;
PRIVATE>
MEMO: exactly-n ( parser n -- parser' )
swap <repetition> seq ;
MEMO: at-most-n ( parser n -- parser' )
dup zero? [
2drop epsilon
] [
2dup exactly-n
-rot 1- at-most-n 2choice
] if ;
MEMO: at-least-n ( parser n -- parser' )
dupd exactly-n swap repeat0 2seq
[ flatten-vectors ] action ;
MEMO: from-m-to-n ( parser m n -- parser' )
>r [ exactly-n ] 2keep r> swap - at-most-n 2seq
[ flatten-vectors ] action ;
MEMO: pack ( begin body end -- parser )
>r >r hide r> r> hide 3seq ;
MEMO: surrounded-by ( parser begin end -- parser' )
[ token ] 2apply swapd pack ;
MEMO: 'digit' ( -- parser )
[ digit? ] satisfy [ digit> ] action ;
MEMO: 'integer' ( -- parser )
'digit' repeat1 [ 10 digits>integer ] action ;
MEMO: 'string' ( -- parser )
[
[ CHAR: " = ] satisfy hide ,
[ CHAR: " = not ] satisfy repeat0 ,
[ CHAR: " = ] satisfy hide ,
] { } make seq [ first >string ] action ;

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences strings namespaces math assocs shuffle
vectors arrays combinators.lib memoize math.parser match
unicode.categories ;
unicode.categories sequences.lib ;
IN: peg
TUPLE: parse-result remaining ast ;
@ -292,6 +292,18 @@ M: delay-parser compile ( parser -- quot )
delay-parser-quot % \ compile , \ call ,
] [ ] make ;
TUPLE: just-parser p1 ;
: just-pattern
[
?quot call dup
[ parse-result-remaining empty? [ drop f ] unless ] [ f ] if*
] ;
M: just-parser compile ( parser -- quot )
just-parser-p1 compile \ ?quot just-pattern match-replace ;
PRIVATE>
MEMO: token ( string -- parser )
@ -312,6 +324,9 @@ MEMO: range ( min max -- parser )
: 3seq ( parser1 parser2 parser3 -- parser )
3array seq ;
: 4seq ( parser1 parser2 parser3 parser4 -- parser )
4array seq ;
: seq* ( quot -- paser )
{ } make seq ; inline
@ -324,6 +339,9 @@ MEMO: range ( min max -- parser )
: 3choice ( parser1 parser2 parser3 -- parser )
3array choice ;
: 4choice ( parser1 parser2 parser3 parser4 -- parser )
4array choice ;
: choice* ( quot -- paser )
{ } make choice ; inline
@ -354,25 +372,5 @@ MEMO: hide ( parser -- parser )
MEMO: delay ( parser -- parser )
delay-parser construct-boa init-parser ;
MEMO: (list-of) ( items separator repeat1? -- parser )
>r over 2seq r> [ repeat1 ] [ repeat0 ] if [ concat ] action 2seq
[ unclip 1vector swap first append ] action ;
MEMO: list-of ( items separator -- parser )
hide f (list-of) ;
MEMO: list-of* ( items separator -- parser )
hide t (list-of) ;
MEMO: 'digit' ( -- parser )
[ digit? ] satisfy [ digit> ] action ;
MEMO: 'integer' ( -- parser )
'digit' repeat1 [ 10 digits>integer ] action ;
MEMO: 'string' ( -- parser )
[
[ CHAR: " = ] satisfy hide ,
[ CHAR: " = not ] satisfy repeat0 ,
[ CHAR: " = ] satisfy hide ,
] { } make seq [ first >string ] action ;
MEMO: just ( parser -- parser )
just-parser construct-boa init-parser ;