1 "{ Package: 'squeak:petitparser' }" |
1 "{ Package: 'stx:goodies/petitparser' }" |
2 |
2 |
3 Object subclass:#PPParser |
3 Object subclass:#PPParser |
4 instanceVariableNames:'properties' |
4 instanceVariableNames:'properties' |
5 classVariableNames:'' |
5 classVariableNames:'' |
6 poolDictionaries:'' |
6 poolDictionaries:'' |
7 category:'PetitParser-Parsers' |
7 category:'PetitParser-Parsers' |
8 ! |
8 ! |
9 |
9 |
10 PPParser comment:'An abstract parser for all parsers in PetitParser. Subclasses implement #parseOn: to perform the actual recursive-descent parsing. All parsers support a variety of methods to perform an actual parse, see the methods in the #parsing protocol. Parsers are combined with a series of operators that can be found in the #operations protocol. |
10 PPParser comment:'An abstract parser for all parsers in PetitParser. Subclasses implement #parseOn: to perform the actual recursive-descent parsing. All parsers support a variety of methods to perform an actual parse, see the methods in the #parsing protocol. Parsers are combined with a series of operators that can be found in the #operations protocol. |
11 Instance Variables: |
11 Instance Variables: |
12 properties <Dictionary> Stores additional state in the parser object.' |
12 properties <Dictionary> Stores additional state in the parser object.' |
13 ! |
13 ! |
14 |
14 |
15 |
15 |
16 !PPParser class methodsFor:'instance creation'! |
16 !PPParser class methodsFor:'instance creation'! |
17 |
17 |
43 |
43 |
44 !PPParser methodsFor:'accessing-properties'! |
44 !PPParser methodsFor:'accessing-properties'! |
45 |
45 |
46 hasProperty: aKey |
46 hasProperty: aKey |
47 "Test if the property aKey is present." |
47 "Test if the property aKey is present." |
48 |
48 |
49 ^ properties notNil and: [ properties includesKey: aKey ] |
49 ^ properties notNil and: [ properties includesKey: aKey ] |
50 ! |
50 ! |
51 |
51 |
52 propertyAt: aKey |
52 propertyAt: aKey |
53 "Answer the property value associated with aKey." |
53 "Answer the property value associated with aKey." |
54 |
54 |
55 ^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ] |
55 ^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ] |
56 ! |
56 ! |
57 |
57 |
58 propertyAt: aKey ifAbsent: aBlock |
58 propertyAt: aKey ifAbsent: aBlock |
59 "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock." |
59 "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock." |
60 |
60 |
61 ^ properties isNil |
61 ^ properties isNil |
62 ifTrue: [ aBlock value ] |
62 ifTrue: [ aBlock value ] |
63 ifFalse: [ properties at: aKey ifAbsent: aBlock ] |
63 ifFalse: [ properties at: aKey ifAbsent: aBlock ] |
64 ! |
64 ! |
65 |
65 |
66 propertyAt: aKey ifAbsentPut: aBlock |
66 propertyAt: aKey ifAbsentPut: aBlock |
67 "Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value." |
67 "Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value." |
68 |
68 |
69 ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ] |
69 ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ] |
70 ! |
70 ! |
71 |
71 |
72 propertyAt: aKey put: anObject |
72 propertyAt: aKey put: anObject |
73 "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject." |
73 "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject." |
76 at: aKey put: anObject |
76 at: aKey put: anObject |
77 ! |
77 ! |
78 |
78 |
79 removeProperty: aKey |
79 removeProperty: aKey |
80 "Remove the property with aKey. Answer the property or raise an error if aKey isn't found." |
80 "Remove the property with aKey. Answer the property or raise an error if aKey isn't found." |
81 |
81 |
82 ^ self removeProperty: aKey ifAbsent: [ self error: 'Property not found' ] |
82 ^ self removeProperty: aKey ifAbsent: [ self error: 'Property not found' ] |
83 ! |
83 ! |
84 |
84 |
85 removeProperty: aKey ifAbsent: aBlock |
85 removeProperty: aKey ifAbsent: aBlock |
86 "Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock." |
86 "Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock." |
87 |
87 |
88 | answer | |
88 | answer | |
89 properties isNil ifTrue: [ ^ aBlock value ]. |
89 properties isNil ifTrue: [ ^ aBlock value ]. |
90 answer := properties removeKey: aKey ifAbsent: aBlock. |
90 answer := properties removeKey: aKey ifAbsent: aBlock. |
91 properties isEmpty ifTrue: [ properties := nil ]. |
91 properties isEmpty ifTrue: [ properties := nil ]. |
92 ^ answer |
92 ^ answer |
110 initialize |
110 initialize |
111 ! ! |
111 ! ! |
112 |
112 |
113 !PPParser methodsFor:'operations'! |
113 !PPParser methodsFor:'operations'! |
114 |
114 |
115 , aParser |
115 , aParser |
116 "Answer a new parser that parses the receiver followed by aParser." |
116 "Answer a new parser that parses the receiver followed by aParser." |
117 |
117 |
118 ^ PPSequenceParser with: self with: aParser |
118 ^ PPSequenceParser with: self with: aParser |
119 ! |
119 ! |
120 |
120 |
121 / aParser |
121 / aParser |
122 "Answer a new parser that parses the receiver, if the receiver fails try with aParser (ordered-choice)." |
122 "Answer a new parser that parses the receiver, if the receiver fails try with aParser (ordered-choice)." |
123 |
123 |
124 ^ PPChoiceParser with: self with: aParser |
124 ^ PPChoiceParser with: self with: aParser |
125 ! |
125 ! |
126 |
126 |
127 and |
127 and |
128 "Answer a new parser (logical and-predicate) that succeeds whenever the receiver does, but never consumes input." |
128 "Answer a new parser (logical and-predicate) that succeeds whenever the receiver does, but never consumes input." |
142 ^ PPEndOfInputParser on: self |
142 ^ PPEndOfInputParser on: self |
143 ! |
143 ! |
144 |
144 |
145 max: anInteger |
145 max: anInteger |
146 "Answer a new parser that parses the receiver at most anInteger times." |
146 "Answer a new parser that parses the receiver at most anInteger times." |
147 |
147 |
148 ^ PPRepeatingParser on: self max: anInteger |
148 ^ PPRepeatingParser on: self max: anInteger |
149 ! |
149 ! |
150 |
150 |
151 memoized |
151 memoized |
152 "Answer a new memoized parser, for refraining redundant computations. This ensures polynomial time O(n^4) for left-recursive grammars and O(n^3) for non left-recursive grammars in the worst case. Not necessary for most grammars that are carefully written and in O(n) anyway." |
152 "Answer a new memoized parser, for refraining redundant computations. This ensures polynomial time O(n^4) for left-recursive grammars and O(n^3) for non left-recursive grammars in the worst case. Not necessary for most grammars that are carefully written and in O(n) anyway." |
153 |
153 |
154 ^ PPMemoizedParser on: self |
154 ^ PPMemoizedParser on: self |
155 ! |
155 ! |
156 |
156 |
157 min: anInteger |
157 min: anInteger |
158 "Answer a new parser that parses the receiver at least anInteger times." |
158 "Answer a new parser that parses the receiver at least anInteger times." |
159 |
159 |
160 ^ PPRepeatingParser on: self min: anInteger |
160 ^ PPRepeatingParser on: self min: anInteger |
161 ! |
161 ! |
162 |
162 |
163 min: aMinInteger max: aMaxInteger |
163 min: aMinInteger max: aMaxInteger |
164 "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times." |
164 "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times." |
165 |
165 |
166 ^ PPRepeatingParser on: self min: aMinInteger max: aMaxInteger |
166 ^ PPRepeatingParser on: self min: aMinInteger max: aMaxInteger |
167 ! |
167 ! |
168 |
168 |
169 negate |
169 negate |
170 "Answer a new parser consumes any input token but the receiver." |
170 "Answer a new parser consumes any input token but the receiver." |
171 |
171 |
172 ^ self not , #any asParser ==> #second |
172 ^ self not , #any asParser ==> #second |
173 ! |
173 ! |
174 |
174 |
175 not |
175 not |
176 "Answer a new parser (logical not-predicate) that succeeds whenever the receiver fails, but never consumes input." |
176 "Answer a new parser (logical not-predicate) that succeeds whenever the receiver fails, but never consumes input." |
190 ^ self min: 1 |
190 ^ self min: 1 |
191 ! |
191 ! |
192 |
192 |
193 plusGreedy: aParser |
193 plusGreedy: aParser |
194 "Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed." |
194 "Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed." |
195 |
195 |
196 ^ self , (self starGreedy: aParser) map: [ :first :rest | rest copyWithFirst: first ] |
196 ^ self , (self starGreedy: aParser) map: [ :first :rest | rest copyWithFirst: first ] |
197 ! |
197 ! |
198 |
198 |
199 plusLazy: aParser |
199 plusLazy: aParser |
200 "Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed." |
200 "Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed." |
201 |
201 |
202 ^ self , (self starLazy: aParser) map: [ :first :rest | rest copyWithFirst: first ] |
202 ^ self , (self starLazy: aParser) map: [ :first :rest | rest copyWithFirst: first ] |
203 ! |
203 ! |
204 |
204 |
205 star |
205 star |
206 "Answer a new parser that parses the receiver zero or more times. This is a greedy and blind implementation that tries to consume as much input as possible and it does not consider what comes afterwards." |
206 "Answer a new parser that parses the receiver zero or more times. This is a greedy and blind implementation that tries to consume as much input as possible and it does not consider what comes afterwards." |
208 ^ PPRepeatingParser on: self |
208 ^ PPRepeatingParser on: self |
209 ! |
209 ! |
210 |
210 |
211 starGreedy: aParser |
211 starGreedy: aParser |
212 "Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed." |
212 "Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed." |
213 |
213 |
214 | parser | |
214 | parser | |
215 parser := PPChoiceParser new. |
215 parser := PPChoiceParser new. |
216 parser setParsers: (Array |
216 parser setParsers: (Array |
217 with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ]) |
217 with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ]) |
218 with: (aParser and ==> [ :each | OrderedCollection new ])). |
218 with: (aParser and ==> [ :each | OrderedCollection new ])). |
219 ^ parser ==> [ :rest | rest asArray ] |
219 ^ parser ==> [ :rest | rest asArray ] |
220 ! |
220 ! |
221 |
221 |
222 starLazy: aParser |
222 starLazy: aParser |
223 "Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed." |
223 "Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed." |
224 |
224 |
225 | parser | |
225 | parser | |
226 parser := PPChoiceParser new. |
226 parser := PPChoiceParser new. |
227 parser setParsers: (Array |
227 parser setParsers: (Array |
228 with: (aParser and ==> [ :each | OrderedCollection new ]) |
228 with: (aParser and ==> [ :each | OrderedCollection new ]) |
229 with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ])). |
229 with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ])). |
230 ^ parser ==> [ :rest | rest asArray ] |
230 ^ parser ==> [ :rest | rest asArray ] |
231 ! |
231 ! |
232 |
232 |
233 times: anInteger |
233 times: anInteger |
234 "Answer a new parser that parses the receiver exactly anInteger times." |
234 "Answer a new parser that parses the receiver exactly anInteger times." |
235 |
235 |
236 ^ self min: anInteger max: anInteger |
236 ^ self min: anInteger max: anInteger |
237 ! |
237 ! |
238 |
238 |
239 wrapped |
239 wrapped |
240 "Answer a new parser that is simply wrapped." |
240 "Answer a new parser that is simply wrapped." |
241 |
241 |
242 ^ PPDelegateParser on: self |
242 ^ PPDelegateParser on: self |
243 ! |
243 ! |
244 |
244 |
245 | aParser |
245 | aParser |
246 "Answer a new parser that either parses the receiver or aParser. Fail if both pass or fail (exclusive choice, unordered choice)." |
246 "Answer a new parser that either parses the receiver or aParser. Fail if both pass or fail (exclusive choice, unordered choice)." |
250 |
250 |
251 !PPParser methodsFor:'operations-convenience'! |
251 !PPParser methodsFor:'operations-convenience'! |
252 |
252 |
253 delimitedBy: aParser |
253 delimitedBy: aParser |
254 "Answer a new parser that parses the receiver one or more times, separated and possibly ended by aParser." |
254 "Answer a new parser that parses the receiver one or more times, separated and possibly ended by aParser." |
255 |
255 |
256 ^ (self separatedBy: aParser) , (aParser optional) ==> [ :node | |
256 ^ (self separatedBy: aParser) , (aParser optional) ==> [ :node | |
257 node second isNil |
257 node second isNil |
258 ifTrue: [ node first ] |
258 ifTrue: [ node first ] |
259 ifFalse: [ node first copyWith: node second ] ] |
259 ifFalse: [ node first copyWith: node second ] ] |
260 ! |
260 ! |
261 |
261 |
262 separatedBy: aParser |
262 separatedBy: aParser |
263 "Answer a new parser that parses the receiver one or more times, separated by aParser." |
263 "Answer a new parser that parses the receiver one or more times, separated by aParser." |
264 |
264 |
265 ^ (PPSequenceParser with: self with: (PPSequenceParser with: aParser with: self) star) ==> [ :nodes | |
265 ^ (PPSequenceParser with: self with: (PPSequenceParser with: aParser with: self) star) ==> [ :nodes | |
266 | result | |
266 | result | |
267 result := Array new: 2 * nodes second size + 1. |
267 result := Array new: 2 * nodes second size + 1. |
268 result at: 1 put: nodes first. |
268 result at: 1 put: nodes first. |
269 nodes second |
269 nodes second |
270 keysAndValuesDo: [ :index :pair | result replaceFrom: 2 * index to: 2 * index + 1 with: pair startingAt: 1 ]. |
270 keysAndValuesDo: [ :index :pair | result replaceFrom: 2 * index to: 2 * index + 1 with: pair startingAt: 1 ]. |
271 result ] |
271 result ] |
272 ! ! |
272 ! ! |
273 |
273 |
274 !PPParser methodsFor:'operations-mapping'! |
274 !PPParser methodsFor:'operations-mapping'! |
291 ^ self ==> [ :nodes | anObject ] |
291 ^ self ==> [ :nodes | anObject ] |
292 ! |
292 ! |
293 |
293 |
294 flatten |
294 flatten |
295 "Answer a new parser that flattens the underlying collection." |
295 "Answer a new parser that flattens the underlying collection." |
296 |
296 |
297 ^ PPFlattenParser on: self |
297 ^ PPFlattenParser on: self |
298 ! |
298 ! |
299 |
299 |
300 foldLeft: aBlock |
300 foldLeft: aBlock |
301 "Answer a new parser that that folds the result of the receiver from left-to-right into aBlock. The argument aBlock must take two or more arguments." |
301 "Answer a new parser that that folds the result of the receiver from left-to-right into aBlock. The argument aBlock must take two or more arguments." |
302 |
302 |
303 | size args | |
303 | size args | |
304 size := aBlock numArgs. |
304 size := aBlock numArgs. |
305 args := Array new: size. |
305 args := Array new: size. |
306 ^ self ==> [ :nodes | |
306 ^ self ==> [ :nodes | |
307 args at: 1 put: (nodes at: 1). |
307 args at: 1 put: (nodes at: 1). |
327 args at: size ] |
327 args at: size ] |
328 ! |
328 ! |
329 |
329 |
330 map: aBlock |
330 map: aBlock |
331 "Answer a new parser that works on the receiving sequence an passes in each element as a block argument." |
331 "Answer a new parser that works on the receiving sequence an passes in each element as a block argument." |
332 |
332 |
333 ^ self ==> aBlock |
333 ^ self ==> aBlock |
334 ! |
334 ! |
335 |
335 |
336 token |
336 token |
337 "Answer a new parser that transforms the input to a token." |
337 "Answer a new parser that transforms the input to a token." |
338 |
338 |
339 ^ PPTokenParser on: self |
339 ^ PPTokenParser on: self |
340 ! |
340 ! |
341 |
341 |
342 token: aTokenClass |
342 token: aTokenClass |
343 "Answer a new parser that transforms the input to a token of class aTokenClass." |
343 "Answer a new parser that transforms the input to a token of class aTokenClass." |
344 |
344 |
345 ^ self token tokenClass: aTokenClass |
345 ^ self token tokenClass: aTokenClass |
346 ! |
346 ! |
347 |
347 |
348 trim |
348 trim |
349 "Answer a new parser that consumes spaces before and after the receiving parser." |
349 "Answer a new parser that consumes spaces before and after the receiving parser." |
350 |
350 |
351 ^ self trimSpaces |
351 ^ self trimSpaces |
352 ! |
352 ! |
353 |
353 |
354 trimBlanks |
354 trimBlanks |
355 "Answer a new parser that consumes blanks before and after the receiving parser." |
355 "Answer a new parser that consumes blanks before and after the receiving parser." |
356 |
356 |
357 ^ PPTrimmingParser on: self trimmer: #blank asParser |
357 ^ PPTrimmingParser on: self trimmer: #blank asParser |
358 ! |
358 ! |
359 |
359 |
360 trimSpaces |
360 trimSpaces |
361 "Answer a new parser that consumes spaces before and after the receiving parser." |
361 "Answer a new parser that consumes spaces before and after the receiving parser." |
362 |
362 |
363 ^ PPTrimmingParser on: self trimmer: #space asParser |
363 ^ PPTrimmingParser on: self trimmer: #space asParser |
364 ! ! |
364 ! ! |
365 |
365 |
366 !PPParser methodsFor:'parsing'! |
366 !PPParser methodsFor:'parsing'! |
367 |
367 |
368 matches: anObject |
368 matches: anObject |
369 "Answer if anObject can be parsed by the receiver." |
369 "Answer if anObject can be parsed by the receiver." |
370 |
370 |
371 ^ (self parse: anObject) isPetitFailure not |
371 ^ (self parse: anObject) isPetitFailure not |
372 ! |
372 ! |
373 |
373 |
374 matchesIn: anObject |
374 matchesIn: anObject |
375 "Search anObject repeatedly for the matches of the receiver." |
375 "Search anObject repeatedly for the matches of the receiver." |
376 |
376 |
377 | result | |
377 | result | |
378 result := OrderedCollection new. |
378 result := OrderedCollection new. |
379 self |
379 self |
380 matchesIn: anObject |
380 matchesIn: anObject |
381 do: [ :each | result addLast: each ]. |
381 do: [ :each | result addLast: each ]. |
382 ^ result |
382 ^ result |
383 ! |
383 ! |
384 |
384 |
388 ((self and ==> aBlock , #any asParser) / #any asParser) star parse: anObject |
388 ((self and ==> aBlock , #any asParser) / #any asParser) star parse: anObject |
389 ! |
389 ! |
390 |
390 |
391 matchingRangesIn: anObject |
391 matchingRangesIn: anObject |
392 "Search anObject repeatedly for the matches of the receiver. Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)." |
392 "Search anObject repeatedly for the matches of the receiver. Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)." |
393 |
393 |
394 | result | |
394 | result | |
395 result := OrderedCollection new. |
395 result := OrderedCollection new. |
396 self |
396 self |
397 matchingRangesIn: anObject |
397 matchingRangesIn: anObject |
398 do: [ :value | result addLast: value ]. |
398 do: [ :value | result addLast: value ]. |
399 ^ result |
399 ^ result |
400 ! |
400 ! |
401 |
401 |
402 matchingRangesIn: anObject do: aBlock |
402 matchingRangesIn: anObject do: aBlock |
403 "Search anObject repeatedly for the matches of the receiver. Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)." |
403 "Search anObject repeatedly for the matches of the receiver. Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)." |
404 |
404 |
405 | result | |
405 | result | |
406 result := OrderedCollection new. |
406 result := OrderedCollection new. |
407 [ :stream | stream position + 1 ] asParser , self , [ :stream | stream position ] asParser |
407 [ :stream | stream position + 1 ] asParser , self , [ :stream | stream position ] asParser |
408 matchesIn: anObject |
408 matchesIn: anObject |
409 do: [ :value | aBlock value: (value first to: value last) ]. |
409 do: [ :value | aBlock value: (value first to: value last) ]. |
410 ^ result |
410 ^ result |
411 ! |
411 ! |
412 |
412 |
413 parse: anObject |
413 parse: anObject |
414 "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure." |
414 "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure." |
415 |
415 |
416 ^ self parseOn: anObject asPetitStream |
416 ^ self parseOn: anObject asPetitStream |
417 ! |
417 ! |
418 |
418 |
419 parse: anObject onError: aBlock |
419 parse: anObject onError: aBlock |
420 "Parse anObject with the receiving parser and answer the parse-result or answer the result of evaluating aBlock. Depending on the number of arguments of the block it is simply evaluated, evaluated with the failure object, or evaluated with the error message and position." |
420 "Parse anObject with the receiving parser and answer the parse-result or answer the result of evaluating aBlock. Depending on the number of arguments of the block it is simply evaluated, evaluated with the failure object, or evaluated with the error message and position." |
421 |
421 |
422 | result | |
422 | result | |
423 result := self parse: anObject. |
423 result := self parse: anObject. |
424 result isPetitFailure |
424 result isPetitFailure |
425 ifFalse: [ ^ result ]. |
425 ifFalse: [ ^ result ]. |
426 aBlock numArgs = 0 |
426 aBlock numArgs = 0 |
430 ^ aBlock value: result message value: result position |
430 ^ aBlock value: result message value: result position |
431 ! |
431 ! |
432 |
432 |
433 parseOn: aStream |
433 parseOn: aStream |
434 "Parse aStream with the receiving parser and answer the parse-result or an instance of PPFailure. Override this method in subclasses to specify custom parse behavior. Do not call this method from outside, instead use #parse:." |
434 "Parse aStream with the receiving parser and answer the parse-result or an instance of PPFailure. Override this method in subclasses to specify custom parse behavior. Do not call this method from outside, instead use #parse:." |
435 |
435 |
436 self subclassResponsibility |
436 self subclassResponsibility |
437 ! ! |
437 ! ! |
438 |
438 |
439 !PPParser methodsFor:'printing'! |
439 !PPParser methodsFor:'printing'! |
440 |
440 |