|
1 "{ Package: 'stx:goodies/petitparser/analyzer' }"! |
|
2 |
|
3 !PPActionParser methodsFor:'*petitanalyzer-matching'! |
|
4 |
|
5 match: aParser inContext: aDictionary seen: anIdentitySet |
|
6 ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ] |
|
7 ! ! |
|
8 |
|
9 !PPDelegateParser methodsFor:'*petitanalyzer-transforming'! |
|
10 |
|
11 replace: aParser with: anotherParser |
|
12 super replace: aParser with: anotherParser. |
|
13 parser == aParser ifTrue: [ parser := anotherParser ] |
|
14 ! ! |
|
15 |
|
16 !PPEpsilonParser methodsFor:'*petitanalyzer-testing'! |
|
17 |
|
18 isNullable |
|
19 ^ true |
|
20 ! ! |
|
21 |
|
22 !PPFailingParser methodsFor:'*petitanalyzer-matching'! |
|
23 |
|
24 match: aParser inContext: aDictionary seen: anIdentitySet |
|
25 ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self message = aParser message ] |
|
26 ! ! |
|
27 |
|
28 !PPLimitedRepeatingParser methodsFor:'*petitanalyzer-transforming'! |
|
29 |
|
30 replace:aParser with:anotherParser |
|
31 super replace:aParser with:anotherParser. |
|
32 limit == aParser ifTrue:[limit := anotherParser]. |
|
33 ! ! |
|
34 |
|
35 !PPListParser methodsFor:'*petitanalyzer-matching'! |
|
36 |
|
37 copyInContext: aDictionary seen: aSeenDictionary |
|
38 | copy copies | |
|
39 aSeenDictionary at: self ifPresent: [ :value | ^ value ]. |
|
40 copy := aSeenDictionary at: self put: self copy. |
|
41 copies := OrderedCollection new. |
|
42 parsers do: [ :each | |
|
43 | result | |
|
44 result := each |
|
45 copyInContext: aDictionary |
|
46 seen: aSeenDictionary. |
|
47 result isCollection |
|
48 ifTrue: [ copies addAll: result ] |
|
49 ifFalse: [ copies add: result ] ]. |
|
50 ^ copy |
|
51 setParsers: copies; |
|
52 yourself |
|
53 ! ! |
|
54 |
|
55 !PPListParser methodsFor:'*petitanalyzer-transforming'! |
|
56 |
|
57 replace: aParser with: anotherParser |
|
58 super replace: aParser with: anotherParser. |
|
59 parsers keysAndValuesDo: [ :index :parser | |
|
60 parser == aParser |
|
61 ifTrue: [ parsers at: index put: anotherParser ] ] |
|
62 ! ! |
|
63 |
|
64 !PPLiteralParser methodsFor:'*petitanalyzer-matching'! |
|
65 |
|
66 match: aParser inContext: aDictionary seen: anIdentitySet |
|
67 ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self literal = aParser literal and: [ self message = aParser message ] ] |
|
68 ! ! |
|
69 |
|
70 !PPOptionalParser methodsFor:'*petitanalyzer-testing'! |
|
71 |
|
72 isNullable |
|
73 ^ true |
|
74 ! ! |
|
75 |
|
76 !PPParser methodsFor:'*petitanalyzer-named'! |
|
77 |
|
78 allNamedParsers |
|
79 "Answer all the named parse nodes of the receiver." |
|
80 |
|
81 | result | |
|
82 result := OrderedCollection new. |
|
83 self allNamedParsersDo: [ :parser | result addLast: parser ]. |
|
84 ^ result |
|
85 ! ! |
|
86 |
|
87 !PPParser methodsFor:'*petitanalyzer-named'! |
|
88 |
|
89 allNamedParsersDo: aBlock |
|
90 "Iterate over all the named parse nodes of the receiver." |
|
91 |
|
92 self allParsersDo: [ :each | |
|
93 each name notNil |
|
94 ifTrue: [ aBlock value: each ] ] |
|
95 ! ! |
|
96 |
|
97 !PPParser methodsFor:'*petitanalyzer-enumerating'! |
|
98 |
|
99 allParsers |
|
100 "Answer all the parse nodes of the receiver." |
|
101 |
|
102 | result | |
|
103 result := OrderedCollection new. |
|
104 self allParsersDo: [ :parser | result addLast: parser ]. |
|
105 ^ result |
|
106 ! ! |
|
107 |
|
108 !PPParser methodsFor:'*petitanalyzer-enumerating'! |
|
109 |
|
110 allParsersDo: aBlock |
|
111 "Iterate over all the parse nodes of the receiver." |
|
112 |
|
113 self allParsersDo: aBlock seen: IdentitySet new |
|
114 ! ! |
|
115 |
|
116 !PPParser methodsFor:'*petitanalyzer-enumerating'! |
|
117 |
|
118 allParsersDo: aBlock seen: aSet |
|
119 "Iterate over all the parse nodes of the receiver, do not visit and follow the ones contained in aSet." |
|
120 |
|
121 (aSet includes: self) |
|
122 ifTrue: [ ^ self ]. |
|
123 aSet add: self. |
|
124 aBlock value: self. |
|
125 self children |
|
126 do: [ :each | each allParsersDo: aBlock seen: aSet ] |
|
127 ! ! |
|
128 |
|
129 !PPParser methodsFor:'*petitanalyzer-matching'! |
|
130 |
|
131 copyInContext: aDictionary |
|
132 ^ self copyInContext: aDictionary seen: IdentityDictionary new |
|
133 ! ! |
|
134 |
|
135 !PPParser methodsFor:'*petitanalyzer-matching'! |
|
136 |
|
137 copyInContext: aDictionary seen: aSeenDictionary |
|
138 | copy | |
|
139 aSeenDictionary |
|
140 at: self |
|
141 ifPresent: [ :value | ^ value ]. |
|
142 copy := aSeenDictionary |
|
143 at: self |
|
144 put: self copy. |
|
145 copy children do: [ :each | |
|
146 copy |
|
147 replace: each |
|
148 with: (each copyInContext: aDictionary seen: aSeenDictionary) ]. |
|
149 ^ copy |
|
150 ! ! |
|
151 |
|
152 !PPParser methodsFor:'*petitanalyzer-querying'! |
|
153 |
|
154 cycleSet |
|
155 "Answer a set of all nodes that are within one or more cycles of left-recursion. This is generally not a problem if at least one of the nodes is memoized, but it might make the grammar very inefficient and should be avoided if possible." |
|
156 |
|
157 | cycles | |
|
158 cycles := IdentitySet new. |
|
159 self cycleSet: OrderedCollection new firstSets: self firstSets into: cycles. |
|
160 ^ cycles |
|
161 ! ! |
|
162 |
|
163 !PPParser methodsFor:'*petitanalyzer-private'! |
|
164 |
|
165 cycleSet: aDictionary |
|
166 "PRIVATE: Answer the children that could be part of a cycle-set with the receiver, subclasses might restrict the number of children returned. aDictionary is pre-calcualted first-sets." |
|
167 |
|
168 ^ self children |
|
169 ! ! |
|
170 |
|
171 !PPParser methodsFor:'*petitanalyzer-private'! |
|
172 |
|
173 cycleSet: aStack firstSets: aDictionary into: aSet |
|
174 "PRIVATE: Try to find a cycle, where aStack contains the previously visited parsers. The method returns quickly when the receiver is a terminal, terminals cannot be part of a cycle. If aStack already contains the receiver, then we are in a cycle. In this case we don't process the children further and add the nodes to aSet." |
|
175 |
|
176 | index | |
|
177 self isTerminal |
|
178 ifTrue: [ ^ self ]. |
|
179 (index := aStack indexOf: self) > 0 |
|
180 ifTrue: [ ^ aSet addAll: (aStack copyFrom: index to: aStack size) ]. |
|
181 aStack addLast: self. |
|
182 (self cycleSet: aDictionary) |
|
183 do: [ :each | each cycleSet: aStack firstSets: aDictionary into: aSet ]. |
|
184 aStack removeLast |
|
185 ! ! |
|
186 |
|
187 !PPParser methodsFor:'*petitanalyzer-querying'! |
|
188 |
|
189 firstSet |
|
190 "Answer the first-set of the receiver. Note, this implementation is inefficient when called on different receivers of the same grammar, instead use #firstSets to calculate the first-sets at once." |
|
191 |
|
192 ^ self firstSets at: self |
|
193 ! ! |
|
194 |
|
195 !PPParser methodsFor:'*petitanalyzer-querying'! |
|
196 |
|
197 firstSets |
|
198 "Answer a dictionary with all the parsers reachable from the receiver as key and their first-set as value. The first-set of a parser is the list of terminal parsers that begin the parser derivable from that parser." |
|
199 |
|
200 | firstSets | |
|
201 firstSets := IdentityDictionary new. |
|
202 self allParsersDo: [ :each | |
|
203 firstSets at: each put: (each isTerminal |
|
204 ifTrue: [ IdentitySet with: each ] |
|
205 ifFalse: [ IdentitySet new ]). |
|
206 each isNullable |
|
207 ifTrue: [ (firstSets at: each) add: PPSentinel instance ] ]. |
|
208 [ | changed tally | |
|
209 changed := false. |
|
210 firstSets keysAndValuesDo: [ :parser :first | |
|
211 tally := first size. |
|
212 parser firstSets: firstSets into: first. |
|
213 changed := changed or: [ tally ~= first size ] ]. |
|
214 changed ] whileTrue. |
|
215 ^ firstSets |
|
216 ! ! |
|
217 |
|
218 !PPParser methodsFor:'*petitanalyzer-private'! |
|
219 |
|
220 firstSets: aFirstDictionary into: aSet |
|
221 "PRIVATE: Try to add additional elements to the first-set aSet of the receiver, use the incomplete aFirstDictionary." |
|
222 |
|
223 self children do: [ :parser | aSet addAll: (aFirstDictionary at: parser) ] |
|
224 ! ! |
|
225 |
|
226 !PPParser methodsFor:'*petitanalyzer-querying'! |
|
227 |
|
228 followSet |
|
229 "Answer the follow-set of the receiver starting at the receiver. Note, this implementation is inefficient when called on different receivers of the same grammar, instead use #followSets to calculate the follow-sets at once." |
|
230 |
|
231 ^ self followSets at: self |
|
232 ! ! |
|
233 |
|
234 !PPParser methodsFor:'*petitanalyzer-querying'! |
|
235 |
|
236 followSets |
|
237 "Answer a dictionary with all the parsers reachable from the receiver as key and their follow-set as value. The follow-set of a parser is the list of terminal parsers that can appear immediately to the right of that parser." |
|
238 |
|
239 | current previous continue firstSets followSets | |
|
240 current := previous := 0. |
|
241 firstSets := self firstSets. |
|
242 followSets := IdentityDictionary new. |
|
243 self allParsersDo: [ :each | followSets at: each put: IdentitySet new ]. |
|
244 (followSets at: self) add: PPSentinel instance. |
|
245 [ followSets keysAndValuesDo: [ :parser :follow | |
|
246 parser |
|
247 followSets: followSets |
|
248 firstSets: firstSets |
|
249 into: follow ]. |
|
250 current := followSets |
|
251 inject: 0 |
|
252 into: [ :result :each | result + each size ]. |
|
253 continue := previous < current. |
|
254 previous := current. |
|
255 continue ] whileTrue. |
|
256 ^ followSets |
|
257 ! ! |
|
258 |
|
259 !PPParser methodsFor:'*petitanalyzer-private'! |
|
260 |
|
261 followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet |
|
262 "PRIVATE: Try to add additional elements to the follow-set aSet of the receiver, use the incomplete aFollowDictionary and the complete aFirstDictionary." |
|
263 |
|
264 self children do: [ :parser | (aFollowDictionary at: parser) addAll: aSet ] |
|
265 ! ! |
|
266 |
|
267 !PPParser methodsFor:'*petitanalyzer-named'! |
|
268 |
|
269 innerChildren |
|
270 "Answer the inner children of the receiver." |
|
271 |
|
272 | result | |
|
273 result := OrderedCollection new. |
|
274 self innerChildrenDo: [ :parser | result addLast: parser ]. |
|
275 ^ result |
|
276 ! ! |
|
277 |
|
278 !PPParser methodsFor:'*petitanalyzer-named'! |
|
279 |
|
280 innerChildrenDo: aBlock |
|
281 "Iterate over the inner children of the receiver." |
|
282 |
|
283 self innerChildrenDo: aBlock seen: IdentitySet new |
|
284 ! ! |
|
285 |
|
286 !PPParser methodsFor:'*petitanalyzer-named'! |
|
287 |
|
288 innerChildrenDo: aBlock seen: aSet |
|
289 "Iterate over the inner children of the receiver." |
|
290 |
|
291 self children do: [ :each | |
|
292 (aSet includes: each) |
|
293 ifTrue: [ ^ self ]. |
|
294 aSet add: each. |
|
295 each name isNil ifTrue: [ |
|
296 aBlock value: each. |
|
297 each innerChildrenDo: aBlock seen: aSet ] ] |
|
298 ! ! |
|
299 |
|
300 !PPParser methodsFor:'*petitanalyzer-testing'! |
|
301 |
|
302 isNullable |
|
303 "Answer true if the receiver is a nullable parser, e.g. it can successfully parse nothing." |
|
304 |
|
305 ^ false |
|
306 ! ! |
|
307 |
|
308 !PPParser methodsFor:'*petitanalyzer-testing'! |
|
309 |
|
310 isTerminal |
|
311 "Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser." |
|
312 |
|
313 ^ self children isEmpty |
|
314 ! ! |
|
315 |
|
316 !PPParser methodsFor:'*petitanalyzer-matching'! |
|
317 |
|
318 match: aParser inContext: aDictionary |
|
319 ^ self match: aParser inContext: aDictionary seen: IdentitySet new |
|
320 ! ! |
|
321 |
|
322 !PPParser methodsFor:'*petitanalyzer-matching'! |
|
323 |
|
324 match: aParser inContext: aDictionary seen: anIdentitySet |
|
325 "This is the default implementation to match two parsers. This code can properly handle recursion. This is code is supposed to be overridden in subclasses that add new state." |
|
326 |
|
327 (self == aParser or: [ anIdentitySet includes: self ]) |
|
328 ifTrue: [ ^ true ]. |
|
329 anIdentitySet add: self. |
|
330 ^ self class = aParser class and: [ self matchList: self children against: aParser children inContext: aDictionary seen: anIdentitySet ] |
|
331 ! ! |
|
332 |
|
333 !PPParser methodsFor:'*petitanalyzer-matching'! |
|
334 |
|
335 matchList: matchList against: parserList inContext: aDictionary seen: aSet |
|
336 ^ self matchList: matchList index: 1 against: parserList index: 1 inContext: aDictionary seen: aSet |
|
337 ! ! |
|
338 |
|
339 !PPParser methodsFor:'*petitanalyzer-matching'! |
|
340 |
|
341 matchList: matchList index: matchIndex against: parserList index: parserIndex inContext: aDictionary seen: aSet |
|
342 | parser currentIndex currentDictionary currentSeen parsers | |
|
343 matchList size < matchIndex |
|
344 ifTrue: [ ^ parserList size < parserIndex ]. |
|
345 parser := matchList at: matchIndex. |
|
346 parser class = PPListPattern ifTrue: [ |
|
347 currentIndex := parserIndex - 1. |
|
348 [ currentDictionary := aDictionary copy. |
|
349 currentSeen := aSet copy. |
|
350 parserList size < currentIndex or: [ |
|
351 parsers := parserList copyFrom: parserIndex to: currentIndex. |
|
352 (currentDictionary at: parser ifAbsentPut: [ parsers ]) = parsers and: [ |
|
353 (self |
|
354 matchList: matchList |
|
355 index: matchIndex + 1 |
|
356 against: parserList |
|
357 index: currentIndex + 1 |
|
358 inContext: currentDictionary |
|
359 seen: currentSeen) |
|
360 ifTrue: [ |
|
361 currentDictionary keysAndValuesDo: [ :key :value | aDictionary at: key put: value ]. |
|
362 ^ true ]. |
|
363 false ] ] ] whileFalse: [ currentIndex := currentIndex + 1 ]. |
|
364 ^ false ]. |
|
365 parserList size < parserIndex |
|
366 ifTrue: [ ^ false ]. |
|
367 (parser match: (parserList at: parserIndex) inContext: aDictionary seen: aSet) |
|
368 ifFalse: [ ^ false ]. |
|
369 ^ self |
|
370 matchList: matchList |
|
371 index: matchIndex + 1 |
|
372 against: parserList |
|
373 index: parserIndex + 1 |
|
374 inContext: aDictionary |
|
375 seen: aSet |
|
376 ! ! |
|
377 |
|
378 !PPParser methodsFor:'*petitanalyzer-named'! |
|
379 |
|
380 namedChildren |
|
381 "Answer the named children of the receiver." |
|
382 |
|
383 | result | |
|
384 result := OrderedCollection new. |
|
385 self namedChildrenDo: [ :parser | result addLast: parser ]. |
|
386 ^ result |
|
387 ! ! |
|
388 |
|
389 !PPParser methodsFor:'*petitanalyzer-named'! |
|
390 |
|
391 namedChildrenDo: aBlock |
|
392 "Iterate over the named children of the receiver." |
|
393 |
|
394 self namedChildrenDo: aBlock seen: IdentitySet new |
|
395 ! ! |
|
396 |
|
397 !PPParser methodsFor:'*petitanalyzer-named'! |
|
398 |
|
399 namedChildrenDo: aBlock seen: aSet |
|
400 "Iterate over the named children of the receiver." |
|
401 |
|
402 self children do: [ :each | |
|
403 (aSet includes: each) |
|
404 ifTrue: [ ^ self ]. |
|
405 aSet add: each. |
|
406 each name isNil |
|
407 ifTrue: [ each namedChildrenDo: aBlock seen: aSet ] |
|
408 ifFalse: [ aBlock value: each ] ] |
|
409 ! ! |
|
410 |
|
411 !PPParser methodsFor:'*petitanalyzer-transforming'! |
|
412 |
|
413 replace: aParser with: anotherParser |
|
414 "Replace the references of the receiver pointing to aParser with anotherParser." |
|
415 ! ! |
|
416 |
|
417 !PPParser methodsFor:'*petitanalyzer-transforming'! |
|
418 |
|
419 transform: aBlock |
|
420 "Answer a copy of all parsers reachable from the receiver transformed using aBlock." |
|
421 |
|
422 | mapping root | |
|
423 mapping := IdentityDictionary new. |
|
424 self allParsersDo: [ :each | |
|
425 mapping |
|
426 at: each |
|
427 put: (aBlock value: each copy) ]. |
|
428 root := mapping at: self. |
|
429 [ | changed | |
|
430 changed := false. |
|
431 root allParsersDo: [ :each | |
|
432 each children do: [ :old | |
|
433 mapping at: old ifPresent: [ :new | |
|
434 each replace: old with: new. |
|
435 changed := true ] ] ]. |
|
436 changed ] whileTrue. |
|
437 ^ root |
|
438 ! ! |
|
439 |
|
440 !PPPluggableParser methodsFor:'*petitanalyzer-matching'! |
|
441 |
|
442 match: aParser inContext: aDictionary seen: anIdentitySet |
|
443 ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ] |
|
444 ! ! |
|
445 |
|
446 !PPPredicateParser methodsFor:'*petitanalyzer-matching'! |
|
447 |
|
448 match: aParser inContext: aDictionary seen: anIdentitySet |
|
449 ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block and: [ self message = aParser message ] ] |
|
450 ! ! |
|
451 |
|
452 !PPPredicateSequenceParser methodsFor:'*petitanalyzer-matching'! |
|
453 |
|
454 match: aParser inContext: aDictionary seen: anIdentitySet |
|
455 ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self size = aParser size ] |
|
456 ! ! |
|
457 |
|
458 !PPRepeatingParser methodsFor:'*petitanalyzer-testing'! |
|
459 |
|
460 isNullable |
|
461 ^ min = 0 |
|
462 ! ! |
|
463 |
|
464 !PPRepeatingParser methodsFor:'*petitanalyzer-matching'! |
|
465 |
|
466 match: aParser inContext: aDictionary seen: anIdentitySet |
|
467 ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self min = aParser min and: [ self max = aParser max ] ] |
|
468 ! ! |
|
469 |
|
470 !PPSequenceParser methodsFor:'*petitanalyzer-private'! |
|
471 |
|
472 cycleSet: aDictionary |
|
473 | firstSet | |
|
474 1 to: parsers size do: [ :index | |
|
475 firstSet := aDictionary at: (parsers at: index). |
|
476 (firstSet anySatisfy: [ :each | each isNullable ]) |
|
477 ifFalse: [ ^ parsers copyFrom: 1 to: index ] ]. |
|
478 ^ parsers |
|
479 ! ! |
|
480 |
|
481 !PPSequenceParser methodsFor:'*petitanalyzer-private'! |
|
482 |
|
483 firstSets: aFirstDictionary into: aSet |
|
484 | nullable | |
|
485 parsers do: [ :parser | |
|
486 nullable := false. |
|
487 (aFirstDictionary at: parser) do: [ :each | |
|
488 each isNullable |
|
489 ifTrue: [ nullable := true ] |
|
490 ifFalse: [ aSet add: each ] ]. |
|
491 nullable |
|
492 ifFalse: [ ^ self ] ]. |
|
493 aSet add: PPSentinel instance |
|
494 ! ! |
|
495 |
|
496 !PPSequenceParser methodsFor:'*petitanalyzer-private'! |
|
497 |
|
498 followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet |
|
499 parsers keysAndValuesDo: [ :index :parser | |
|
500 | followSet firstSet | |
|
501 followSet := aFollowDictionary at: parser. |
|
502 index = parsers size |
|
503 ifTrue: [ followSet addAll: aSet ] |
|
504 ifFalse: [ |
|
505 (self class withAll: (parsers |
|
506 copyFrom: index + 1 to: parsers size)) |
|
507 firstSets: aFirstDictionary |
|
508 into: (firstSet := IdentitySet new). |
|
509 (firstSet anySatisfy: [ :each | each isNullable ]) |
|
510 ifTrue: [ followSet addAll: aSet ]. |
|
511 followSet addAll: (firstSet |
|
512 reject: [ :each | each isNullable ]) ] ] |
|
513 ! ! |
|
514 |
|
515 !PPTokenParser methodsFor:'*petitanalyzer-matching'! |
|
516 |
|
517 match: aParser inContext: aDictionary seen: anIdentitySet |
|
518 ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self tokenClass = aParser tokenClass ] |
|
519 ! ! |
|
520 |
|
521 !stx_goodies_petitparser_analyzer class methodsFor:'documentation'! |
|
522 |
|
523 extensionsVersion_CVS |
|
524 ^ '$Header: /cvs/stx/stx/goodies/petitparser/analyzer/extensions.st,v 1.2 2014-03-04 20:25:41 cg Exp $' |
|
525 ! ! |