1 ! Copyright (C) 2007, 2008 Chris Double, Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel sequences strings namespaces math assocs shuffle
4 vectors arrays math.parser
5 unicode.categories sequences.deep peg peg.private
6 peg.search math.ranges words ;
9 TUPLE: just-parser p1 ;
14 dup parse-result-remaining empty? [ drop f ] unless
19 M: just-parser (compile) ( parser -- quot )
20 just-parser-p1 compile-parser just-pattern curry ;
22 : just ( parser -- parser )
23 just-parser boa wrap-peg ;
25 : 1token ( ch -- parser ) 1string token ;
27 : (list-of) ( items separator repeat1? -- parser )
28 >r over 2seq r> [ repeat1 ] [ repeat0 ] if [ concat ] action 2seq
29 [ unclip 1vector swap first append ] action ;
31 : list-of ( items separator -- parser )
34 : list-of-many ( items separator -- parser )
37 : epsilon ( -- parser ) V{ } token ;
39 : any-char ( -- parser ) [ drop t ] satisfy ;
43 : flatten-vectors ( pair -- vector )
44 first2 over push-all ;
48 : exactly-n ( parser n -- parser' )
49 swap <repetition> seq ;
51 : at-most-n ( parser n -- parser' )
56 -rot 1- at-most-n 2choice
59 : at-least-n ( parser n -- parser' )
60 dupd exactly-n swap repeat0 2seq
61 [ flatten-vectors ] action ;
63 : from-m-to-n ( parser m n -- parser' )
64 >r [ exactly-n ] 2keep r> swap - at-most-n 2seq
65 [ flatten-vectors ] action ;
67 : pack ( begin body end -- parser )
68 >r >r hide r> r> hide 3seq [ first ] action ;
70 : surrounded-by ( parser begin end -- parser' )
71 [ token ] bi@ swapd pack ;
73 : 'digit' ( -- parser )
74 [ digit? ] satisfy [ digit> ] action ;
76 : 'integer' ( -- parser )
77 'digit' repeat1 [ 10 digits>integer ] action ;
79 : 'string' ( -- parser )
81 [ CHAR: " = ] satisfy hide ,
82 [ CHAR: " = not ] satisfy repeat0 ,
83 [ CHAR: " = ] satisfy hide ,
84 ] seq* [ first >string ] action ;
86 : (range-pattern) ( pattern -- string )
87 #! Given a range pattern, produce a string containing
88 #! all characters within that range.
91 [ CHAR: - = ] satisfy hide ,
98 : range-pattern ( pattern -- parser )
99 #! 'pattern' is a set of characters describing the
100 #! parser to be produced. Any single character in
101 #! the pattern matches that character. If the pattern
102 #! begins with a ^ then the set is negated (the element
103 #! matches any character not in the set). Any pair of
104 #! characters separated with a dash (-) represents the
105 #! range of characters from the first to the second,
107 dup first CHAR: ^ = [
108 rest (range-pattern) [ member? not ] curry satisfy
110 (range-pattern) [ member? ] curry satisfy