1 ! Copyright (C) 2004 Chris Double.
2 ! See http://factorcode.org/license.txt for BSD license.
4 USING: lazy-lists kernel sequences strings math io arrays errors namespaces ;
7 ! Parser combinator protocol
8 GENERIC: (parse) ( input parser -- list )
10 : parse ( input parser -- promise )
11 [ (parse) ] curry curry <promise> ;
13 TUPLE: parse-result parsed unparsed ;
15 : ?head-slice ( seq begin -- newseq ? )
16 2dup head? [ length tail-slice t ] [ drop f ] if ;
18 : unclip-slice ( seq -- rest first )
19 dup 1 tail-slice swap first ;
21 : h:t ( object -- head tail )
22 #! Return the head and tail of the object.
23 dup empty? [ dup first swap 1 tail ] unless ;
25 TUPLE: token-parser string ;
27 : token ( string -- parser )
30 M: token-parser (parse) ( input parser -- list )
31 token-parser-string swap over ?head-slice [
37 TUPLE: satisfy-parser quot ;
39 : satisfy ( quot -- parser )
42 M: satisfy-parser (parse) ( input parser -- list )
43 #! A parser that succeeds if the predicate,
44 #! when passed the first character in the input, returns
46 satisfy-parser-quot >r unclip-slice dup r> call [
47 swap <parse-result> 1list
52 TUPLE: epsilon-parser ;
57 M: epsilon-parser (parse) ( input parser -- list )
58 #! A parser that parses the empty string. It
59 #! does not consume any input and always returns
60 #! an empty list as the parse tree with the
62 drop "" swap <parse-result> 1list ;
64 TUPLE: succeed-parser result ;
66 : succeed ( result -- parser )
69 M: succeed-parser (parse) ( input parser -- list )
70 #! A parser that always returns 'result' as a
71 #! successful parse with no input consumed.
72 succeed-parser-result swap <parse-result> 1list ;
79 M: fail-parser (parse) ( input parser -- list )
80 #! A parser that always fails and returns
81 #! an empty list of successes.
84 TUPLE: and-parser p1 p2 ;
86 : <&> ( parser1 parser2 -- parser )
89 M: and-parser (parse) ( input parser -- list )
90 #! Parse 'input' by sequentially combining the
91 #! two parsers. First parser1 is applied to the
92 #! input then parser2 is applied to the rest of
93 #! the input strings from the first parser.
94 [ and-parser-p1 ] keep and-parser-p2 -rot parse [
95 dup parse-result-unparsed rot parse
97 >r parse-result-parsed r>
98 [ parse-result-parsed 2array ] keep
99 parse-result-unparsed <parse-result>
101 ] lmap-with lconcat ;
103 TUPLE: or-parser p1 p2 ;
105 : <|> ( parser1 parser2 -- parser )
108 M: or-parser (parse) ( input parser1 -- list )
109 #! Return the combined list resulting from the parses
110 #! of parser1 and parser2 being applied to the same
111 #! input. This implements the choice parsing operator.
112 [ or-parser-p1 ] keep or-parser-p2 >r dupd parse swap r> parse lappend ;
114 : string-ltrim ( string -- string )
115 #! Return a new string without any leading whitespace
116 #! from the original string.
117 dup first blank? [ 1 tail string-ltrim ] when ;
119 : sp-parser ( input parser -- result )
120 #! Skip all leading whitespace from the input then call
121 #! the parser on the remaining input.
122 >r string-ltrim r> call ;
124 : sp ( parser -- parser )
125 #! Return a parser that first skips all whitespace before
126 #! calling the original parser.
127 [ sp-parser ] curry ;
129 : just-parser ( input parser -- result )
130 #! Calls the given parser on the input removes
131 #! from the results anything where the remaining
132 #! input to be parsed is not empty. So ensures a
133 #! fully parsed input string.
134 call [ parse-result-unparsed empty? ] lsubset ;
136 : just ( parser -- parser )
137 #! Return an instance of the just-parser.
138 [ just-parser ] curry ;
140 : <@-parser ( input parser quot -- result )
141 #! Calls the parser on the input. For each successfull
142 #! parse the quot is call with the parse result on the stack.
143 #! The result of that quotation then becomes the new parse result.
144 #! This allows modification of parse tree results (like
145 #! converting strings to integers, etc).
147 [ parse-result-parsed swap call ] keep
148 parse-result-unparsed <parse-result>
151 : <@ ( parser quot -- parser )
152 #! Return an <@-parser.
153 [ <@-parser ] curry curry ;
155 : some-parser ( input parser -- result )
156 #! Calls the parser on the input, guarantees
157 #! the parse is complete (the remaining input is empty),
158 #! picks the first solution and only returns the parse
159 #! tree since the remaining input is empty.
160 just call car parse-result-parsed ;
162 : some ( parser -- deterministic-parser )
163 #! Creates a 'some-parser'.
164 [ some-parser ] curry ;
166 : <& ( parser1 parser2 -- parser )
167 #! Same as <&> except discard the results of the second parser.
170 : &> ( parser1 parser2 -- parser )
171 #! Same as <&> except discard the results of the first parser.
174 : <:&>-parser ( input parser1 parser2 -- result )
175 #! Same as <&> except flatten the result.
176 <&> [ dup second swap first [ % , ] { } make ] <@ call ;
178 : <:&> ( parser1 parser2 -- parser )
179 #! Same as <&> except flatten the result.
180 [ <:&>-parser ] curry curry ;
182 : <&:>-parser ( input parser1 parser2 -- result )
183 #! Same as <&> except flatten the result.
184 <&> [ dup second swap first [ , % ] { } make ] <@ call ;
186 : <&:> ( parser1 parser2 -- parser )
187 #! Same as <&> except flatten the result.
188 [ <&:>-parser ] curry curry ;
192 : (<*>) ( parser -- parser )
193 #! Non-delayed implementation of <*>
194 dup <*> <&:> [ ] succeed <|> ;
196 : <*> ( parser -- parser )
197 #! Return a parser that accepts zero or more occurences of the original
199 [ (<*>) call ] curry ;
201 : (<+>) ( parser -- parser )
202 #! Non-delayed implementation of <+>
205 : <+> ( parser -- parser )
206 #! Return a parser that accepts one or more occurences of the original
208 [ (<+>) call ] curry ;
210 : (<?>) ( parser -- parser )
211 #! Non-delayed implementation of <?>
212 [ unit ] <@ f succeed <|> ;
214 : <?> ( parser -- parser )
215 #! Return a parser that optionally uses the parser
216 #! if that parser would be successfull.
217 [ (<?>) call ] curry ;