23 javaInDirectory: directory |
23 javaInDirectory: directory |
24 | files | |
24 | files | |
25 files := self readDirectory: directory. |
25 files := self readDirectory: directory. |
26 files := self files: files withExtension: 'java'. |
26 files := self files: files withExtension: 'java'. |
27 |
27 |
28 ^ files collect: [ :f | (FileStream fileNamed: f) contents asString ] |
28 ^ files collect: [ :f | (FileStream fileNamed: f) contents ] |
29 ! |
|
30 |
|
31 javaLangClass |
|
32 ! |
29 ! |
33 |
30 |
34 javaLangMath |
31 javaLangMath |
35 ^ (FileStream fileNamed: '../java-src/java/lang/Math.java') contents asString |
32 ^ (FileStream fileNamed: '../java-src/java/lang/Math.java') contents |
36 ! |
33 ! |
37 |
34 |
38 javaSourcesBig |
35 javaSourcesBig |
39 ^ self javaInDirectory: '../java-src/java/util'. |
36 ^ self javaInDirectory: '../java-src/java/util'. |
40 "^ self workingJavaInDirectory: '../java-src/java/util'" |
37 "^ self workingJavaInDirectory: '../java-src/java/util'" |
41 ! |
38 ! |
42 |
39 |
43 petitParserPackage |
|
44 ^ ' |
|
45 Object subclass: #PPCharSetPredicate |
|
46 instanceVariableNames: ''block classification'' |
|
47 classVariableNames: '''' |
|
48 poolDictionaries: '''' |
|
49 category: ''PetitParser-Tools''!! |
|
50 !!PPCharSetPredicate commentStamp: ''<historical>'' prior: 0!! |
|
51 !! |
|
52 |
|
53 |
|
54 !!PPCharSetPredicate methodsFor: ''initialization'' stamp: ''lr 8/30/2010 12:19''!! |
|
55 initializeOn: aBlock |
|
56 block := aBlock. |
|
57 classification := Array new: 255. |
|
58 1 to: classification size do: [ :index | |
|
59 classification at: index put: (block |
|
60 value: (Character value: index)) ]!! !! |
|
61 |
|
62 |
|
63 !!PPCharSetPredicate methodsFor: ''evaluating'' stamp: ''lr 8/30/2010 12:19''!! |
|
64 value: aCharacter |
|
65 | index | |
|
66 index := aCharacter asInteger. |
|
67 index == 0 |
|
68 ifTrue: [ ^ block value: aCharacter ]. |
|
69 index > 255 |
|
70 ifTrue: [ ^ block value: aCharacter ]. |
|
71 ^ classification at: index!! !! |
|
72 |
|
73 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
74 |
|
75 PPCharSetPredicate class |
|
76 instanceVariableNames: ''''!! |
|
77 !!PPCharSetPredicate class commentStamp: ''<historical>'' prior: 0!! |
|
78 !! |
|
79 |
|
80 |
|
81 !!PPCharSetPredicate class methodsFor: ''instance creation'' stamp: ''lr 8/25/2010 11:05''!! |
|
82 on: aBlock |
|
83 ^ self basicNew initializeOn: aBlock!! !! |
|
84 |
|
85 |
|
86 PPDelegateParser subclass: #PPExpressionParser |
|
87 instanceVariableNames: ''operators'' |
|
88 classVariableNames: '''' |
|
89 poolDictionaries: '''' |
|
90 category: ''PetitParser-Tools''!! |
|
91 !!PPExpressionParser commentStamp: ''<historical>'' prior: 0!! |
|
92 A PPExpressionParser is a parser to conveniently define an expression grammar with prefix, postfix, and left- and right-associative infix operators. |
|
93 |
|
94 The following code initializes a parser for arithmetic expressions. First we instantiate an expression parser, a simple parser for expressions in parenthesis and a simple parser for integer numbers. |
|
95 |
|
96 expression := PPExpressionParser new. |
|
97 parens := $( asParser token trim , expression , $) asParser token trim |
|
98 ==> [ :nodes | nodes second ]. |
|
99 integer := #digit asParser plus token trim |
|
100 ==> [ :token | token value asInteger ]. |
|
101 |
|
102 Then we define on what term the expression grammar is built on: |
|
103 |
|
104 expression term: parens / integer. |
|
105 |
|
106 Finally we define the operator-groups in descending precedence. Note, that the action blocks receive both, the terms and the parsed operator in the order they appear in the parsed input. |
|
107 |
|
108 expression |
|
109 group: [ :g | |
|
110 g prefix: $- asParser token trim do: [ :op :a | a negated ] ]; |
|
111 group: [ :g | |
|
112 g postfix: ''++'' asParser token trim do: [ :a :op | a + 1 ]. |
|
113 g postfix: ''--'' asParser token trim do: [ :a :op | a - 1 ] ]; |
|
114 group: [ :g | |
|
115 g right: $^ asParser token trim do: [ :a :op :b | a raisedTo: b ] ]; |
|
116 group: [ :g | |
|
117 g left: $* asParser token trim do: [ :a :op :b | a * b ]. |
|
118 g left: $/ asParser token trim do: [ :a :op :b | a / b ] ]; |
|
119 group: [ :g | |
|
120 g left: $+ asParser token trim do: [ :a :op :b | a + b ]. |
|
121 g left: $- asParser token trim do: [ :a :op :b | a - b ] ]. |
|
122 |
|
123 After evaluating the above code the ''expression'' is an efficient parser that evaluates examples like: |
|
124 |
|
125 expression parse: ''-8++''. |
|
126 expression parse: ''1+2*3''. |
|
127 expression parse: ''1*2+3''. |
|
128 expression parse: ''(1+2)*3''. |
|
129 expression parse: ''8/4/2''. |
|
130 expression parse: ''8/(4/2)''. |
|
131 expression parse: ''2^2^3''. |
|
132 expression parse: ''(2^2)^3''. |
|
133 |
|
134 Instance Variables: |
|
135 operators <Dictionary> The operators defined in the current group.!! |
|
136 |
|
137 |
|
138 !!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!! |
|
139 build: aParser right: aChoiceParser |
|
140 ^ (aParser separatedBy: aChoiceParser) foldRight: [ :a :op :b | op first value: a value: op second value: b ]!! !! |
|
141 |
|
142 !!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!! |
|
143 build: aParser left: aChoiceParser |
|
144 ^ (aParser separatedBy: aChoiceParser) foldLeft: [ :a :op :b | op first value: a value: op second value: b ]!! !! |
|
145 |
|
146 !!PPExpressionParser methodsFor: ''private'' stamp: ''lr 12/4/2009 17:38''!! |
|
147 build: aParser postfix: aChoiceParser |
|
148 ^ aParser , aChoiceParser star map: [ :term :ops | ops inject: term into: [ :result :operator | operator first value: result value: operator second ] ]!! !! |
|
149 |
|
150 !!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 21:15''!! |
|
151 buildOn: aParser |
|
152 ^ self buildSelectors inject: aParser into: [ :term :selector | |
|
153 | list | |
|
154 list := operators at: selector ifAbsent: [ #() ]. |
|
155 list isEmpty |
|
156 ifTrue: [ term ] |
|
157 ifFalse: [ |
|
158 self |
|
159 perform: selector with: term |
|
160 with: (list size = 1 |
|
161 ifTrue: [ list first first ==> [ :operator | Array with: list first second with: operator ] ] |
|
162 ifFalse: [ |
|
163 list |
|
164 inject: PPChoiceParser new |
|
165 into: [ :choice :each | choice / (each first ==> [ :operator | Array with: each second with: operator ]) ] ]) ] ]!! !! |
|
166 |
|
167 !!PPExpressionParser methodsFor: ''private'' stamp: ''lr 12/4/2009 17:39''!! |
|
168 build: aParser prefix: aChoiceParser |
|
169 ^ aChoiceParser star , aParser map: [ :ops :term | ops reversed inject: term into: [ :result :operator | operator first value: operator second value: result ] ]!! !! |
|
170 |
|
171 !!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!! |
|
172 buildSelectors |
|
173 ^ #(build:prefix: build:postfix: build:right: build:left:)!! !! |
|
174 |
|
175 !!PPExpressionParser methodsFor: ''private'' stamp: ''lr 2/7/2010 23:23''!! |
|
176 operator: aSymbol parser: aParser do: aBlock |
|
177 parser isNil |
|
178 ifTrue: [ ^ self error: ''You did not specify a term when creating the receiver.'' ]. |
|
179 operators isNil |
|
180 ifTrue: [ ^ self error: ''Use #group: to define precedence groups in descending order.'' ]. |
|
181 (operators at: aSymbol ifAbsentPut: [ OrderedCollection new ]) |
|
182 addLast: (Array with: aParser asParser with: aBlock)!! !! |
|
183 |
|
184 |
|
185 !!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 21:26''!! |
|
186 term: aParser |
|
187 "Defines the initial term aParser of the receiver." |
|
188 |
|
189 parser isNil |
|
190 ifTrue: [ parser := aParser ] |
|
191 ifFalse: [ self error: ''Unable to redefine the term.'' ]!! !! |
|
192 |
|
193 !!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!! |
|
194 postfix: aParser do: aTwoArgumentBlock |
|
195 "Define a postfix operator aParser. Evaluate aTwoArgumentBlock with the term and the operator." |
|
196 |
|
197 self operator: #build:postfix: parser: aParser do: aTwoArgumentBlock!! !! |
|
198 |
|
199 !!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!! |
|
200 left: aParser do: aThreeArgumentBlock |
|
201 "Define an operator aParser that is left-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term." |
|
202 |
|
203 self operator: #build:left: parser: aParser do: aThreeArgumentBlock!! !! |
|
204 |
|
205 !!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!! |
|
206 prefix: aParser do: aTwoArgumentBlock |
|
207 "Define a prefix operator aParser. Evaluate aTwoArgumentBlock with the operator and the term." |
|
208 |
|
209 self operator: #build:prefix: parser: aParser do: aTwoArgumentBlock!! !! |
|
210 |
|
211 !!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!! |
|
212 right: aParser do: aThreeArgumentBlock |
|
213 "Define an operator aParser that is right-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term." |
|
214 |
|
215 self operator: #build:right: parser: aParser do: aThreeArgumentBlock!! !! |
|
216 |
|
217 !!PPExpressionParser methodsFor: ''specifying'' stamp: ''lr 2/7/2010 23:20''!! |
|
218 group: aOneArgumentBlock |
|
219 "Defines a priority group by evaluating aOneArgumentBlock." |
|
220 |
|
221 operators := Dictionary new. |
|
222 parser := [ |
|
223 aOneArgumentBlock value: self. |
|
224 self buildOn: parser ] |
|
225 ensure: [ operators := nil ]!! !! |
|
226 |
|
227 |
|
228 PPDelegateParser subclass: #PPCompositeParser |
|
229 instanceVariableNames: ''dependencies'' |
|
230 classVariableNames: '''' |
|
231 poolDictionaries: '''' |
|
232 category: ''PetitParser-Tools''!! |
|
233 !!PPCompositeParser commentStamp: ''lr 12/4/2009 18:38'' prior: 0!! |
|
234 A PPCompositeParser is composed parser built from various primitive parsers. |
|
235 |
|
236 Every production in the receiver is specified as a method that returns its parser. Note that every production requires an instance variable of the same name, otherwise the production is not cached and cannot be used in recursive grammars. Productions should refer to each other by reading the respective inst-var. Note: these inst-vars are typically not written, as the assignment happens in the initialize method using reflection. |
|
237 |
|
238 The start production is defined in the method start. It is aliased to the inst-var parser defined in the superclass of PPCompositeParser.!! |
|
239 |
|
240 |
|
241 !!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 6/4/2010 13:37''!! |
|
242 productionAt: aSymbol ifAbsent: aBlock |
|
243 "Answer the production named aSymbol, if there is no such production answer the result of evaluating aBlock." |
|
244 |
|
245 (self class ignoredNames includes: aSymbol asString) |
|
246 ifTrue: [ ^ aBlock value ]. |
|
247 (self class startSymbol = aSymbol) |
|
248 ifTrue: [ ^ parser ]. |
|
249 ^ self instVarAt: (self class allInstVarNames |
|
250 indexOf: aSymbol asString |
|
251 ifAbsent: [ ^ aBlock value ])!! !! |
|
252 |
|
253 !!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 5/8/2011 15:45''!! |
|
254 productionNames |
|
255 "Answer a dictionary of slot indexes and production names." |
|
256 |
|
257 | productionNames ignoredNames | |
|
258 productionNames := Dictionary new. |
|
259 ignoredNames := self class ignoredNames |
|
260 collect: [ :each | each asSymbol ]. |
|
261 self class allInstVarNames keysAndValuesDo: [ :key :value | |
|
262 (ignoredNames includes: value asSymbol) |
|
263 ifFalse: [ productionNames at: key put: value asSymbol ] ]. |
|
264 ^ productionNames!! !! |
|
265 |
|
266 !!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 3/16/2013 21:41''!! |
|
267 dependencyAt: aClass |
|
268 "Answer the dependent parser aClass. Throws an error if this parser class is not declared in the method #dependencies on the class-side of the receiver." |
|
269 |
|
270 ^ dependencies at: aClass ifAbsent: [ self error: ''Undeclared dependency in '' , self class name , '' to '' , aClass name ]!! !! |
|
271 |
|
272 !!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 12/4/2009 18:39''!! |
|
273 productionAt: aSymbol |
|
274 "Answer the production named aSymbol." |
|
275 |
|
276 ^ self productionAt: aSymbol ifAbsent: [ nil ]!! !! |
|
277 |
|
278 |
|
279 !!PPCompositeParser methodsFor: ''initialization'' stamp: ''lr 3/16/2013 17:15''!! |
|
280 initializeStartingAt: aSymbol dependencies: aDictionary |
|
281 self initialize. |
|
282 parser := PPDelegateParser named: aSymbol. |
|
283 self productionNames keysAndValuesDo: [ :key :value | |
|
284 self instVarAt: key put: (PPDelegateParser named: value) ]. |
|
285 dependencies := aDictionary!! !! |
|
286 |
|
287 |
|
288 !!PPCompositeParser methodsFor: ''accessing'' stamp: ''lr 5/16/2008 17:32''!! |
|
289 start |
|
290 "Answer the production to start this parser with." |
|
291 |
|
292 self subclassResponsibility!! !! |
|
293 |
|
294 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
295 |
|
296 PPCompositeParser class |
|
297 instanceVariableNames: ''''!! |
|
298 !!PPCompositeParser class commentStamp: ''<historical>'' prior: 0!! |
|
299 !! |
|
300 |
|
301 |
|
302 !!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 1/29/2010 11:35''!! |
|
303 ignoredNames |
|
304 "Answer a collection of instance-variables that should not be automatically initialized with productions, but that are used internal to the composite parser." |
|
305 |
|
306 ^ PPCompositeParser allInstVarNames!! !! |
|
307 |
|
308 !!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 12/7/2009 08:20''!! |
|
309 startSymbol |
|
310 "Answer the method that represents the default start symbol." |
|
311 |
|
312 ^ #start!! !! |
|
313 |
|
314 !!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 3/16/2013 21:42''!! |
|
315 dependencies |
|
316 "Answer a collection of PPCompositeParser classes that this parser directly dependends on. Override this method in subclasses to declare dependent parsers. The default implementation does not depend on other PPCompositeParser." |
|
317 |
|
318 ^ #()!! !! |
|
319 |
|
320 |
|
321 !!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:40''!! |
|
322 debug: anObject startingAt: aSymbol onError: aBlock |
|
323 ^ (self newStartingAt: aSymbol) debug: anObject onError: aBlock!! !! |
|
324 |
|
325 !!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:39''!! |
|
326 debug: anObject startingAt: aSymbol |
|
327 ^ (self newStartingAt: aSymbol) debug: anObject!! !! |
|
328 |
|
329 !!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:40''!! |
|
330 debug: anObject onError: aBlock |
|
331 ^ self debug: anObject startingAt: self startSymbol onError: aBlock!! !! |
|
332 |
|
333 !!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:39''!! |
|
334 debug: anObject |
|
335 ^ self debug: anObject startingAt: self startSymbol!! !! |
|
336 |
|
337 |
|
338 !!PPCompositeParser class methodsFor: ''instance creation'' stamp: ''lr 3/16/2013 21:21''!! |
|
339 newStartingAt: aSymbol |
|
340 "Answer a new parser starting at aSymbol. The code makes sure to resolve all dependent parsers correctly." |
|
341 |
|
342 | parsers remaining | |
|
343 parsers := IdentityDictionary new. |
|
344 remaining := OrderedCollection with: self. |
|
345 [ remaining isEmpty ] whileFalse: [ |
|
346 | dependency | |
|
347 dependency := remaining removeLast. |
|
348 (parsers includesKey: dependency) ifFalse: [ |
|
349 parsers at: dependency put: dependency basicNew. |
|
350 remaining addAll: dependency dependencies ] ]. |
|
351 parsers keysAndValuesDo: [ :class :parser | |
|
352 | dependencies | |
|
353 dependencies := IdentityDictionary new. |
|
354 class dependencies |
|
355 do: [ :dependency | dependencies at: dependency put: (parsers at: dependency) ]. |
|
356 parser |
|
357 initializeStartingAt: (class == self |
|
358 ifTrue: [ aSymbol ] |
|
359 ifFalse: [ class startSymbol ]) |
|
360 dependencies: dependencies ]. |
|
361 parsers keysAndValuesDo: [ :class :parser | |
|
362 parser setParser: (parser perform: parser children first name). |
|
363 parser productionNames keysAndValuesDo: [ :key :value | |
|
364 (parser instVarAt: key) setParser: (parser perform: value) ] ]. |
|
365 ^ parsers at: self!! !! |
|
366 |
|
367 !!PPCompositeParser class methodsFor: ''instance creation'' stamp: ''lr 12/7/2009 08:24''!! |
|
368 new |
|
369 "Answer a new parser starting at the default start symbol." |
|
370 |
|
371 ^ self newStartingAt: self startSymbol!! !! |
|
372 |
|
373 |
|
374 !!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 21:02''!! |
|
375 parse: anObject onError: aBlock |
|
376 ^ self parse: anObject startingAt: self startSymbol onError: aBlock!! !! |
|
377 |
|
378 !!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 21:02''!! |
|
379 parse: anObject startingAt: aSymbol onError: aBlock |
|
380 ^ (self newStartingAt: aSymbol) parse: anObject onError: aBlock!! !! |
|
381 |
|
382 !!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:57''!! |
|
383 parse: anObject startingAt: aSymbol |
|
384 ^ (self newStartingAt: aSymbol) parse: anObject!! !! |
|
385 |
|
386 !!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:57''!! |
|
387 parse: anObject |
|
388 ^ self parse: anObject startingAt: self startSymbol!! !! |
|
389 |
|
390 |
|
391 PPParser subclass: #PPUnresolvedParser |
|
392 instanceVariableNames: '''' |
|
393 classVariableNames: '''' |
|
394 poolDictionaries: '''' |
|
395 category: ''PetitParser-Tools''!! |
|
396 !!PPUnresolvedParser commentStamp: ''lr 11/28/2009 18:50'' prior: 0!! |
|
397 This is a temporary placeholder or forward reference to a parser that has not been defined yet. If everything goes well it will eventually be replaced with the real parser instance.!! |
|
398 |
|
399 |
|
400 !!PPUnresolvedParser methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:51''!! |
|
401 parseOn: aStream |
|
402 self error: self printString , '' need to be resolved before execution.''!! !! |
|
403 |
|
404 |
|
405 !!PPUnresolvedParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:15''!! |
|
406 displayColor |
|
407 ^ Color red!! !! |
|
408 |
|
409 |
|
410 !!PPUnresolvedParser methodsFor: ''testing'' stamp: ''lr 10/27/2008 11:29''!! |
|
411 isUnresolved |
|
412 ^ true!! !! |
|
413 Object subclass: #PPParser |
|
414 instanceVariableNames: ''properties'' |
|
415 classVariableNames: '''' |
|
416 poolDictionaries: '''' |
|
417 category: ''PetitParser-Parsers''!! |
|
418 !!PPParser commentStamp: ''<historical>'' prior: 0!! |
|
419 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. |
|
420 |
|
421 Instance Variables: |
|
422 properties <Dictionary> Stores additional state in the parser object.!! |
|
423 |
|
424 |
|
425 !!PPParser methodsFor: ''*petitjava-operations'' stamp: ''sback 9/2/2010 23:01''!! |
|
426 javaToken |
|
427 ^ PPJavaTokenParser on: self!! !! |
|
428 |
|
429 |
|
430 !!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 12/18/2013 06:41''!! |
|
431 gtInspectorParserInspectorIn: composite |
|
432 <gtInspectorPresentationOrder: 30> |
|
433 composite custom: ( |
|
434 PPVerticalParserInspector new |
|
435 title: ''Sampler''; |
|
436 startOn: self)!! !! |
|
437 |
|
438 !!PPParser methodsFor: ''*petitgui'' stamp: ''AlexandreBergel 12/18/2013 16:40''!! |
|
439 gtGraphViewIn: composite |
|
440 <gtInspectorPresentationOrder: 50> |
|
441 |
|
442 composite roassal |
|
443 title: ''Graph''; |
|
444 painting: [ :view | |
|
445 self visualizeStructureInGraphOn: view. |
|
446 ].!! !! |
|
447 |
|
448 !!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 6/24/2013 23:44''!! |
|
449 gtNamedTreeViewIn: composite |
|
450 <gtInspectorPresentationOrder: 40> |
|
451 |
|
452 composite tree |
|
453 title: ''Named Tree''; |
|
454 children: [:n | n namedChildren ]; |
|
455 format: [:n| n name ifNil: [ n asString ] ]; |
|
456 shouldExpandToLevel: 3!! !! |
|
457 |
|
458 !!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 6/24/2013 23:44''!! |
|
459 gtTreeViewIn: composite |
|
460 <gtInspectorPresentationOrder: 40> |
|
461 |
|
462 composite tree |
|
463 title: ''Tree''; |
|
464 children: [:n | n children ]; |
|
465 format: [:n| n name ifNil: [ n asString ] ifNotNil: [n name] ]; |
|
466 shouldExpandToLevel: 6!! !! |
|
467 |
|
468 |
|
469 !!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 1/30/2013 19:35''!! |
|
470 morphicShapeDefault |
|
471 ^ self newRowMorph |
|
472 addMorphBack: (self newColumnMorph |
|
473 addMorphBack: (self newSpacerMorph); |
|
474 addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1) |
|
475 makeForwardArrow; |
|
476 yourself); |
|
477 addMorphBack: (self newRowMorph |
|
478 borderWidth: 1; |
|
479 layoutInset: 3; |
|
480 color: Color white; |
|
481 addMorphBack: (StringMorph new |
|
482 contents: self displayName; |
|
483 color: self displayColor; |
|
484 yourself); |
|
485 yourself); |
|
486 yourself!! !! |
|
487 |
|
488 !!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 10:56''!! |
|
489 morphicProduction |
|
490 ^ self newRowMorph |
|
491 layoutInset: 4; |
|
492 addMorphBack: (self newRowMorph |
|
493 layoutInset: 4; |
|
494 addMorphBack: (StringMorph new |
|
495 contents: self displayName; |
|
496 emphasis: TextEmphasis bold emphasisCode; |
|
497 yourself); |
|
498 yourself); |
|
499 addMorphBack: (self morphicShapeSeen: IdentitySet new depth: 0); |
|
500 addMorphBack: (self newColumnMorph |
|
501 addMorphBack: (self newSpacerMorph); |
|
502 addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1) |
|
503 makeForwardArrow; |
|
504 yourself); |
|
505 yourself!! !! |
|
506 |
|
507 !!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/13/2009 13:24''!! |
|
508 morphicShapeSeen: aSet depth: anInteger |
|
509 ^ self morphicShapeDefault!! !! |
|
510 |
|
511 !!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/13/2009 13:43''!! |
|
512 morphicShapeSeen: aSet depth: anInteger do: aBlock |
|
513 " avoid recursion " |
|
514 (aSet includes: self) |
|
515 ifTrue: [ ^ self morphicShapeDefault ]. |
|
516 " display nice name when possible " |
|
517 (anInteger > 0 and: [ self name notNil ]) |
|
518 ifTrue: [ ^ self morphicShapeDefault ]. |
|
519 " don''t do it too deep " |
|
520 (anInteger > 10) |
|
521 ifTrue: [ ^ self morphicShapeDefault ]. |
|
522 aSet add: self. |
|
523 ^ aBlock value: [ :parser | |
|
524 parser |
|
525 morphicShapeSeen: aSet |
|
526 depth: anInteger + 1 ]!! !! |
|
527 |
|
528 |
|
529 !!PPParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 10/30/2010 11:54''!! |
|
530 transform: aBlock |
|
531 "Answer a copy of all parsers reachable from the receiver transformed using aBlock." |
|
532 |
|
533 | mapping root | |
|
534 mapping := IdentityDictionary new. |
|
535 self allParsersDo: [ :each | |
|
536 mapping |
|
537 at: each |
|
538 put: (aBlock value: each copy) ]. |
|
539 root := mapping at: self. |
|
540 [ | changed | |
|
541 changed := false. |
|
542 root allParsersDo: [ :each | |
|
543 each children do: [ :old | |
|
544 mapping at: old ifPresent: [ :new | |
|
545 each replace: old with: new. |
|
546 changed := true ] ] ]. |
|
547 changed ] whileTrue. |
|
548 ^ root!! !! |
|
549 |
|
550 !!PPParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 4/13/2010 09:38''!! |
|
551 replace: aParser with: anotherParser |
|
552 "Replace the references of the receiver pointing to aParser with anotherParser."!! !! |
|
553 |
|
554 |
|
555 !!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:55''!! |
|
556 namedChildrenDo: aBlock |
|
557 "Iterate over the named children of the receiver." |
|
558 |
|
559 self namedChildrenDo: aBlock seen: IdentitySet new!! !! |
|
560 |
|
561 !!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:01''!! |
|
562 allNamedParsers |
|
563 "Answer all the named parse nodes of the receiver." |
|
564 |
|
565 | result | |
|
566 result := OrderedCollection new. |
|
567 self allNamedParsersDo: [ :parser | result addLast: parser ]. |
|
568 ^ result!! !! |
|
569 |
|
570 !!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:55''!! |
|
571 namedChildrenDo: aBlock seen: aSet |
|
572 "Iterate over the named children of the receiver." |
|
573 |
|
574 self children do: [ :each | |
|
575 (aSet includes: each) |
|
576 ifTrue: [ ^ self ]. |
|
577 aSet add: each. |
|
578 each name isNil |
|
579 ifTrue: [ each namedChildrenDo: aBlock seen: aSet ] |
|
580 ifFalse: [ aBlock value: each ] ]!! !! |
|
581 |
|
582 !!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 12/3/2010 16:45''!! |
|
583 innerChildren |
|
584 "Answer the inner children of the receiver." |
|
585 |
|
586 | result | |
|
587 result := OrderedCollection new. |
|
588 self innerChildrenDo: [ :parser | result addLast: parser ]. |
|
589 ^ result!! !! |
|
590 |
|
591 !!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 12/3/2010 16:51''!! |
|
592 innerChildrenDo: aBlock seen: aSet |
|
593 "Iterate over the inner children of the receiver." |
|
594 |
|
595 self children do: [ :each | |
|
596 (aSet includes: each) |
|
597 ifTrue: [ ^ self ]. |
|
598 aSet add: each. |
|
599 each name isNil ifTrue: [ |
|
600 aBlock value: each. |
|
601 each innerChildrenDo: aBlock seen: aSet ] ]!! !! |
|
602 |
|
603 !!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 12/3/2010 16:48''!! |
|
604 innerChildrenDo: aBlock |
|
605 "Iterate over the inner children of the receiver." |
|
606 |
|
607 self innerChildrenDo: aBlock seen: IdentitySet new!! !! |
|
608 |
|
609 !!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:12''!! |
|
610 allNamedParsersDo: aBlock |
|
611 "Iterate over all the named parse nodes of the receiver." |
|
612 |
|
613 self allParsersDo: [ :each | |
|
614 each name notNil |
|
615 ifTrue: [ aBlock value: each ] ]!! !! |
|
616 |
|
617 !!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:55''!! |
|
618 namedChildren |
|
619 "Answer the named children of the receiver." |
|
620 |
|
621 | result | |
|
622 result := OrderedCollection new. |
|
623 self namedChildrenDo: [ :parser | result addLast: parser ]. |
|
624 ^ result!! !! |
|
625 |
|
626 |
|
627 !!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/11/2011 11:03''!! |
|
628 trimBlanks |
|
629 "Answer a new parser that consumes blanks before and after the receiving parser." |
|
630 |
|
631 ^ self trim: #blank asParser!! !! |
|
632 |
|
633 !!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 2/19/2010 07:42''!! |
|
634 answer: anObject |
|
635 "Answer a new parser that always returns anObject from a successful parse." |
|
636 |
|
637 ^ self ==> [ :nodes | anObject ]!! !! |
|
638 |
|
639 !!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/11/2011 11:03''!! |
|
640 trim: aParser |
|
641 "Answer a new parser that consumes and ignores aParser repeatedly before and after the receiving parser." |
|
642 |
|
643 ^ PPTrimmingParser on: self trimmer: aParser!! !! |
|
644 |
|
645 !!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 5/6/2011 20:28''!! |
|
646 map: aBlock |
|
647 "Answer a new parser that works on the receiving sequence an passes in each element as a block argument." |
|
648 |
|
649 ^ aBlock numArgs = 1 |
|
650 ifTrue: [ self ==> aBlock ] |
|
651 ifFalse: [ self error: aBlock numArgs asString , '' arguments expected.'' ] |
|
652 !! !! |
|
653 |
|
654 !!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 6/29/2010 14:25''!! |
|
655 token |
|
656 "Answer a new parser that transforms the input to a token." |
|
657 |
|
658 ^ PPTokenParser on: self!! !! |
|
659 |
|
660 !!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 4/3/2011 14:59''!! |
|
661 foldRight: aBlock |
|
662 "Answer a new parser that that folds the result of the receiver from right-to-left into aBlock. The argument aBlock must take two or more arguments." |
|
663 |
|
664 | size args | |
|
665 size := aBlock numArgs. |
|
666 args := Array new: size. |
|
667 ^ self ==> [ :nodes | |
|
668 args at: size put: nodes last. |
|
669 nodes size - size + 1 to: 1 by: 1 - size do: [ :index | |
|
670 args |
|
671 replaceFrom: 1 to: size - 1 with: nodes startingAt: index; |
|
672 at: size put: (aBlock valueWithArguments: args) ]. |
|
673 args at: size ]!! !! |
|
674 |
|
675 !!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/11/2011 11:03''!! |
|
676 trimSpaces |
|
677 "Answer a new parser that consumes spaces before and after the receiving parser." |
|
678 |
|
679 ^ self trim: #space asParser!! !! |
|
680 |
|
681 !!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 5/15/2008 16:08''!! |
|
682 flatten |
|
683 "Answer a new parser that flattens the underlying collection." |
|
684 |
|
685 ^ PPFlattenParser on: self!! !! |
|
686 |
|
687 !!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/31/2010 12:06''!! |
|
688 trim |
|
689 "Answer a new parser that consumes spaces before and after the receiving parser." |
|
690 |
|
691 ^ self trimSpaces!! !! |
|
692 |
|
693 !!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 6/12/2010 10:20''!! |
|
694 >=> aBlock |
|
695 "Answer a new parser that wraps the receiving parser with a two argument block. The first argument is the parsed stream, the second argument a continuation block on the delegate parser." |
|
696 |
|
697 ^ PPWrappingParser on: self block: aBlock!! !! |
|
698 |
|
699 !!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 5/12/2010 20:32''!! |
|
700 ==> aBlock |
|
701 "Answer a new parser that performs aBlock as action handler on success." |
|
702 |
|
703 ^ PPActionParser on: self block: aBlock!! !! |
|
704 |
|
705 !!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 4/3/2011 15:00''!! |
|
706 foldLeft: aBlock |
|
707 "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." |
|
708 |
|
709 | size args | |
|
710 size := aBlock numArgs. |
|
711 args := Array new: size. |
|
712 ^ self ==> [ :nodes | |
|
713 args at: 1 put: nodes first. |
|
714 2 to: nodes size by: size - 1 do: [ :index | |
|
715 args |
|
716 replaceFrom: 2 to: size with: nodes startingAt: index; |
|
717 at: 1 put: (aBlock valueWithArguments: args) ]. |
|
718 args first ]!! !! |
|
719 |
|
720 !!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 4/6/2010 19:26''!! |
|
721 token: aTokenClass |
|
722 "Answer a new parser that transforms the input to a token of class aTokenClass." |
|
723 |
|
724 ^ self token tokenClass: aTokenClass!! !! |
|
725 |
|
726 |
|
727 !!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:57''!! |
|
728 max: anInteger lazy: aParser |
|
729 "Answer a new parser that parses the receiver at most anInteger times until it reaches aParser. This is a lazy non-blind implementation. aParser is not consumed." |
|
730 |
|
731 ^ (self starLazy: aParser) setMax: anInteger!! !! |
|
732 |
|
733 !!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/2/2011 10:01''!! |
|
734 starLazy: aParser |
|
735 "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." |
|
736 |
|
737 ^ PPLazyRepeatingParser on: self limit: aParser!! !! |
|
738 |
|
739 !!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 9/15/2010 09:34''!! |
|
740 times: anInteger |
|
741 "Answer a new parser that parses the receiver exactly anInteger times." |
|
742 |
|
743 ^ self min: anInteger max: anInteger!! !! |
|
744 |
|
745 !!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:56''!! |
|
746 min: aMinInteger max: aMaxInteger greedy: aParser |
|
747 "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed." |
|
748 |
|
749 ^ (self starGreedy: aParser) setMin: aMinInteger; setMax: aMaxInteger!! !! |
|
750 |
|
751 !!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/2/2011 10:02''!! |
|
752 star |
|
753 "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." |
|
754 |
|
755 ^ PPPossessiveRepeatingParser on: self!! !! |
|
756 |
|
757 !!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:02''!! |
|
758 min: anInteger |
|
759 "Answer a new parser that parses the receiver at least anInteger times." |
|
760 |
|
761 ^ self star setMin: anInteger!! !! |
|
762 |
|
763 !!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:03''!! |
|
764 min: aMinInteger max: aMaxInteger |
|
765 "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times." |
|
766 |
|
767 ^ self star setMin: aMinInteger; setMax: aMaxInteger!! !! |
|
768 |
|
769 !!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/2/2011 10:01''!! |
|
770 starGreedy: aParser |
|
771 "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." |
|
772 |
|
773 ^ PPGreedyRepeatingParser on: self limit: aParser!! !! |
|
774 |
|
775 !!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:57''!! |
|
776 min: aMinInteger max: aMaxInteger lazy: aParser |
|
777 "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed." |
|
778 |
|
779 ^ (self starLazy: aParser) setMin: aMinInteger; setMax: aMaxInteger!! !! |
|
780 |
|
781 !!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:57''!! |
|
782 min: anInteger lazy: aParser |
|
783 "Answer a new parser that parses the receiver at least anInteger times until it reaches aParser. This is a lazy non-blind implementation. aParser is not consumed." |
|
784 |
|
785 ^ (self starLazy: aParser) setMin: anInteger!! !! |
|
786 |
|
787 !!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:56''!! |
|
788 max: anInteger greedy: aParser |
|
789 "Answer a new parser that parses the receiver at most anInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed." |
|
790 |
|
791 ^ (self starGreedy: aParser) setMax: anInteger!! !! |
|
792 |
|
793 !!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:03''!! |
|
794 plus |
|
795 "Answer a new parser that parses the receiver one or more times." |
|
796 |
|
797 ^ self star setMin: 1!! !! |
|
798 |
|
799 !!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:56''!! |
|
800 min: anInteger greedy: aParser |
|
801 "Answer a new parser that parses the receiver at least anInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed." |
|
802 |
|
803 ^ (self starGreedy: aParser) setMin: anInteger!! !! |
|
804 |
|
805 !!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:03''!! |
|
806 max: anInteger |
|
807 "Answer a new parser that parses the receiver at most anInteger times." |
|
808 |
|
809 ^ self star setMax: anInteger!! !! |
|
810 |
|
811 !!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:04''!! |
|
812 plusGreedy: aParser |
|
813 "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." |
|
814 |
|
815 ^ (self starGreedy: aParser) setMin: 1!! !! |
|
816 |
|
817 !!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:04''!! |
|
818 plusLazy: aParser |
|
819 "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." |
|
820 |
|
821 ^ (self starLazy: aParser) setMin: 1!! !! |
|
822 |
|
823 |
|
824 !!PPParser methodsFor: ''*petitsmalltalk-operations'' stamp: ''lr 6/29/2010 14:27''!! |
|
825 smalltalkToken |
|
826 ^ PPSmalltalkTokenParser on: self!! !! |
|
827 |
|
828 |
|
829 !!PPParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 5/22/2010 10:45''!! |
|
830 isTerminal |
|
831 "Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser." |
|
832 |
|
833 ^ self children isEmpty!! !! |
|
834 |
|
835 !!PPParser methodsFor: ''*petitanalyzer-testing'' stamp: ''JanKurs 5/31/2013 11:49''!! |
|
836 isFirstSetTerminal |
|
837 "Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser." |
|
838 |
|
839 ^ self children isEmpty!! !! |
|
840 |
|
841 !!PPParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 11/12/2009 17:25''!! |
|
842 isNullable |
|
843 "Answer true if the receiver is a nullable parser, e.g. it can successfully parse nothing." |
|
844 |
|
845 ^ false!! !! |
|
846 |
|
847 |
|
848 !!PPParser methodsFor: ''converting'' stamp: ''lr 11/29/2011 20:48''!! |
|
849 asParser |
|
850 "Answer the receiving parser." |
|
851 |
|
852 ^ self!! !! |
|
853 |
|
854 |
|
855 !!PPParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 16:36''!! |
|
856 printNameOn: aStream |
|
857 self name isNil |
|
858 ifTrue: [ aStream print: self hash ] |
|
859 ifFalse: [ aStream nextPutAll: self name ]!! !! |
|
860 |
|
861 !!PPParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 16:36''!! |
|
862 printOn: aStream |
|
863 super printOn: aStream. |
|
864 aStream nextPut: $(. |
|
865 self printNameOn: aStream. |
|
866 aStream nextPut: $)!! !! |
|
867 |
|
868 |
|
869 !!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:37''!! |
|
870 example |
|
871 ^ String streamContents: [ :stream | self exampleOn: stream ] limitedTo: 1024!! !! |
|
872 |
|
873 !!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:20''!! |
|
874 exampleOn: aStream!! !! |
|
875 |
|
876 !!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 9/12/2011 18:34''!! |
|
877 displayColor |
|
878 ^ self isTerminal |
|
879 ifTrue: [ Color r: 0.5 g: 0.0 b: 0.5 ] |
|
880 ifFalse: [ Color blue ]!! !! |
|
881 |
|
882 !!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/6/2009 18:31''!! |
|
883 displayName |
|
884 ^ self name isNil |
|
885 ifFalse: [ self name asString ] |
|
886 ifTrue: [ self class name asString ]!! !! |
|
887 |
|
888 !!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:11''!! |
|
889 backgroundForDepth: anInteger |
|
890 ^ Color gray: 1.0 - (anInteger / 20.0)!! !! |
|
891 |
|
892 |
|
893 !!PPParser methodsFor: ''parsing'' stamp: ''lr 10/29/2010 17:05''!! |
|
894 parse: anObject onError: aBlock |
|
895 "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." |
|
896 |
|
897 | result | |
|
898 result := self parse: anObject. |
|
899 result isPetitFailure |
|
900 ifFalse: [ ^ result ]. |
|
901 aBlock numArgs = 0 |
|
902 ifTrue: [ ^ aBlock value ]. |
|
903 aBlock numArgs = 1 |
|
904 ifTrue: [ ^ aBlock value: result ]. |
|
905 ^ aBlock value: result message value: result position!! !! |
|
906 |
|
907 !!PPParser methodsFor: ''parsing'' stamp: ''lr 6/4/2011 18:12''!! |
|
908 matchesIn: anObject |
|
909 "Search anObject repeatedly for the matches of the receiver. Answered an OrderedCollection of the matched parse-trees." |
|
910 |
|
911 | result | |
|
912 result := OrderedCollection new. |
|
913 self |
|
914 matchesIn: anObject |
|
915 do: [ :each | result addLast: each ]. |
|
916 ^ result!! !! |
|
917 |
|
918 !!PPParser methodsFor: ''parsing'' stamp: ''lr 8/16/2011 07:26''!! |
|
919 matchesSkipIn: anObject |
|
920 "Search anObject repeatedly for the matches of the receiver. Answer an OrderedCollection of the matched parse-trees. Skip over matches." |
|
921 |
|
922 | result | |
|
923 result := OrderedCollection new. |
|
924 self |
|
925 matchesSkipIn: anObject |
|
926 do: [ :each | result addLast: each ]. |
|
927 ^ result!! !! |
|
928 |
|
929 !!PPParser methodsFor: ''parsing'' stamp: ''lr 2/25/2013 23:42''!! |
|
930 matchingSkipRangesIn: anObject do: aBlock |
|
931 "Search anObject repeatedly for the matches of the receiver. Skip over matches. Evaluate aBlock with the range of each match (index of first character to: index of last character)." |
|
932 |
|
933 self token |
|
934 matchesSkipIn: anObject |
|
935 do: [ :token | aBlock value: (token start to: token stop) ]!! !! |
|
936 |
|
937 !!PPParser methodsFor: ''parsing'' stamp: ''DamienCassou 10/29/2011 19:18''!! |
|
938 matchingSkipRangesIn: anObject |
|
939 "Search anObject repeatedly for the matches of the receiver. Skip over matches. Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)." |
|
940 |
|
941 | result | |
|
942 result := OrderedCollection new. |
|
943 self |
|
944 matchingSkipRangesIn: anObject |
|
945 do: [ :value | result addLast: value ]. |
|
946 ^ result!! !! |
|
947 |
|
948 !!PPParser methodsFor: ''parsing'' stamp: ''lr 6/4/2011 18:12''!! |
|
949 matchingRangesIn: anObject |
|
950 "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)." |
|
951 |
|
952 | result | |
|
953 result := OrderedCollection new. |
|
954 self |
|
955 matchingRangesIn: anObject |
|
956 do: [ :value | result addLast: value ]. |
|
957 ^ result!! !! |
|
958 |
|
959 !!PPParser methodsFor: ''parsing'' stamp: ''lr 8/16/2011 07:26''!! |
|
960 matchesSkipIn: anObject do: aBlock |
|
961 "Search anObject repeatedly for the matches of the receiver. Evaluate aBlock for each match with the matched parse-tree as the argument. Skip over matches." |
|
962 |
|
963 (self ==> aBlock / #any asParser) star parse: anObject!! !! |
|
964 |
|
965 !!PPParser methodsFor: ''parsing'' stamp: ''lr 2/25/2013 23:41''!! |
|
966 matchingRangesIn: anObject do: aBlock |
|
967 "Search anObject repeatedly for the matches of the receiver. Evaluate aBlock with the range of each match (index of first character to: index of last character)." |
|
968 |
|
969 self token |
|
970 matchesIn: anObject |
|
971 do: [ :token | aBlock value: (token start to: token stop) ]!! !! |
|
972 |
|
973 !!PPParser methodsFor: ''parsing'' stamp: ''lr 2/8/2010 00:30''!! |
|
974 matches: anObject |
|
975 "Answer if anObject can be parsed by the receiver." |
|
976 |
|
977 ^ (self parse: anObject) isPetitFailure not!! !! |
|
978 |
|
979 !!PPParser methodsFor: ''parsing'' stamp: ''lr 3/1/2010 21:51''!! |
|
980 matchesIn: anObject do: aBlock |
|
981 "Search anObject repeatedly for the matches of the receiver. Evaluate aBlock for each match with the matched parse-tree as the argument. Make sure to always consume exactly one character with each step, to not miss any match." |
|
982 |
|
983 ((self and ==> aBlock , #any asParser) / #any asParser) star parse: anObject!! !! |
|
984 |
|
985 |
|
986 !!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 5/31/2010 18:37''!! |
|
987 matchList: matchList index: matchIndex against: parserList index: parserIndex inContext: aDictionary seen: aSet |
|
988 | parser currentIndex currentDictionary currentSeen parsers | |
|
989 matchList size < matchIndex |
|
990 ifTrue: [ ^ parserList size < parserIndex ]. |
|
991 parser := matchList at: matchIndex. |
|
992 parser class = PPListPattern ifTrue: [ |
|
993 currentIndex := parserIndex - 1. |
|
994 [ currentDictionary := aDictionary copy. |
|
995 currentSeen := aSet copy. |
|
996 parserList size < currentIndex or: [ |
|
997 parsers := parserList copyFrom: parserIndex to: currentIndex. |
|
998 (currentDictionary at: parser ifAbsentPut: [ parsers ]) = parsers and: [ |
|
999 (self |
|
1000 matchList: matchList |
|
1001 index: matchIndex + 1 |
|
1002 against: parserList |
|
1003 index: currentIndex + 1 |
|
1004 inContext: currentDictionary |
|
1005 seen: currentSeen) |
|
1006 ifTrue: [ |
|
1007 currentDictionary keysAndValuesDo: [ :key :value | aDictionary at: key put: value ]. |
|
1008 ^ true ]. |
|
1009 false ] ] ] whileFalse: [ currentIndex := currentIndex + 1 ]. |
|
1010 ^ false ]. |
|
1011 parserList size < parserIndex |
|
1012 ifTrue: [ ^ false ]. |
|
1013 (parser match: (parserList at: parserIndex) inContext: aDictionary seen: aSet) |
|
1014 ifFalse: [ ^ false ]. |
|
1015 ^ self |
|
1016 matchList: matchList |
|
1017 index: matchIndex + 1 |
|
1018 against: parserList |
|
1019 index: parserIndex + 1 |
|
1020 inContext: aDictionary |
|
1021 seen: aSet!! !! |
|
1022 |
|
1023 !!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 7/17/2011 11:53''!! |
|
1024 copyInContext: aDictionary seen: aSeenDictionary |
|
1025 | copy | |
|
1026 aSeenDictionary |
|
1027 at: self |
|
1028 ifPresent: [ :value | ^ value ]. |
|
1029 copy := aSeenDictionary |
|
1030 at: self |
|
1031 put: self copy. |
|
1032 copy children do: [ :each | |
|
1033 copy |
|
1034 replace: each |
|
1035 with: (each copyInContext: aDictionary seen: aSeenDictionary) ]. |
|
1036 ^ copy!! !! |
|
1037 |
|
1038 !!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/30/2010 07:49''!! |
|
1039 copyInContext: aDictionary |
|
1040 ^ self copyInContext: aDictionary seen: IdentityDictionary new!! !! |
|
1041 |
|
1042 !!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/29/2010 23:07''!! |
|
1043 matchList: matchList against: parserList inContext: aDictionary seen: aSet |
|
1044 ^ self matchList: matchList index: 1 against: parserList index: 1 inContext: aDictionary seen: aSet!! !! |
|
1045 |
|
1046 !!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!! |
|
1047 match: aParser inContext: aDictionary seen: anIdentitySet |
|
1048 "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." |
|
1049 |
|
1050 (self == aParser or: [ anIdentitySet includes: self ]) |
|
1051 ifTrue: [ ^ true ]. |
|
1052 anIdentitySet add: self. |
|
1053 ^ self class = aParser class and: [ self matchList: self children against: aParser children inContext: aDictionary seen: anIdentitySet ]!! !! |
|
1054 |
|
1055 !!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/29/2010 23:14''!! |
|
1056 match: aParser inContext: aDictionary |
|
1057 ^ self match: aParser inContext: aDictionary seen: IdentitySet new!! !! |
|
1058 |
|
1059 |
|
1060 !!PPParser methodsFor: ''testing'' stamp: ''lr 10/27/2008 11:28''!! |
|
1061 isUnresolved |
|
1062 ^ false!! !! |
|
1063 |
|
1064 !!PPParser methodsFor: ''testing'' stamp: ''lr 8/6/2010 16:44''!! |
|
1065 isPetitParser |
|
1066 ^ true!! !! |
|
1067 |
|
1068 |
|
1069 !!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!! |
|
1070 propertyAt: aKey ifAbsentPut: aBlock |
|
1071 "Answer the property associated with aKey or, if aKey isn''t found store the result of evaluating aBlock as new value." |
|
1072 |
|
1073 ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]!! !! |
|
1074 |
|
1075 !!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:33''!! |
|
1076 removeProperty: aKey ifAbsent: aBlock |
|
1077 "Remove the property with aKey. Answer the value or, if aKey isn''t found, answer the result of evaluating aBlock." |
|
1078 |
|
1079 | answer | |
|
1080 properties isNil ifTrue: [ ^ aBlock value ]. |
|
1081 answer := properties removeKey: aKey ifAbsent: aBlock. |
|
1082 properties isEmpty ifTrue: [ properties := nil ]. |
|
1083 ^ answer!! !! |
|
1084 |
|
1085 !!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!! |
|
1086 propertyAt: aKey |
|
1087 "Answer the property value associated with aKey." |
|
1088 |
|
1089 ^ self propertyAt: aKey ifAbsent: [ self error: ''Property not found'' ]!! !! |
|
1090 |
|
1091 !!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!! |
|
1092 propertyAt: aKey ifAbsent: aBlock |
|
1093 "Answer the property value associated with aKey or, if aKey isn''t found, answer the result of evaluating aBlock." |
|
1094 |
|
1095 ^ properties isNil |
|
1096 ifTrue: [ aBlock value ] |
|
1097 ifFalse: [ properties at: aKey ifAbsent: aBlock ]!! !! |
|
1098 |
|
1099 !!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:33''!! |
|
1100 propertyAt: aKey put: anObject |
|
1101 "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." |
|
1102 |
|
1103 ^ (properties ifNil: [ properties := Dictionary new: 1 ]) |
|
1104 at: aKey put: anObject!! !! |
|
1105 |
|
1106 !!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!! |
|
1107 hasProperty: aKey |
|
1108 "Test if the property aKey is present." |
|
1109 |
|
1110 ^ properties notNil and: [ properties includesKey: aKey ]!! !! |
|
1111 |
|
1112 !!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:33''!! |
|
1113 removeProperty: aKey |
|
1114 "Remove the property with aKey. Answer the property or raise an error if aKey isn''t found." |
|
1115 |
|
1116 ^ self removeProperty: aKey ifAbsent: [ self error: ''Property not found'' ]!! !! |
|
1117 |
|
1118 |
|
1119 !!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:41''!! |
|
1120 visualizationGraphType |
|
1121 ^ nil!! !! |
|
1122 |
|
1123 !!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 17:26''!! |
|
1124 visualizeStructureInGraphOn: view |
|
1125 view shape rectangle |
|
1126 borderWidth: 1; |
|
1127 if: [ :p | p name isNil ] fillColor: Color lightGray. |
|
1128 |
|
1129 view interaction |
|
1130 item: ''Explore'' action: #explore; |
|
1131 highlightWhenOver: [ :p | |
|
1132 self allParsers select: [ :ch | ch children includes: p ] |
|
1133 ] color: Color orange muchLighter; |
|
1134 highlightWhenOver: [ :p | |children| |
|
1135 children := p namedChildren. |
|
1136 ] color: Color orange muchDarker; |
|
1137 highlightWhenOver: [ :p | Array with: p ] color: Color orange; |
|
1138 popupText: [:p | p class name asString ]. |
|
1139 |
|
1140 view |
|
1141 nodes: self allParsers |
|
1142 forEach: [ :aParser | |labels| |
|
1143 labels := OrderedCollection new. |
|
1144 aParser name notNil ifTrue: [ labels add: aParser name ]. |
|
1145 aParser visualizationGraphType notNil ifTrue: [ labels add: aParser visualizationGraphType ]. |
|
1146 labels isEmpty ifFalse: [ |
|
1147 view shape label. |
|
1148 view interaction forwarder. |
|
1149 view nodes: labels asArray ]. |
|
1150 ]. |
|
1151 |
|
1152 view shape: (ROLine new add: (ROArrow new size: 4) offset: 0.1). |
|
1153 view edgesToAll: #children. |
|
1154 view treeLayout |
|
1155 layered; |
|
1156 on: ROLayoutEnd do: [ :evt | ROFocusView on: (view raw elementFromModel: self) ]. |
|
1157 |
|
1158 view zoomInButton. |
|
1159 view zoomOutButton.!! !! |
|
1160 |
|
1161 !!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''tg 8/25/2010 00:32''!! |
|
1162 namedParsersDo: aBlock |
|
1163 self namedParsersDo: aBlock seen: IdentitySet new!! !! |
|
1164 |
|
1165 !!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''VincentBlondeau 2/14/2014 17:06''!! |
|
1166 viewAllNamedParsersWithSelection: aCollectionOfNames previewing: aBlock on: view |
|
1167 view shape label |
|
1168 color: [ :each | |
|
1169 (aCollectionOfNames includes: each name) |
|
1170 ifFalse: [ Color black ] |
|
1171 ifTrue: [ Color red ] ]; |
|
1172 text: [ :each | each displayName ]. |
|
1173 view interaction popupText: aBlock. |
|
1174 view interaction item: ''Explore'' action: #explore. |
|
1175 view nodes: (self allParsers reject: [ :each | each name isEmptyOrNil ]). |
|
1176 view edges: (self allParsers reject: [ :each | each name isEmptyOrNil ]) from: #yourself toAll: #namedParsers. |
|
1177 view horizontalDominanceTreeLayout |
|
1178 verticalGap: 10; |
|
1179 layered!! !! |
|
1180 |
|
1181 !!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 17:21''!! |
|
1182 visualizeStructureInGraph |
|
1183 |
|
1184 " |
|
1185 PPSmalltalkParser new visualize |
|
1186 |
|
1187 |
|
1188 " |
|
1189 | view | |
|
1190 |
|
1191 view := ROMondrianViewBuilder new. |
|
1192 self visualizeStructureInGraphOn: view. |
|
1193 view open. |
|
1194 ^ view!! !! |
|
1195 |
|
1196 !!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''VincentBlondeau 2/14/2014 17:06''!! |
|
1197 viewAllNamedParsersOn: view |
|
1198 view shape |
|
1199 rectangleWithoutBorder; |
|
1200 withText: #displayName. |
|
1201 view nodes: (self allParsers reject: [ :each | each name isEmptyOrNil ]). |
|
1202 view edgesToAll: #namedParsers. |
|
1203 view horizontalDominanceTreeLayout layered!! !! |
|
1204 |
|
1205 !!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''TudorGirba 12/6/2011 07:43''!! |
|
1206 viewAllNamedParsersWithSelection: aCollectionOfNames on: view |
|
1207 self viewAllNamedParsersWithSelection: aCollectionOfNames previewing: [ :each | each name ] on: view!! !! |
|
1208 |
|
1209 !!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''TudorGirba 12/14/2011 12:40''!! |
|
1210 namedParsersDo: aBlock seen: aSet |
|
1211 self children do: [ :each | |
|
1212 (aSet includes: each) |
|
1213 ifFalse: [ |
|
1214 aSet add: each. |
|
1215 each name isEmptyOrNil |
|
1216 ifFalse: [ aBlock value: each ] |
|
1217 ifTrue: [ each namedParsersDo: aBlock seen: aSet ] ] ]!! !! |
|
1218 |
|
1219 !!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''TudorGirba 6/5/2013 23:01''!! |
|
1220 viewAllNamedParsers |
|
1221 | view | |
|
1222 view := ROMondrianViewBuilder new. |
|
1223 self viewAllNamedParsersOn: view. |
|
1224 ^ view open setLabel: ''All named parsers''!! !! |
|
1225 |
|
1226 !!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''tg 8/25/2010 00:31''!! |
|
1227 namedParsers |
|
1228 | result | |
|
1229 result := OrderedCollection new. |
|
1230 self namedParsersDo: [ :parser | result addLast: parser ]. |
|
1231 ^ result!! !! |
|
1232 |
|
1233 |
|
1234 !!PPParser methodsFor: ''*petitanalyzer-enumerating'' stamp: ''lr 4/13/2010 08:36''!! |
|
1235 allParsers |
|
1236 "Answer all the parse nodes of the receiver." |
|
1237 |
|
1238 | result | |
|
1239 result := OrderedCollection new. |
|
1240 self allParsersDo: [ :parser | result addLast: parser ]. |
|
1241 ^ result!! !! |
|
1242 |
|
1243 !!PPParser methodsFor: ''*petitanalyzer-enumerating'' stamp: ''lr 4/13/2010 08:36''!! |
|
1244 allParsersDo: aBlock |
|
1245 "Iterate over all the parse nodes of the receiver." |
|
1246 |
|
1247 self allParsersDo: aBlock seen: IdentitySet new!! !! |
|
1248 |
|
1249 !!PPParser methodsFor: ''*petitanalyzer-enumerating'' stamp: ''lr 4/13/2010 08:35''!! |
|
1250 allParsersDo: aBlock seen: aSet |
|
1251 "Iterate over all the parse nodes of the receiver, do not visit and follow the ones contained in aSet." |
|
1252 |
|
1253 (aSet includes: self) |
|
1254 ifTrue: [ ^ self ]. |
|
1255 aSet add: self. |
|
1256 aBlock value: self. |
|
1257 self children |
|
1258 do: [ :each | each allParsersDo: aBlock seen: aSet ]!! !! |
|
1259 |
|
1260 |
|
1261 !!PPParser methodsFor: ''operators-convenience'' stamp: ''lr 2/19/2010 07:56''!! |
|
1262 separatedBy: aParser |
|
1263 "Answer a new parser that parses the receiver one or more times, separated by aParser." |
|
1264 |
|
1265 ^ (PPSequenceParser with: self with: (PPSequenceParser with: aParser with: self) star) ==> [ :nodes | |
|
1266 | result | |
|
1267 result := Array new: 2 * nodes second size + 1. |
|
1268 result at: 1 put: nodes first. |
|
1269 nodes second |
|
1270 keysAndValuesDo: [ :index :pair | result replaceFrom: 2 * index to: 2 * index + 1 with: pair startingAt: 1 ]. |
|
1271 result ]!! !! |
|
1272 |
|
1273 !!PPParser methodsFor: ''operators-convenience'' stamp: ''lr 2/19/2010 07:42''!! |
|
1274 delimitedBy: aParser |
|
1275 "Answer a new parser that parses the receiver one or more times, separated and possibly ended by aParser." |
|
1276 |
|
1277 ^ (self separatedBy: aParser) , (aParser optional) ==> [ :node | |
|
1278 node second isNil |
|
1279 ifTrue: [ node first ] |
|
1280 ifFalse: [ node first copyWith: node second ] ]!! !! |
|
1281 |
|
1282 !!PPParser methodsFor: ''operators-convenience'' stamp: ''lr 2/25/2012 16:54''!! |
|
1283 withoutSeparators |
|
1284 "Filters out the separators from a parse result produced by one of the productions #delimitedBy: or #separatedBy:." |
|
1285 |
|
1286 ^ self ==> [ :items | |
|
1287 | result | |
|
1288 result := Array new: items size + 1 // 2. |
|
1289 1 to: result size do: [ :index | result at: index put: (items at: 2 * index - 1) ]. |
|
1290 result ]!! !! |
|
1291 |
|
1292 |
|
1293 !!PPParser methodsFor: ''copying'' stamp: ''lr 4/19/2010 10:33''!! |
|
1294 postCopy |
|
1295 super postCopy. |
|
1296 properties := properties copy!! !! |
|
1297 |
|
1298 |
|
1299 !!PPParser methodsFor: ''initialization'' stamp: ''lr 4/24/2008 10:33''!! |
|
1300 initialize!! !! |
|
1301 |
|
1302 |
|
1303 !!PPParser methodsFor: ''*petitgui-morphic-creational'' stamp: ''lr 11/17/2009 21:58''!! |
|
1304 newColumnMorph |
|
1305 ^ AlignmentMorph newColumn |
|
1306 cellPositioning: #topLeft; |
|
1307 color: Color transparent; |
|
1308 listCentering: #topLeft; |
|
1309 vResizing: #shrinkWrap; |
|
1310 hResizing: #shrinkWrap; |
|
1311 layoutInset: 0; |
|
1312 yourself!! !! |
|
1313 |
|
1314 !!PPParser methodsFor: ''*petitgui-morphic-creational'' stamp: ''lr 11/17/2009 21:57''!! |
|
1315 newRowMorph |
|
1316 ^ AlignmentMorph newRow |
|
1317 cellPositioning: #topLeft; |
|
1318 color: Color transparent; |
|
1319 listCentering: #topLeft; |
|
1320 vResizing: #shrinkWrap; |
|
1321 hResizing: #shrinkWrap; |
|
1322 layoutInset: 0; |
|
1323 yourself!! !! |
|
1324 |
|
1325 !!PPParser methodsFor: ''*petitgui-morphic-creational'' stamp: ''lr 11/17/2009 22:03''!! |
|
1326 newSpacerMorph |
|
1327 ^ Morph new |
|
1328 color: Color transparent; |
|
1329 borderWidth: 0; |
|
1330 extent: 7 @ 7; |
|
1331 yourself!! !! |
|
1332 |
|
1333 |
|
1334 !!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 9/16/2010 17:55''!! |
|
1335 followSets |
|
1336 "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." |
|
1337 |
|
1338 | current previous continue firstSets followSets | |
|
1339 current := previous := 0. |
|
1340 firstSets := self firstSets. |
|
1341 followSets := IdentityDictionary new. |
|
1342 self allParsersDo: [ :each | followSets at: each put: IdentitySet new ]. |
|
1343 (followSets at: self) add: PPSentinel instance. |
|
1344 [ followSets keysAndValuesDo: [ :parser :follow | |
|
1345 parser |
|
1346 followSets: followSets |
|
1347 firstSets: firstSets |
|
1348 into: follow ]. |
|
1349 current := followSets |
|
1350 inject: 0 |
|
1351 into: [ :result :each | result + each size ]. |
|
1352 continue := previous < current. |
|
1353 previous := current. |
|
1354 continue ] whileTrue. |
|
1355 ^ followSets!! !! |
|
1356 |
|
1357 !!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 10/22/2009 19:59''!! |
|
1358 firstSet |
|
1359 "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." |
|
1360 |
|
1361 ^ self firstSets at: self!! !! |
|
1362 |
|
1363 !!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 11/19/2009 23:49''!! |
|
1364 cycleSet |
|
1365 "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." |
|
1366 |
|
1367 | cycles | |
|
1368 cycles := IdentitySet new. |
|
1369 self cycleSet: OrderedCollection new firstSets: self firstSets into: cycles. |
|
1370 ^ cycles!! !! |
|
1371 |
|
1372 !!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''JanKurs 5/31/2013 11:49''!! |
|
1373 firstSets |
|
1374 "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." |
|
1375 |
|
1376 | firstSets | |
|
1377 firstSets := IdentityDictionary new. |
|
1378 self allParsersDo: [ :each | |
|
1379 firstSets at: each put: (each isFirstSetTerminal |
|
1380 ifTrue: [ IdentitySet with: each ] |
|
1381 ifFalse: [ IdentitySet new ]). |
|
1382 each isNullable |
|
1383 ifTrue: [ (firstSets at: each) add: PPSentinel instance ] ]. |
|
1384 [ | changed tally | |
|
1385 changed := false. |
|
1386 firstSets keysAndValuesDo: [ :parser :first | |
|
1387 tally := first size. |
|
1388 parser firstSets: firstSets into: first. |
|
1389 changed := changed or: [ tally ~= first size ] ]. |
|
1390 changed ] whileTrue. |
|
1391 ^ firstSets!! !! |
|
1392 |
|
1393 !!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 11/12/2009 21:13''!! |
|
1394 followSet |
|
1395 "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." |
|
1396 |
|
1397 ^ self followSets at: self!! !! |
|
1398 |
|
1399 |
|
1400 !!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:30''!! |
|
1401 parseOn: aPPContext |
|
1402 "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:." |
|
1403 |
|
1404 self subclassResponsibility!! !! |
|
1405 |
|
1406 !!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/17/2014 13:15''!! |
|
1407 debugWithContext: aPPContext |
|
1408 |
|
1409 ^ self enableDebug parseWithContext: aPPContext !! !! |
|
1410 |
|
1411 !!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/11/2014 13:33''!! |
|
1412 updateContext: aPPContext |
|
1413 "nothing to do"!! !! |
|
1414 |
|
1415 !!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 13:26''!! |
|
1416 parse: anObject withContext: aPPContext |
|
1417 "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure." |
|
1418 |
|
1419 aPPContext stream: anObject asPetitStream. |
|
1420 ^ self parseWithContext: aPPContext. |
|
1421 !! !! |
|
1422 |
|
1423 !!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 13:25''!! |
|
1424 parse: anObject |
|
1425 "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure." |
|
1426 |
|
1427 ^ self parse: anObject withContext: PPContext new!! !! |
|
1428 |
|
1429 !!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/19/2014 16:34''!! |
|
1430 parseWithContext: context |
|
1431 context root: self. |
|
1432 self updateContext: context. |
|
1433 ^ self parseOn: context!! !! |
|
1434 |
|
1435 |
|
1436 !!PPParser methodsFor: ''accessing'' stamp: ''lr 10/21/2009 16:38''!! |
|
1437 children |
|
1438 "Answer a set of child parsers that could follow the receiver." |
|
1439 |
|
1440 ^ #()!! !! |
|
1441 |
|
1442 !!PPParser methodsFor: ''accessing'' stamp: ''lr 4/19/2010 10:38''!! |
|
1443 name: aString |
|
1444 self propertyAt: #name put: aString!! !! |
|
1445 |
|
1446 !!PPParser methodsFor: ''accessing'' stamp: ''lr 4/19/2010 10:35''!! |
|
1447 name |
|
1448 "Answer the production name of the receiver." |
|
1449 |
|
1450 ^ self propertyAt: #name ifAbsent: [ nil ]!! !! |
|
1451 |
|
1452 |
|
1453 !!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 11/19/2009 23:47''!! |
|
1454 cycleSet: aDictionary |
|
1455 "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." |
|
1456 |
|
1457 ^ self children!! !! |
|
1458 |
|
1459 !!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 5/22/2010 10:45''!! |
|
1460 cycleSet: aStack firstSets: aDictionary into: aSet |
|
1461 "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." |
|
1462 |
|
1463 | index | |
|
1464 self isTerminal |
|
1465 ifTrue: [ ^ self ]. |
|
1466 (index := aStack indexOf: self) > 0 |
|
1467 ifTrue: [ ^ aSet addAll: (aStack copyFrom: index to: aStack size) ]. |
|
1468 aStack addLast: self. |
|
1469 (self cycleSet: aDictionary) |
|
1470 do: [ :each | each cycleSet: aStack firstSets: aDictionary into: aSet ]. |
|
1471 aStack removeLast!! !! |
|
1472 |
|
1473 !!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 11/12/2009 21:25''!! |
|
1474 firstSets: aFirstDictionary into: aSet |
|
1475 "PRIVATE: Try to add additional elements to the first-set aSet of the receiver, use the incomplete aFirstDictionary." |
|
1476 |
|
1477 self children do: [ :parser | aSet addAll: (aFirstDictionary at: parser) ]!! !! |
|
1478 |
|
1479 !!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 11/12/2009 21:25''!! |
|
1480 followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet |
|
1481 "PRIVATE: Try to add additional elements to the follow-set aSet of the receiver, use the incomplete aFollowDictionary and the complete aFirstDictionary." |
|
1482 |
|
1483 self children do: [ :parser | (aFollowDictionary at: parser) addAll: aSet ]!! !! |
|
1484 |
|
1485 |
|
1486 !!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 1/16/2014 15:41''!! |
|
1487 debug: anObject |
|
1488 "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure." |
|
1489 |
|
1490 ^ self enableDebug parse: anObject asPetitStream!! !! |
|
1491 |
|
1492 !!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 3/18/2014 12:21''!! |
|
1493 enableDebuggerOutput |
|
1494 self debuggerOutput: true.!! !! |
|
1495 |
|
1496 !!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 4/22/2013 18:04''!! |
|
1497 debuggerOutput: aBoolean |
|
1498 self propertyAt: #debuggerOutput put: aBoolean!! !! |
|
1499 |
|
1500 !!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 3/18/2014 12:21''!! |
|
1501 disableDebuggerOutput |
|
1502 self debuggerOutput: false. !! !! |
|
1503 |
|
1504 !!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 3/18/2014 17:01''!! |
|
1505 enableDebug |
|
1506 | root newParser | |
|
1507 root := PPParserDebuggerResult new. |
|
1508 |
|
1509 newParser := self transform: [:each | |
|
1510 each >=> [:stream :continuation | |
|
1511 | result child | |
|
1512 child := PPParserDebuggerResult new |
|
1513 parser: each; |
|
1514 parent: root. |
|
1515 root := root children add: child. |
|
1516 child start: stream position + 1. |
|
1517 child showChildren: each debuggerOutput. |
|
1518 result := continuation value. |
|
1519 child end: stream position. |
|
1520 root result: result. |
|
1521 root := root parent. |
|
1522 result |
|
1523 ] |
|
1524 ]. |
|
1525 |
|
1526 ^ PPDebugParser on: newParser root: root. |
|
1527 !! !! |
|
1528 |
|
1529 !!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 4/22/2013 18:04''!! |
|
1530 debuggerOutput |
|
1531 ^ self propertyAt: #debuggerOutput ifAbsentPut: true.!! !! |
|
1532 |
|
1533 |
|
1534 !!PPParser methodsFor: ''operators'' stamp: ''lr 2/19/2010 07:36''!! |
|
1535 negate |
|
1536 "Answer a new parser consumes any input token but the receiver." |
|
1537 |
|
1538 ^ self not , #any asParser ==> #second!! !! |
|
1539 |
|
1540 !!PPParser methodsFor: ''operators'' stamp: ''lr 9/1/2010 22:03''!! |
|
1541 optional |
|
1542 "Answer a new parser that parses the receiver, if possible." |
|
1543 |
|
1544 ^ PPOptionalParser on: self!! !! |
|
1545 |
|
1546 !!PPParser methodsFor: ''operators'' stamp: ''lr 12/3/2010 11:34''!! |
|
1547 def: aParser |
|
1548 "Redefine the receiver as the argument aParser. This method is useful when defining recursive parsers: instantiate a PPUnresolvedParser and later redefine it with another one." |
|
1549 |
|
1550 ^ self becomeForward: (aParser name: self name)!! !! |
|
1551 |
|
1552 !!PPParser methodsFor: ''operators'' stamp: ''lr 10/23/2008 14:05''!! |
|
1553 wrapped |
|
1554 "Answer a new parser that is simply wrapped." |
|
1555 |
|
1556 ^ PPDelegateParser on: self!! !! |
|
1557 |
|
1558 !!PPParser methodsFor: ''operators'' stamp: ''lr 5/31/2010 16:34''!! |
|
1559 memoized |
|
1560 "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." |
|
1561 |
|
1562 ^ PPMemoizedParser on: self!! !! |
|
1563 |
|
1564 !!PPParser methodsFor: ''operators'' stamp: ''lr 5/31/2010 15:12''!! |
|
1565 and |
|
1566 "Answer a new parser (logical and-predicate) that succeeds whenever the receiver does, but never consumes input." |
|
1567 |
|
1568 ^ PPAndParser on: self!! !! |
|
1569 |
|
1570 !!PPParser methodsFor: ''operators'' stamp: ''lr 4/14/2010 11:46''!! |
|
1571 / aParser |
|
1572 "Answer a new parser that parses the receiver, if the receiver fails try with aParser (ordered-choice)." |
|
1573 |
|
1574 ^ PPChoiceParser with: self with: aParser!! !! |
|
1575 |
|
1576 !!PPParser methodsFor: ''operators'' stamp: ''lr 4/30/2010 12:13''!! |
|
1577 end |
|
1578 "Answer a new parser that succeeds at the end of the input and return the result of the receiver." |
|
1579 |
|
1580 ^ PPEndOfInputParser on: self!! !! |
|
1581 |
|
1582 !!PPParser methodsFor: ''operators'' stamp: ''lr 5/31/2010 15:12''!! |
|
1583 not |
|
1584 "Answer a new parser (logical not-predicate) that succeeds whenever the receiver fails, but never consumes input." |
|
1585 |
|
1586 ^ PPNotParser on: self!! !! |
|
1587 |
|
1588 !!PPParser methodsFor: ''operators'' stamp: ''lr 4/14/2010 11:53''!! |
|
1589 | aParser |
|
1590 "Answer a new parser that either parses the receiver or aParser. Fail if both pass or fail (exclusive choice, unordered choice)." |
|
1591 |
|
1592 ^ (self not , aParser) / (aParser not , self) ==> #second!! !! |
|
1593 |
|
1594 !!PPParser methodsFor: ''operators'' stamp: ''lr 9/23/2008 18:32''!! |
|
1595 , aParser |
|
1596 "Answer a new parser that parses the receiver followed by aParser." |
|
1597 |
|
1598 ^ PPSequenceParser with: self with: aParser!! !! |
|
1599 |
|
1600 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
1601 |
|
1602 PPParser class |
|
1603 instanceVariableNames: ''''!! |
|
1604 !!PPParser class commentStamp: ''<historical>'' prior: 0!! |
|
1605 !! |
|
1606 |
|
1607 |
|
1608 !!PPParser class methodsFor: ''instance creation'' stamp: ''lr 10/27/2008 11:17''!! |
|
1609 named: aString |
|
1610 ^ self new name: aString!! !! |
|
1611 |
|
1612 !!PPParser class methodsFor: ''instance creation'' stamp: ''lr 4/18/2008 14:00''!! |
|
1613 new |
|
1614 ^ self basicNew initialize!! !! |
|
1615 |
|
1616 |
|
1617 PPParser subclass: #PPPluggableParser |
|
1618 instanceVariableNames: ''block'' |
|
1619 classVariableNames: '''' |
|
1620 poolDictionaries: '''' |
|
1621 category: ''PetitParser-Parsers''!! |
|
1622 !!PPPluggableParser commentStamp: ''<historical>'' prior: 0!! |
|
1623 A pluggable parser that passes the parser stream into a block. This enables users to perform manual parsing or to embed other parser frameworks into PetitParser. |
|
1624 |
|
1625 Instance Variables: |
|
1626 block <BlockClosure> The pluggable one-argument block. |
|
1627 !! |
|
1628 |
|
1629 |
|
1630 !!PPPluggableParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!! |
|
1631 match: aParser inContext: aDictionary seen: anIdentitySet |
|
1632 ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ]!! !! |
|
1633 |
|
1634 |
|
1635 !!PPPluggableParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 16:52''!! |
|
1636 initializeOn: aBlock |
|
1637 block := aBlock!! !! |
|
1638 |
|
1639 |
|
1640 !!PPPluggableParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:42''!! |
|
1641 parseOn: aPPContext |
|
1642 | position result | |
|
1643 position := aPPContext remember. |
|
1644 result := block value: aPPContext. |
|
1645 result isPetitFailure |
|
1646 ifTrue: [ aPPContext restore: position ]. |
|
1647 ^ result!! !! |
|
1648 |
|
1649 |
|
1650 !!PPPluggableParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:41''!! |
|
1651 displayName |
|
1652 ^ String streamContents: [ :stream | block decompile shortPrintOn: stream ]!! !! |
|
1653 |
|
1654 |
|
1655 !!PPPluggableParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:10''!! |
|
1656 block |
|
1657 "Answer the pluggable block." |
|
1658 |
|
1659 ^ block!! !! |
|
1660 |
|
1661 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
1662 |
|
1663 PPPluggableParser class |
|
1664 instanceVariableNames: ''''!! |
|
1665 !!PPPluggableParser class commentStamp: ''<historical>'' prior: 0!! |
|
1666 !! |
|
1667 |
|
1668 |
|
1669 !!PPPluggableParser class methodsFor: ''instance creation'' stamp: ''lr 5/2/2010 16:52''!! |
|
1670 on: aBlock |
|
1671 ^ self new initializeOn: aBlock!! !! |
|
1672 |
|
1673 |
|
1674 PPParser subclass: #PPFailingParser |
|
1675 instanceVariableNames: ''message'' |
|
1676 classVariableNames: '''' |
|
1677 poolDictionaries: '''' |
|
1678 category: ''PetitParser-Parsers''!! |
|
1679 !!PPFailingParser commentStamp: ''<historical>'' prior: 0!! |
|
1680 A parser that consumes nothing and always fails. |
|
1681 |
|
1682 Instance Variables: |
|
1683 message <String> The failure message.!! |
|
1684 |
|
1685 |
|
1686 !!PPFailingParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 19:16''!! |
|
1687 setMessage: aString |
|
1688 message := aString!! !! |
|
1689 |
|
1690 |
|
1691 !!PPFailingParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:59''!! |
|
1692 parseOn: aPPContext |
|
1693 ^ PPFailure message: message context: aPPContext!! !! |
|
1694 |
|
1695 |
|
1696 !!PPFailingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/6/2009 18:43''!! |
|
1697 displayName |
|
1698 ^ message!! !! |
|
1699 |
|
1700 !!PPFailingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:16''!! |
|
1701 displayColor |
|
1702 ^ Color red!! !! |
|
1703 |
|
1704 |
|
1705 !!PPFailingParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 21:27''!! |
|
1706 printNameOn: aStream |
|
1707 super printNameOn: aStream. |
|
1708 aStream nextPutAll: '', ''; print: message!! !! |
|
1709 |
|
1710 |
|
1711 !!PPFailingParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/30/2010 12:01''!! |
|
1712 match: aParser inContext: aDictionary seen: anIdentitySet |
|
1713 ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self message = aParser message ]!! !! |
|
1714 |
|
1715 |
|
1716 !!PPFailingParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:10''!! |
|
1717 message |
|
1718 "Answer the error message of the receiving parser." |
|
1719 |
|
1720 ^ message!! !! |
|
1721 |
|
1722 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
1723 |
|
1724 PPFailingParser class |
|
1725 instanceVariableNames: ''''!! |
|
1726 !!PPFailingParser class commentStamp: ''<historical>'' prior: 0!! |
|
1727 !! |
|
1728 |
|
1729 |
|
1730 !!PPFailingParser class methodsFor: ''instance creation'' stamp: ''lr 5/2/2010 19:16''!! |
|
1731 message: aString |
|
1732 ^ self new setMessage: aString!! !! |
|
1733 |
|
1734 |
|
1735 PPParser subclass: #PPLiteralParser |
|
1736 instanceVariableNames: ''literal message'' |
|
1737 classVariableNames: '''' |
|
1738 poolDictionaries: '''' |
|
1739 category: ''PetitParser-Parsers''!! |
|
1740 !!PPLiteralParser commentStamp: ''<historical>'' prior: 0!! |
|
1741 Abstract literal parser that parses some kind of literal type (to be specified by subclasses). |
|
1742 |
|
1743 Instance Variables: |
|
1744 literal <Object> The literal object to be parsed. |
|
1745 message <String> The error message to be generated. |
|
1746 !! |
|
1747 |
|
1748 |
|
1749 !!PPLiteralParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 9/15/2010 12:08''!! |
|
1750 match: aParser inContext: aDictionary seen: anIdentitySet |
|
1751 ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self literal = aParser literal and: [ self message = aParser message ] ]!! !! |
|
1752 |
|
1753 |
|
1754 !!PPLiteralParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 17:25''!! |
|
1755 visualizationGraphType |
|
1756 ^ literal printString!! !! |
|
1757 |
|
1758 |
|
1759 !!PPLiteralParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:19''!! |
|
1760 displayName |
|
1761 ^ literal printString!! !! |
|
1762 |
|
1763 |
|
1764 !!PPLiteralParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:26''!! |
|
1765 message |
|
1766 "Answer the failure message." |
|
1767 |
|
1768 ^ message!! !! |
|
1769 |
|
1770 !!PPLiteralParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:26''!! |
|
1771 literal |
|
1772 "Answer the parsed literal." |
|
1773 |
|
1774 ^ literal!! !! |
|
1775 |
|
1776 |
|
1777 !!PPLiteralParser methodsFor: ''operators'' stamp: ''lr 6/1/2010 22:24''!! |
|
1778 caseInsensitive |
|
1779 "Answer a parser that can parse the receiver case-insensitive." |
|
1780 |
|
1781 self subclassResponsibility!! !! |
|
1782 |
|
1783 |
|
1784 !!PPLiteralParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 13:25''!! |
|
1785 initializeOn: anObject message: aString |
|
1786 literal := anObject. |
|
1787 message := aString!! !! |
|
1788 |
|
1789 |
|
1790 !!PPLiteralParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 16:38''!! |
|
1791 printNameOn: aStream |
|
1792 super printNameOn: aStream. |
|
1793 aStream nextPutAll: '', ''; print: literal!! !! |
|
1794 |
|
1795 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
1796 |
|
1797 PPLiteralParser class |
|
1798 instanceVariableNames: ''''!! |
|
1799 !!PPLiteralParser class commentStamp: ''<historical>'' prior: 0!! |
|
1800 !! |
|
1801 |
|
1802 |
|
1803 !!PPLiteralParser class methodsFor: ''instance creation'' stamp: ''lr 1/7/2010 15:29''!! |
|
1804 on: anObject message: aString |
|
1805 ^ self new initializeOn: anObject message: aString!! !! |
|
1806 |
|
1807 !!PPLiteralParser class methodsFor: ''instance creation'' stamp: ''lr 1/7/2010 15:30''!! |
|
1808 on: anObject |
|
1809 ^ self on: anObject message: anObject printString , '' expected''!! !! |
|
1810 |
|
1811 |
|
1812 PPLiteralParser subclass: #PPLiteralObjectParser |
|
1813 instanceVariableNames: '''' |
|
1814 classVariableNames: '''' |
|
1815 poolDictionaries: '''' |
|
1816 category: ''PetitParser-Parsers''!! |
|
1817 !!PPLiteralObjectParser commentStamp: ''<historical>'' prior: 0!! |
|
1818 A parser that accepts a single literal object, such as a character. This is the same as the predicate parser ''PPPredicateParser expect: literal'' but slightly more efficient.!! |
|
1819 |
|
1820 |
|
1821 !!PPLiteralObjectParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:25''!! |
|
1822 exampleOn: aStream |
|
1823 aStream nextPut: literal!! !! |
|
1824 |
|
1825 |
|
1826 !!PPLiteralObjectParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:00''!! |
|
1827 parseOn: aPPContext |
|
1828 ^ (aPPContext stream atEnd not and: [ literal = aPPContext stream uncheckedPeek ]) |
|
1829 ifFalse: [ PPFailure message: message context: aPPContext ] |
|
1830 ifTrue: [ aPPContext stream next ]!! !! |
|
1831 |
|
1832 |
|
1833 !!PPLiteralObjectParser methodsFor: ''operators'' stamp: ''lr 8/18/2010 20:16''!! |
|
1834 caseInsensitive |
|
1835 "Answer a parser that can parse the receiver case-insensitive." |
|
1836 |
|
1837 literal asUppercase = literal asLowercase ifTrue: [ ^ self ]. |
|
1838 ^ PPPredicateObjectParser on: [ :value | literal sameAs: value ] message: message!! !! |
|
1839 |
|
1840 !!PPLiteralObjectParser methodsFor: ''operators'' stamp: ''lr 4/28/2011 20:02''!! |
|
1841 negate |
|
1842 ^ (PPPredicateObjectParser expect: literal message: message) negate!! !! |
|
1843 |
|
1844 |
|
1845 PPParser subclass: #PPPredicateParser |
|
1846 instanceVariableNames: ''predicate predicateMessage negated negatedMessage'' |
|
1847 classVariableNames: '''' |
|
1848 poolDictionaries: '''' |
|
1849 category: ''PetitParser-Parsers''!! |
|
1850 !!PPPredicateParser commentStamp: ''<historical>'' prior: 0!! |
|
1851 An abstract parser that accepts if a given predicate holds. |
|
1852 |
|
1853 Instance Variables: |
|
1854 predicate <BlockClosure> The block testing for the predicate. |
|
1855 predicateMessage <String> The error message of the predicate. |
|
1856 negated <BlockClosure> The block testing for the negation of the predicate. |
|
1857 negatedMessage <String> The error message of the negated predicate.!! |
|
1858 |
|
1859 |
|
1860 !!PPPredicateParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 9/15/2010 11:56''!! |
|
1861 match: aParser inContext: aDictionary seen: anIdentitySet |
|
1862 ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block and: [ self message = aParser message ] ]!! !! |
|
1863 |
|
1864 |
|
1865 !!PPPredicateParser methodsFor: ''printing'' stamp: ''lr 5/2/2010 13:37''!! |
|
1866 printNameOn: aStream |
|
1867 super printNameOn: aStream. |
|
1868 aStream nextPutAll: '', ''; print: predicateMessage!! !! |
|
1869 |
|
1870 |
|
1871 !!PPPredicateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 5/1/2010 17:05''!! |
|
1872 exampleOn: aStream |
|
1873 "Produce a random character that is valid. If there are characters in the alpha-numeric range prefer those over all others." |
|
1874 |
|
1875 | valid normal | |
|
1876 valid := Character allCharacters |
|
1877 select: [ :char | self matches: (String with: char) ]. |
|
1878 normal := valid |
|
1879 select: [ :char | char asInteger < 127 and: [ char isAlphaNumeric ] ]. |
|
1880 aStream nextPut: (normal isEmpty |
|
1881 ifTrue: [ valid atRandom ] |
|
1882 ifFalse: [ normal atRandom ])!! !! |
|
1883 |
|
1884 !!PPPredicateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 5/2/2010 19:35''!! |
|
1885 displayName |
|
1886 ^ predicateMessage!! !! |
|
1887 |
|
1888 |
|
1889 !!PPPredicateParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:36''!! |
|
1890 message |
|
1891 "Answer the failure message." |
|
1892 |
|
1893 ^ predicateMessage!! !! |
|
1894 |
|
1895 !!PPPredicateParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:36''!! |
|
1896 block |
|
1897 "Answer the predicate block of the receiver." |
|
1898 |
|
1899 ^ predicate!! !! |
|
1900 |
|
1901 |
|
1902 PPPredicateParser subclass: #PPPredicateObjectParser |
|
1903 instanceVariableNames: '''' |
|
1904 classVariableNames: '''' |
|
1905 poolDictionaries: '''' |
|
1906 category: ''PetitParser-Parsers''!! |
|
1907 !!PPPredicateObjectParser commentStamp: ''<historical>'' prior: 0!! |
|
1908 A parser that accepts if a given predicate on one element of the input sequence holds.!! |
|
1909 |
|
1910 |
|
1911 !!PPPredicateObjectParser methodsFor: ''operators'' stamp: ''lr 6/12/2010 09:12''!! |
|
1912 negate |
|
1913 "Answer a parser that is the negation of the receiving predicate parser." |
|
1914 |
|
1915 ^ self class |
|
1916 on: negated message: negatedMessage |
|
1917 negated: predicate message: predicateMessage!! !! |
|
1918 |
|
1919 |
|
1920 !!PPPredicateObjectParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:03''!! |
|
1921 parseOn: aPPContext |
|
1922 ^ (aPPContext stream atEnd not and: [ predicate value: aPPContext stream uncheckedPeek ]) |
|
1923 ifFalse: [ PPFailure message: predicateMessage context: aPPContext ] |
|
1924 ifTrue: [ aPPContext stream next ]!! !! |
|
1925 |
|
1926 |
|
1927 !!PPPredicateObjectParser methodsFor: ''initialization'' stamp: ''lr 6/12/2010 09:12''!! |
|
1928 initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString |
|
1929 predicate := aBlock. |
|
1930 predicateMessage := aString. |
|
1931 negated := aNegatedBlock. |
|
1932 negatedMessage := aNegatedString!! !! |
|
1933 |
|
1934 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
1935 |
|
1936 PPPredicateObjectParser class |
|
1937 instanceVariableNames: ''''!! |
|
1938 !!PPPredicateObjectParser class commentStamp: ''<historical>'' prior: 0!! |
|
1939 !! |
|
1940 |
|
1941 |
|
1942 !!PPPredicateObjectParser class methodsFor: ''*petitregex-chars'' stamp: ''lr 8/30/2010 14:48''!! |
|
1943 control |
|
1944 ^ self chars: ((0 to: 31) collect: [ :each | Character value: each ]) message: ''control character expected''!! !! |
|
1945 |
|
1946 |
|
1947 !!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 8/25/2010 10:57''!! |
|
1948 expect: anObject |
|
1949 ^ self expect: anObject message: anObject printString , '' expected''!! !! |
|
1950 |
|
1951 !!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 4/1/2011 20:05''!! |
|
1952 anyExceptAnyOf: aCollection |
|
1953 ^ self |
|
1954 on: [ :each | (aCollection includes: each) not ] message: ''any except '' , aCollection printString , '' expected'' |
|
1955 negated: [ :each | aCollection includes: each ] message: aCollection printString , '' not expected''!! !! |
|
1956 |
|
1957 !!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 4/1/2011 20:05''!! |
|
1958 anyOf: aCollection |
|
1959 ^ self |
|
1960 on: [ :each | aCollection includes: each ] message: ''any of '' , aCollection printString , '' expected'' |
|
1961 negated: [ :each | (aCollection includes: each) not ] message: ''none of '' , aCollection printString , ''expected''!! !! |
|
1962 |
|
1963 !!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 6/12/2010 09:10''!! |
|
1964 any |
|
1965 ^ self |
|
1966 on: [ :each | true ] message: ''input expected'' |
|
1967 negated: [ :each | false ] message: ''no input expected''!! !! |
|
1968 |
|
1969 !!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 6/12/2010 09:10''!! |
|
1970 between: min and: max |
|
1971 ^ self |
|
1972 on: [ :each | each >= min and: [ each <= max ] ] message: min printString , ''..'' , max printString , '' expected'' |
|
1973 negated: [ :each | each < min or: [ each > max ] ] message: min printString , ''..'' , max printString , '' not expected''!! !! |
|
1974 |
|
1975 !!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 8/25/2010 10:57''!! |
|
1976 expect: anObject message: aString |
|
1977 ^ self |
|
1978 on: [ :each | each = anObject ] message: aString |
|
1979 negated: [ :each | each ~= anObject ] message: ''no '' , aString!! !! |
|
1980 |
|
1981 |
|
1982 !!PPPredicateObjectParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:10''!! |
|
1983 on: aBlock message: aString |
|
1984 ^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: ''no '' , aString!! !! |
|
1985 |
|
1986 !!PPPredicateObjectParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:10''!! |
|
1987 on: aBlock message: aString negated: aNegatedBlock message: aNegatedString |
|
1988 ^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString!! !! |
|
1989 |
|
1990 |
|
1991 !!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:02''!! |
|
1992 char: aCharacter |
|
1993 ^ self expect: aCharacter message: (String with: $" with: aCharacter with: $") , '' expected''!! !! |
|
1994 |
|
1995 !!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:04''!! |
|
1996 punctuation |
|
1997 ^ self chars: ''.,"''''?!!!!;:#$%&()*+-/<>=@[]\^_{}|~'' message: ''punctuation expected''!! !! |
|
1998 |
|
1999 !!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:02''!! |
|
2000 blank |
|
2001 ^ self chars: (String with: Character space with: Character tab) message: ''blank expected''!! !! |
|
2002 |
|
2003 !!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!! |
|
2004 hex |
|
2005 ^ self |
|
2006 on: (PPCharSetPredicate on: [ :char | |
|
2007 (char between: $0 and: $9) |
|
2008 or: [ (char between: $a and: $f) |
|
2009 or: [ (char between: $A and: $F) ] ] ]) |
|
2010 message: ''hex digit expected''!! !! |
|
2011 |
|
2012 !!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:04''!! |
|
2013 newline |
|
2014 ^ self chars: (String with: Character cr with: Character lf) message: ''newline expected''!! !! |
|
2015 |
|
2016 !!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!! |
|
2017 word |
|
2018 ^ self on: (PPCharSetPredicate on: [ :char | char isAlphaNumeric ]) message: ''letter or digit expected''!! !! |
|
2019 |
|
2020 !!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 6/12/2010 09:10''!! |
|
2021 lf |
|
2022 ^ self char: Character lf!! !! |
|
2023 |
|
2024 !!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!! |
|
2025 digit |
|
2026 ^ self on: (PPCharSetPredicate on: [ :char | char isDigit ]) message: ''digit expected''!! !! |
|
2027 |
|
2028 !!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:05''!! |
|
2029 letter |
|
2030 ^ self on: (PPCharSetPredicate on: [ :char | char isLetter ]) message: ''letter expected''!! !! |
|
2031 |
|
2032 !!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!! |
|
2033 uppercase |
|
2034 ^ self on: (PPCharSetPredicate on: [ :char | char isUppercase ]) message: ''uppercase letter expected''!! !! |
|
2035 |
|
2036 !!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:02''!! |
|
2037 cr |
|
2038 ^ self char: Character cr message: ''carriage return expected''!! !! |
|
2039 |
|
2040 !!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!! |
|
2041 space |
|
2042 ^ self on: (PPCharSetPredicate on: [ :char | char isSeparator ]) message: ''separator expected''!! !! |
|
2043 |
|
2044 !!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!! |
|
2045 lowercase |
|
2046 ^ self on: (PPCharSetPredicate on: [ :char | char isLowercase ]) message: ''lowercase letter expected''!! !! |
|
2047 |
|
2048 !!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:04''!! |
|
2049 tab |
|
2050 ^ self char: Character tab message: ''tab expected''!! !! |
|
2051 |
|
2052 !!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!! |
|
2053 chars: aCollection message: aString |
|
2054 ^ self on: (PPCharSetPredicate on: [ :char | aCollection includes: char ]) message: aString!! !! |
|
2055 |
|
2056 !!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 10:57''!! |
|
2057 char: aCharacter message: aString |
|
2058 ^ self expect: aCharacter message: aString!! !! |
|
2059 |
|
2060 |
|
2061 PPPredicateParser subclass: #PPPredicateSequenceParser |
|
2062 instanceVariableNames: ''size'' |
|
2063 classVariableNames: '''' |
|
2064 poolDictionaries: '''' |
|
2065 category: ''PetitParser-Parsers''!! |
|
2066 !!PPPredicateSequenceParser commentStamp: ''<historical>'' prior: 0!! |
|
2067 A parser that accepts if a given predicate on an arbitrary number of elements of the input sequence holds. |
|
2068 |
|
2069 Instance Variables: |
|
2070 size <Integer> The number of elements to consume.!! |
|
2071 |
|
2072 |
|
2073 !!PPPredicateSequenceParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!! |
|
2074 match: aParser inContext: aDictionary seen: anIdentitySet |
|
2075 ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self size = aParser size ]!! !! |
|
2076 |
|
2077 |
|
2078 !!PPPredicateSequenceParser methodsFor: ''operators'' stamp: ''lr 6/12/2010 09:14''!! |
|
2079 negate |
|
2080 "Answer a parser that is the negation of the receiving predicate parser." |
|
2081 |
|
2082 ^ self class |
|
2083 on: negated message: negatedMessage |
|
2084 negated: predicate message: predicateMessage |
|
2085 size: size!! !! |
|
2086 |
|
2087 |
|
2088 !!PPPredicateSequenceParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:03''!! |
|
2089 parseOn: aPPContext |
|
2090 | position result | |
|
2091 position := aPPContext remember. |
|
2092 result := aPPContext stream next: size. |
|
2093 (result size = size and: [ predicate value: result ]) |
|
2094 ifTrue: [ ^ result ]. |
|
2095 aPPContext restore: position. |
|
2096 ^ PPFailure message: predicateMessage context: aPPContext!! !! |
|
2097 |
|
2098 |
|
2099 !!PPPredicateSequenceParser methodsFor: ''accessing'' stamp: ''lr 6/12/2010 08:58''!! |
|
2100 size |
|
2101 "Answer the sequence size of the receiver." |
|
2102 |
|
2103 ^ size!! !! |
|
2104 |
|
2105 |
|
2106 !!PPPredicateSequenceParser methodsFor: ''initialization'' stamp: ''lr 6/12/2010 09:13''!! |
|
2107 initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger |
|
2108 predicate := aBlock. |
|
2109 predicateMessage := aString. |
|
2110 negated := aNegatedBlock. |
|
2111 negatedMessage := aNegatedString. |
|
2112 size := anInteger !! !! |
|
2113 |
|
2114 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
2115 |
|
2116 PPPredicateSequenceParser class |
|
2117 instanceVariableNames: ''''!! |
|
2118 !!PPPredicateSequenceParser class commentStamp: ''<historical>'' prior: 0!! |
|
2119 !! |
|
2120 |
|
2121 |
|
2122 !!PPPredicateSequenceParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:14''!! |
|
2123 on: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger |
|
2124 ^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger!! !! |
|
2125 |
|
2126 !!PPPredicateSequenceParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:14''!! |
|
2127 on: aBlock message: aString size: anInteger |
|
2128 ^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: ''no '' , aString size: anInteger !! !! |
|
2129 |
|
2130 |
|
2131 PPParser subclass: #PPDelegateParser |
|
2132 instanceVariableNames: ''parser'' |
|
2133 classVariableNames: '''' |
|
2134 poolDictionaries: '''' |
|
2135 category: ''PetitParser-Parsers''!! |
|
2136 !!PPDelegateParser commentStamp: ''<historical>'' prior: 0!! |
|
2137 A parser that delegates to another parser. |
|
2138 |
|
2139 Instance Variables: |
|
2140 parser <PPParser> The parser to delegate to.!! |
|
2141 |
|
2142 |
|
2143 !!PPDelegateParser methodsFor: ''accessing'' stamp: ''lr 10/21/2009 16:37''!! |
|
2144 children |
|
2145 ^ Array with: parser!! !! |
|
2146 |
|
2147 |
|
2148 !!PPDelegateParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 4/13/2010 09:39''!! |
|
2149 replace: aParser with: anotherParser |
|
2150 super replace: aParser with: anotherParser. |
|
2151 parser == aParser ifTrue: [ parser := anotherParser ]!! !! |
|
2152 |
|
2153 |
|
2154 !!PPDelegateParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!! |
|
2155 parseOn: aPPContext |
|
2156 ^ parser parseOn: aPPContext!! !! |
|
2157 |
|
2158 |
|
2159 !!PPDelegateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:27''!! |
|
2160 exampleOn: aStream |
|
2161 parser exampleOn: aStream!! !! |
|
2162 |
|
2163 !!PPDelegateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:20''!! |
|
2164 displayDescription |
|
2165 ^ nil!! !! |
|
2166 |
|
2167 |
|
2168 !!PPDelegateParser methodsFor: ''initialization'' stamp: ''lr 4/20/2008 16:23''!! |
|
2169 setParser: aParser |
|
2170 parser := aParser!! !! |
|
2171 |
|
2172 |
|
2173 !!PPDelegateParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 11:21''!! |
|
2174 morphicShapeSeen: aSet depth: anInteger |
|
2175 ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc | |
|
2176 self displayDescription isNil |
|
2177 ifTrue: [ cc value: parser ] |
|
2178 ifFalse: [ |
|
2179 self newRowMorph |
|
2180 addMorphBack: (self newColumnMorph |
|
2181 addMorphBack: (self newSpacerMorph height: 10); |
|
2182 addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1); |
|
2183 yourself); |
|
2184 addMorphBack: (self newRowMorph |
|
2185 color: (self backgroundForDepth: anInteger); |
|
2186 addMorphBack: (self newColumnMorph |
|
2187 addMorphBack: (cc value: parser); |
|
2188 addMorphBack: (self newRowMorph |
|
2189 hResizing: #spaceFill; |
|
2190 addMorphBack: (self newSpacerMorph |
|
2191 width: 20; |
|
2192 yourself); |
|
2193 addMorphBack: (self newColumnMorph |
|
2194 hResizing: #spaceFill; |
|
2195 listCentering: #center; |
|
2196 addMorphBack: (self newSpacerMorph); |
|
2197 addMorphBack: (StringMorph new |
|
2198 contents: self displayDescription; |
|
2199 yourself); |
|
2200 yourself); |
|
2201 yourself); |
|
2202 yourself); |
|
2203 addMorphBack: (self newColumnMorph |
|
2204 addMorphBack: (self newSpacerMorph height: 10); |
|
2205 addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1); |
|
2206 yourself); |
|
2207 yourself); |
|
2208 yourself ] ]!! !! |
|
2209 |
|
2210 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
2211 |
|
2212 PPDelegateParser class |
|
2213 instanceVariableNames: ''''!! |
|
2214 !!PPDelegateParser class commentStamp: ''<historical>'' prior: 0!! |
|
2215 !! |
|
2216 |
|
2217 |
|
2218 !!PPDelegateParser class methodsFor: ''instance creation'' stamp: ''lr 4/20/2008 16:22''!! |
|
2219 on: aParser |
|
2220 ^ self new setParser: aParser!! !! |
|
2221 |
|
2222 |
|
2223 PPDelegateParser subclass: #PPAndParser |
|
2224 instanceVariableNames: '''' |
|
2225 classVariableNames: '''' |
|
2226 poolDictionaries: '''' |
|
2227 category: ''PetitParser-Parsers''!! |
|
2228 !!PPAndParser commentStamp: ''TudorGirba 2/27/2011 22:22'' prior: 0!! |
|
2229 The and-predicate, a parser that succeeds whenever its delegate does, but does not consume the input stream [Parr 1994, 1995].!! |
|
2230 |
|
2231 |
|
2232 !!PPAndParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 5/1/2010 16:16''!! |
|
2233 exampleOn: aStream!! !! |
|
2234 |
|
2235 !!PPAndParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:17''!! |
|
2236 displayDescription |
|
2237 ^ ''and''!! !! |
|
2238 |
|
2239 |
|
2240 !!PPAndParser methodsFor: ''operators'' stamp: ''lr 5/1/2010 16:16''!! |
|
2241 and |
|
2242 ^ self!! !! |
|
2243 |
|
2244 |
|
2245 !!PPAndParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:50''!! |
|
2246 parseOn: aPPContext |
|
2247 | element position | |
|
2248 position := aPPContext remember. |
|
2249 element := parser parseOn: aPPContext. |
|
2250 aPPContext restore: position. |
|
2251 ^ element!! !! |
|
2252 |
|
2253 |
|
2254 PPDelegateParser subclass: #PPTrimmingParser |
|
2255 instanceVariableNames: ''trimmer'' |
|
2256 classVariableNames: '''' |
|
2257 poolDictionaries: '''' |
|
2258 category: ''PetitParser-Parsers''!! |
|
2259 !!PPTrimmingParser commentStamp: ''lr 4/6/2010 19:27'' prior: 0!! |
|
2260 A parser that silently consumes spaces before and after the delegate parser.!! |
|
2261 |
|
2262 |
|
2263 !!PPTrimmingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 4/14/2010 20:48''!! |
|
2264 exampleOn: aStream |
|
2265 super exampleOn: aStream. |
|
2266 aStream nextPut: Character space!! !! |
|
2267 |
|
2268 |
|
2269 !!PPTrimmingParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:42''!! |
|
2270 parseOn: aPPContext |
|
2271 | position element | |
|
2272 position := aPPContext remember. |
|
2273 [ (trimmer parseOn: aPPContext) isPetitFailure ] |
|
2274 whileFalse. |
|
2275 element := parser parseOn: aPPContext. |
|
2276 element isPetitFailure ifTrue: [ |
|
2277 aPPContext restore: position. |
|
2278 ^ element ]. |
|
2279 [ (trimmer parseOn: aPPContext) isPetitFailure ] |
|
2280 whileFalse. |
|
2281 ^ element!! !! |
|
2282 |
|
2283 |
|
2284 !!PPTrimmingParser methodsFor: ''initialization'' stamp: ''lr 7/31/2010 12:00''!! |
|
2285 setTrimmer: aParser |
|
2286 trimmer := aParser!! !! |
|
2287 |
|
2288 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
2289 |
|
2290 PPTrimmingParser class |
|
2291 instanceVariableNames: ''''!! |
|
2292 !!PPTrimmingParser class commentStamp: ''<historical>'' prior: 0!! |
|
2293 !! |
|
2294 |
|
2295 |
|
2296 !!PPTrimmingParser class methodsFor: ''instance creation'' stamp: ''lr 7/31/2010 12:01''!! |
|
2297 on: aParser trimmer: aTrimParser |
|
2298 ^ self new |
|
2299 setParser: aParser; |
|
2300 setTrimmer: aTrimParser; |
|
2301 yourself!! !! |
|
2302 |
|
2303 |
|
2304 PPDelegateParser subclass: #PPMemoizedParser |
|
2305 instanceVariableNames: ''buffer context'' |
|
2306 classVariableNames: '''' |
|
2307 poolDictionaries: '''' |
|
2308 category: ''PetitParser-Parsers''!! |
|
2309 !!PPMemoizedParser commentStamp: ''<historical>'' prior: 0!! |
|
2310 A memoized parser, for refraining redundant computations. |
|
2311 |
|
2312 Instance Variables: |
|
2313 stream <PositionableStream> The stream of the associated memento objects. |
|
2314 buffer <Array of: PPMemento> The buffer of memento objects. |
|
2315 !! |
|
2316 |
|
2317 |
|
2318 !!PPMemoizedParser methodsFor: ''operators'' stamp: ''lr 4/2/2009 19:48''!! |
|
2319 memoized |
|
2320 "Ther is no point in memoizing more than once." |
|
2321 |
|
2322 ^ self!! !! |
|
2323 |
|
2324 |
|
2325 !!PPMemoizedParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 13:20''!! |
|
2326 reset: aPPContext |
|
2327 context := aPPContext. |
|
2328 buffer := Dictionary new.!! !! |
|
2329 |
|
2330 !!PPMemoizedParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:00''!! |
|
2331 parseOn: aPPContext |
|
2332 | memento contextMemento aStream | |
|
2333 "TODO: JK memoizing needs review!!!!" |
|
2334 |
|
2335 contextMemento := aPPContext remember. |
|
2336 context == aPPContext |
|
2337 ifFalse: [ self reset: aPPContext ]. |
|
2338 memento := (buffer at: contextMemento ifAbsentPut: [ PPMemento new ]). |
|
2339 |
|
2340 memento contextMemento isNil |
|
2341 ifTrue: [ |
|
2342 aStream := aPPContext stream. |
|
2343 memento result: (aStream size - aStream position + 2 < memento count |
|
2344 ifTrue: [ PPFailure message: ''overflow'' context: aPPContext ] |
|
2345 ifFalse: [ memento increment. parser parseOn: aPPContext ]). |
|
2346 memento contextMemento: aPPContext remember ] |
|
2347 ifFalse: [ context restore: memento contextMemento ]. |
|
2348 ^ memento result.!! !! |
|
2349 |
|
2350 |
|
2351 PPDelegateParser subclass: #PPEndOfInputParser |
|
2352 instanceVariableNames: '''' |
|
2353 classVariableNames: '''' |
|
2354 poolDictionaries: '''' |
|
2355 category: ''PetitParser-Parsers''!! |
|
2356 !!PPEndOfInputParser commentStamp: ''lr 4/18/2008 13:46'' prior: 0!! |
|
2357 A parser that succeeds only at the end of the input stream.!! |
|
2358 |
|
2359 |
|
2360 !!PPEndOfInputParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:58''!! |
|
2361 parseOn: aPPContext |
|
2362 | position result | |
|
2363 position := aPPContext remember. |
|
2364 result := parser parseOn: aPPContext. |
|
2365 (result isPetitFailure or: [ aPPContext stream atEnd ]) |
|
2366 ifTrue: [ ^ result ]. |
|
2367 result := PPFailure |
|
2368 message: ''end of input expected'' |
|
2369 context: aPPContext. |
|
2370 aPPContext restore: position. |
|
2371 ^ result!! !! |
|
2372 |
|
2373 |
|
2374 !!PPEndOfInputParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:18''!! |
|
2375 displayDescription |
|
2376 ^ ''end of input''!! !! |
|
2377 |
|
2378 |
|
2379 !!PPEndOfInputParser methodsFor: ''operators'' stamp: ''lr 12/7/2009 08:53''!! |
|
2380 end |
|
2381 ^ self!! !! |
|
2382 |
|
2383 |
|
2384 PPDelegateParser subclass: #PPActionParser |
|
2385 instanceVariableNames: ''block'' |
|
2386 classVariableNames: '''' |
|
2387 poolDictionaries: '''' |
|
2388 category: ''PetitParser-Parsers''!! |
|
2389 !!PPActionParser commentStamp: ''<historical>'' prior: 0!! |
|
2390 A parser that performs an action block with the successful parse result of the delegate. |
|
2391 |
|
2392 Instance Variables: |
|
2393 block <BlockClosure> The action block to be executed. |
|
2394 !! |
|
2395 |
|
2396 |
|
2397 !!PPActionParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 16:58''!! |
|
2398 setBlock: aBlock |
|
2399 block := aBlock!! !! |
|
2400 |
|
2401 |
|
2402 !!PPActionParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:41''!! |
|
2403 visualizationGraphType |
|
2404 ^ ''[]''!! !! |
|
2405 |
|
2406 |
|
2407 !!PPActionParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!! |
|
2408 parseOn: aPPContext |
|
2409 | element | |
|
2410 ^ (element := parser parseOn: aPPContext) isPetitFailure |
|
2411 ifFalse: [ block value: element ] |
|
2412 ifTrue: [ element ]!! !! |
|
2413 |
|
2414 |
|
2415 !!PPActionParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:10''!! |
|
2416 block |
|
2417 "Answer the action block of the receiver." |
|
2418 |
|
2419 ^ block!! !! |
|
2420 |
|
2421 |
|
2422 !!PPActionParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 5/7/2011 15:08''!! |
|
2423 match: aParser inContext: aDictionary seen: anIdentitySet |
|
2424 ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ]!! !! |
|
2425 |
|
2426 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
2427 |
|
2428 PPActionParser class |
|
2429 instanceVariableNames: ''''!! |
|
2430 !!PPActionParser class commentStamp: ''<historical>'' prior: 0!! |
|
2431 !! |
|
2432 |
|
2433 |
|
2434 !!PPActionParser class methodsFor: ''instance creation'' stamp: ''lr 5/2/2010 16:58''!! |
|
2435 on: aParser block: aBlock |
|
2436 ^ (self on: aParser) setBlock: aBlock!! !! |
|
2437 |
|
2438 |
|
2439 PPActionParser subclass: #PPWrappingParser |
|
2440 instanceVariableNames: '''' |
|
2441 classVariableNames: '''' |
|
2442 poolDictionaries: '''' |
|
2443 category: ''PetitParser-Parsers''!! |
|
2444 !!PPWrappingParser commentStamp: ''<historical>'' prior: 0!! |
|
2445 A parser that performs an action block upon activation with the stream and a continuation block.!! |
|
2446 |
|
2447 |
|
2448 !!PPWrappingParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!! |
|
2449 parseOn: aPPContext |
|
2450 ^ block value: aPPContext value: [ parser parseOn: aPPContext ]!! !! |
|
2451 |
|
2452 |
|
2453 PPParser subclass: #PPListParser |
|
2454 instanceVariableNames: ''parsers'' |
|
2455 classVariableNames: '''' |
|
2456 poolDictionaries: '''' |
|
2457 category: ''PetitParser-Parsers''!! |
|
2458 !!PPListParser commentStamp: ''<historical>'' prior: 0!! |
|
2459 Abstract parser that parses a list of things in some way (to be specified by the subclasses). |
|
2460 |
|
2461 Instance Variables: |
|
2462 parsers <SequenceableCollection of: PPParser> A sequence of other parsers to delegate to.!! |
|
2463 |
|
2464 |
|
2465 !!PPListParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/30/2010 08:15''!! |
|
2466 copyInContext: aDictionary seen: aSeenDictionary |
|
2467 | copy copies | |
|
2468 aSeenDictionary at: self ifPresent: [ :value | ^ value ]. |
|
2469 copy := aSeenDictionary at: self put: self copy. |
|
2470 copies := OrderedCollection new. |
|
2471 parsers do: [ :each | |
|
2472 | result | |
|
2473 result := each |
|
2474 copyInContext: aDictionary |
|
2475 seen: aSeenDictionary. |
|
2476 result isCollection |
|
2477 ifTrue: [ copies addAll: result ] |
|
2478 ifFalse: [ copies add: result ] ]. |
|
2479 ^ copy |
|
2480 setParsers: copies; |
|
2481 yourself!! !! |
|
2482 |
|
2483 |
|
2484 !!PPListParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 5/22/2010 10:24''!! |
|
2485 replace: aParser with: anotherParser |
|
2486 super replace: aParser with: anotherParser. |
|
2487 parsers keysAndValuesDo: [ :index :parser | |
|
2488 parser == aParser |
|
2489 ifTrue: [ parsers at: index put: anotherParser ] ]!! !! |
|
2490 |
|
2491 |
|
2492 !!PPListParser methodsFor: ''initialization'' stamp: ''lr 4/29/2010 10:12''!! |
|
2493 setParsers: aCollection |
|
2494 parsers := aCollection asArray!! !! |
|
2495 |
|
2496 !!PPListParser methodsFor: ''initialization'' stamp: ''lr 4/29/2010 10:12''!! |
|
2497 initialize |
|
2498 super initialize. |
|
2499 self setParsers: #()!! !! |
|
2500 |
|
2501 |
|
2502 !!PPListParser methodsFor: ''accessing'' stamp: ''lr 10/21/2009 16:37''!! |
|
2503 children |
|
2504 ^ parsers!! !! |
|
2505 |
|
2506 |
|
2507 !!PPListParser methodsFor: ''copying'' stamp: ''lr 9/17/2008 22:36''!! |
|
2508 copyWith: aParser |
|
2509 ^ self species withAll: (parsers copyWith: aParser)!! !! |
|
2510 |
|
2511 !!PPListParser methodsFor: ''copying'' stamp: ''lr 5/22/2010 10:26''!! |
|
2512 postCopy |
|
2513 super postCopy. |
|
2514 parsers := parsers copy!! !! |
|
2515 |
|
2516 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
2517 |
|
2518 PPListParser class |
|
2519 instanceVariableNames: ''''!! |
|
2520 !!PPListParser class commentStamp: ''<historical>'' prior: 0!! |
|
2521 !! |
|
2522 |
|
2523 |
|
2524 !!PPListParser class methodsFor: ''instance creation'' stamp: ''lr 9/23/2008 18:32''!! |
|
2525 with: aFirstParser with: aSecondParser |
|
2526 ^ self withAll: (Array with: aFirstParser with: aSecondParser)!! !! |
|
2527 |
|
2528 !!PPListParser class methodsFor: ''instance creation'' stamp: ''lr 5/3/2010 20:26''!! |
|
2529 with: aParser |
|
2530 ^ self withAll: (Array with: aParser)!! !! |
|
2531 |
|
2532 !!PPListParser class methodsFor: ''instance creation'' stamp: ''lr 4/29/2010 10:12''!! |
|
2533 withAll: aCollection |
|
2534 ^ self basicNew setParsers: aCollection!! !! |
|
2535 |
|
2536 |
|
2537 PPListParser subclass: #PPChoiceParser |
|
2538 instanceVariableNames: '''' |
|
2539 classVariableNames: '''' |
|
2540 poolDictionaries: '''' |
|
2541 category: ''PetitParser-Parsers''!! |
|
2542 !!PPChoiceParser commentStamp: ''lr 4/18/2008 15:35'' prior: 0!! |
|
2543 A parser that uses the first parser that succeeds.!! |
|
2544 |
|
2545 |
|
2546 !!PPChoiceParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:42''!! |
|
2547 visualizationGraphType |
|
2548 ^ ''/''!! !! |
|
2549 |
|
2550 |
|
2551 !!PPChoiceParser methodsFor: ''operators'' stamp: ''lr 9/17/2008 00:16''!! |
|
2552 / aRule |
|
2553 ^ self copyWith: aRule!! !! |
|
2554 |
|
2555 |
|
2556 !!PPChoiceParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!! |
|
2557 parseOn: aPPContext |
|
2558 "This is optimized code that avoids unnecessary block activations, do not change. When all choices fail, the last failure is answered." |
|
2559 |
|
2560 | element | |
|
2561 1 to: parsers size do: [ :index | |
|
2562 element := (parsers at: index) |
|
2563 parseOn: aPPContext. |
|
2564 element isPetitFailure |
|
2565 ifFalse: [ ^ element ] ]. |
|
2566 ^ element!! !! |
|
2567 |
|
2568 |
|
2569 !!PPChoiceParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 5/2/2010 20:15''!! |
|
2570 exampleOn: aStream |
|
2571 "If there is already a lot written, try to pick an empty possiblity." |
|
2572 |
|
2573 aStream position > 512 ifTrue: [ |
|
2574 (parsers anySatisfy: [ :each | each isNullable ]) |
|
2575 ifTrue: [ ^ self ] ]. |
|
2576 parsers atRandom exampleOn: aStream!! !! |
|
2577 |
|
2578 !!PPChoiceParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 11:14''!! |
|
2579 morphicShapeSeen: aSet depth: anInteger |
|
2580 ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc | |
|
2581 | morph | |
|
2582 morph := self newColumnMorph |
|
2583 cellInset: 5; |
|
2584 yourself. |
|
2585 self children do: [ :each | |
|
2586 morph addMorphBack: (self newRowMorph |
|
2587 hResizing: #spaceFill; |
|
2588 addMorphBack: (cc value: each); |
|
2589 addMorphBack: (self newColumnMorph |
|
2590 hResizing: #spaceFill; |
|
2591 addMorphBack: (self newSpacerMorph height: 10); |
|
2592 addMorphBack: ((LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1) |
|
2593 hResizing: #spaceFill; |
|
2594 minWidth: 20; |
|
2595 yourself); |
|
2596 yourself); |
|
2597 yourself) ]. |
|
2598 morph fullBounds. |
|
2599 self newRowMorph |
|
2600 addMorphBack: (self newColumnMorph |
|
2601 addMorphBack: (self newSpacerMorph height: 10); |
|
2602 addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1); |
|
2603 yourself); |
|
2604 addMorphBack: (self newColumnMorph |
|
2605 addMorphBack: (self newSpacerMorph width: 1; height: 10); |
|
2606 addMorphBack: (LineMorph from: 0 @ 0 to: 0 @ (morph height - 23) color: Color black width: 1); |
|
2607 yourself); |
|
2608 addMorphBack: morph; |
|
2609 addMorphBack: (self newColumnMorph |
|
2610 addMorphBack: (self newSpacerMorph width: 1; height: 10); |
|
2611 addMorphBack: (LineMorph from: 0 @ (morph height - 23) to: 0 @ 0 color: Color black width: 1) |
|
2612 makeForwardArrow; |
|
2613 width: 1; |
|
2614 yourself); |
|
2615 yourself ]!! !! |
|
2616 |
|
2617 |
|
2618 PPDelegateParser subclass: #PPNotParser |
|
2619 instanceVariableNames: '''' |
|
2620 classVariableNames: '''' |
|
2621 poolDictionaries: '''' |
|
2622 category: ''PetitParser-Parsers''!! |
|
2623 !!PPNotParser commentStamp: ''<historical>'' prior: 0!! |
|
2624 The not-predicate, a parser that succeeds whenever its delegate does not, but consumes no input [Parr 1994, 1995].!! |
|
2625 |
|
2626 |
|
2627 !!PPNotParser methodsFor: ''*petitanalyzer-testing'' stamp: ''JanKurs 5/31/2013 11:50''!! |
|
2628 isFirstSetTerminal |
|
2629 ^ true!! !! |
|
2630 |
|
2631 |
|
2632 !!PPNotParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:01''!! |
|
2633 parseOn: aPPContext |
|
2634 | element position | |
|
2635 position := aPPContext remember. |
|
2636 element := parser parseOn: aPPContext. |
|
2637 aPPContext restore: position. |
|
2638 ^ element isPetitFailure |
|
2639 ifFalse: [ PPFailure message: '''' context: aPPContext ]!! !! |
|
2640 |
|
2641 |
|
2642 !!PPNotParser methodsFor: ''*petitanalyzer-private'' stamp: ''JanKurs 5/31/2013 11:50''!! |
|
2643 firstSets: aFirstDictionary into: aSet |
|
2644 !! !! |
|
2645 |
|
2646 |
|
2647 !!PPNotParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/11/2009 21:09''!! |
|
2648 exampleOn: aStream!! !! |
|
2649 |
|
2650 !!PPNotParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:17''!! |
|
2651 displayDescription |
|
2652 ^ ''not''!! !! |
|
2653 |
|
2654 |
|
2655 PPLiteralParser subclass: #PPLiteralSequenceParser |
|
2656 instanceVariableNames: ''size'' |
|
2657 classVariableNames: '''' |
|
2658 poolDictionaries: '''' |
|
2659 category: ''PetitParser-Parsers''!! |
|
2660 !!PPLiteralSequenceParser commentStamp: ''lr 12/4/2009 18:39'' prior: 0!! |
|
2661 A parser accepts a sequence of literal objects, such as a String. This is an optimization to avoid having to compose longer sequences from PPSequenceParser.!! |
|
2662 |
|
2663 |
|
2664 !!PPLiteralSequenceParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:38''!! |
|
2665 parseOn: aPPContext |
|
2666 | memento result | |
|
2667 memento := aPPContext remember. |
|
2668 result := aPPContext stream next: size. |
|
2669 literal = result ifTrue: [ ^ result ]. |
|
2670 aPPContext restore: memento. |
|
2671 ^ PPFailure message: message context: aPPContext!! !! |
|
2672 |
|
2673 |
|
2674 !!PPLiteralSequenceParser methodsFor: ''initialization'' stamp: ''lr 6/1/2010 22:21''!! |
|
2675 initializeOn: anObject message: aString |
|
2676 super initializeOn: anObject message: aString. |
|
2677 size := literal size!! !! |
|
2678 |
|
2679 |
|
2680 !!PPLiteralSequenceParser methodsFor: ''accessing'' stamp: ''lr 9/15/2010 11:16''!! |
|
2681 size |
|
2682 "Answer the sequence size of the receiver." |
|
2683 |
|
2684 ^ size!! !! |
|
2685 |
|
2686 |
|
2687 !!PPLiteralSequenceParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:25''!! |
|
2688 exampleOn: aStream |
|
2689 aStream nextPutAll: literal!! !! |
|
2690 |
|
2691 |
|
2692 !!PPLiteralSequenceParser methodsFor: ''operators'' stamp: ''lr 8/18/2010 20:16''!! |
|
2693 caseInsensitive |
|
2694 "Answer a parser that can parse the receiver case-insensitive." |
|
2695 |
|
2696 literal asUppercase = literal asLowercase ifTrue: [ ^ self ]. |
|
2697 ^ PPPredicateSequenceParser on: [ :value | literal sameAs: value ] message: message size: size!! !! |
|
2698 |
|
2699 |
|
2700 PPDelegateParser subclass: #PPOptionalParser |
|
2701 instanceVariableNames: '''' |
|
2702 classVariableNames: '''' |
|
2703 poolDictionaries: '''' |
|
2704 category: ''PetitParser-Parsers''!! |
|
2705 !!PPOptionalParser commentStamp: ''lr 4/3/2011 14:46'' prior: 0!! |
|
2706 A parser that optionally parsers its delegate, or answers nil.!! |
|
2707 |
|
2708 |
|
2709 !!PPOptionalParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 9/1/2010 22:10''!! |
|
2710 isNullable |
|
2711 ^ true!! !! |
|
2712 |
|
2713 |
|
2714 !!PPOptionalParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:44''!! |
|
2715 visualizationGraphType |
|
2716 ^ ''?''!! !! |
|
2717 |
|
2718 |
|
2719 !!PPOptionalParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/19/2014 15:12''!! |
|
2720 parseOn: aPPContext |
|
2721 | element | |
|
2722 element := parser parseOn: aPPContext. |
|
2723 ^ element isPetitFailure ifFalse: [ element ]!! !! |
|
2724 |
|
2725 |
|
2726 PPDelegateParser subclass: #PPFlattenParser |
|
2727 instanceVariableNames: '''' |
|
2728 classVariableNames: '''' |
|
2729 poolDictionaries: '''' |
|
2730 category: ''PetitParser-Parsers''!! |
|
2731 !!PPFlattenParser commentStamp: ''lr 11/22/2009 13:09'' prior: 0!! |
|
2732 A parser that answers a flat copy of the range my delegate parses.!! |
|
2733 |
|
2734 |
|
2735 !!PPFlattenParser methodsFor: ''private'' stamp: ''lr 2/25/2013 23:31''!! |
|
2736 on: aCollection start: aStartInteger stop: aStopInteger value: anObject |
|
2737 ^ aCollection copyFrom: aStartInteger to: aStopInteger!! !! |
|
2738 |
|
2739 |
|
2740 !!PPFlattenParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:42''!! |
|
2741 parseOn: aPPContext |
|
2742 | start element | |
|
2743 start := aPPContext stream position. |
|
2744 element := parser parseOn: aPPContext. |
|
2745 element isPetitFailure ifTrue: [ ^ element ]. |
|
2746 ^ self on: aPPContext stream collection start: start + 1 stop: aPPContext stream position value: element!! !! |
|
2747 |
|
2748 |
|
2749 PPFlattenParser subclass: #PPTokenParser |
|
2750 instanceVariableNames: ''tokenClass'' |
|
2751 classVariableNames: '''' |
|
2752 poolDictionaries: '''' |
|
2753 category: ''PetitParser-Parsers''!! |
|
2754 !!PPTokenParser commentStamp: ''lr 2/25/2013 23:31'' prior: 0!! |
|
2755 A parser that answers a token with the value of my delegate parses. |
|
2756 |
|
2757 Instance Variables: |
|
2758 tokenClass <PPToken class> The token sub-class to be used.!! |
|
2759 |
|
2760 |
|
2761 !!PPTokenParser methodsFor: ''private'' stamp: ''lr 4/6/2010 19:18''!! |
|
2762 defaultTokenClass |
|
2763 ^ PPToken!! !! |
|
2764 |
|
2765 !!PPTokenParser methodsFor: ''private'' stamp: ''lr 2/25/2013 23:32''!! |
|
2766 on: aCollection start: aStartInteger stop: aStopInteger value: anObject |
|
2767 ^ self tokenClass on: aCollection start: aStartInteger stop: aStopInteger value: anObject!! !! |
|
2768 |
|
2769 |
|
2770 !!PPTokenParser methodsFor: ''initialization'' stamp: ''lr 4/6/2010 19:19''!! |
|
2771 initialize |
|
2772 tokenClass := self defaultTokenClass |
|
2773 !! !! |
|
2774 |
|
2775 |
|
2776 !!PPTokenParser methodsFor: ''accessing'' stamp: ''lr 4/6/2010 19:23''!! |
|
2777 tokenClass |
|
2778 ^ tokenClass!! !! |
|
2779 |
|
2780 !!PPTokenParser methodsFor: ''accessing'' stamp: ''lr 4/6/2010 19:24''!! |
|
2781 tokenClass: aTokenClass |
|
2782 tokenClass := aTokenClass!! !! |
|
2783 |
|
2784 |
|
2785 !!PPTokenParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!! |
|
2786 match: aParser inContext: aDictionary seen: anIdentitySet |
|
2787 ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self tokenClass = aParser tokenClass ]!! !! |
|
2788 |
|
2789 |
|
2790 PPDelegateParser subclass: #PPRepeatingParser |
|
2791 instanceVariableNames: ''min max'' |
|
2792 classVariableNames: '''' |
|
2793 poolDictionaries: '''' |
|
2794 category: ''PetitParser-Parsers''!! |
|
2795 !!PPRepeatingParser commentStamp: ''lr 4/3/2011 14:45'' prior: 0!! |
|
2796 An abstract parser that repeatedly parses between ''min'' and ''max'' instances of its delegate. The default configuration parses an infinite number of elements, as ''min'' is set to 0 and ''max'' to infinity (SmallInteger maxVal). |
|
2797 |
|
2798 Instance Variables: |
|
2799 min <Integer> The minimum number of repetitions. |
|
2800 max <Integer> The maximum number of repetitions.!! |
|
2801 |
|
2802 |
|
2803 !!PPRepeatingParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!! |
|
2804 match: aParser inContext: aDictionary seen: anIdentitySet |
|
2805 ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self min = aParser min and: [ self max = aParser max ] ]!! !! |
|
2806 |
|
2807 |
|
2808 !!PPRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/1/2011 21:00''!! |
|
2809 setMax: anInteger |
|
2810 max := anInteger!! !! |
|
2811 |
|
2812 !!PPRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/1/2011 21:01''!! |
|
2813 setMin: anInteger |
|
2814 min := anInteger!! !! |
|
2815 |
|
2816 !!PPRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/1/2011 21:06''!! |
|
2817 initialize |
|
2818 super initialize. |
|
2819 self setMin: 0; setMax: SmallInteger maxVal!! !! |
|
2820 |
|
2821 |
|
2822 !!PPRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:08''!! |
|
2823 max |
|
2824 "Answer the maximum number of repetitions." |
|
2825 |
|
2826 ^ max!! !! |
|
2827 |
|
2828 !!PPRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:08''!! |
|
2829 min |
|
2830 "Answer the minimum number of repetitions." |
|
2831 |
|
2832 ^ min!! !! |
|
2833 |
|
2834 |
|
2835 !!PPRepeatingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/11/2009 20:57''!! |
|
2836 exampleOn: aStream |
|
2837 "Perform the minimal repeatitions required, and a random amount of more if possible and if not that much output has been produced yet." |
|
2838 |
|
2839 min timesRepeat: [ |
|
2840 super exampleOn: aStream ]. |
|
2841 (max - min min: 5) atRandom timesRepeat: [ |
|
2842 aStream position > 512 |
|
2843 ifTrue: [ ^ self ]. |
|
2844 super exampleOn: aStream ]!! !! |
|
2845 |
|
2846 !!PPRepeatingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:18''!! |
|
2847 displayDescription |
|
2848 ^ String streamContents: [ :stream | |
|
2849 min = 0 |
|
2850 ifFalse: [ stream print: min; nextPutAll: ''..'' ]. |
|
2851 max = SmallInteger maxVal |
|
2852 ifTrue: [ stream nextPut: $* ] |
|
2853 ifFalse: [ stream print: max ] ]!! !! |
|
2854 |
|
2855 |
|
2856 !!PPRepeatingParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 10/21/2009 12:13''!! |
|
2857 isNullable |
|
2858 ^ min = 0!! !! |
|
2859 |
|
2860 |
|
2861 !!PPRepeatingParser methodsFor: ''*petitanalyzer-private'' stamp: ''JanKurs 5/31/2013 11:51''!! |
|
2862 followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet |
|
2863 | firstSet | |
|
2864 super followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet. |
|
2865 |
|
2866 firstSet := aFirstDictionary at: self. |
|
2867 self children do: [:p | (aFollowDictionary at: p) addAll: (firstSet reject: [:each | each isNullable]) ]!! !! |
|
2868 |
|
2869 |
|
2870 !!PPRepeatingParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:44''!! |
|
2871 visualizationGraphType |
|
2872 ^ ''*''!! !! |
|
2873 |
|
2874 |
|
2875 !!PPRepeatingParser methodsFor: ''printing'' stamp: ''lr 6/3/2010 14:00''!! |
|
2876 printOn: aStream |
|
2877 super printOn: aStream. |
|
2878 aStream nextPutAll: '' [''; print: min; nextPutAll: '', ''; nextPutAll: (max = SmallInteger maxVal |
|
2879 ifTrue: [ ''*'' ] ifFalse: [ max printString ]); nextPut: $]!! !! |
|
2880 |
|
2881 |
|
2882 PPRepeatingParser subclass: #PPPossessiveRepeatingParser |
|
2883 instanceVariableNames: '''' |
|
2884 classVariableNames: '''' |
|
2885 poolDictionaries: '''' |
|
2886 category: ''PetitParser-Parsers''!! |
|
2887 !!PPPossessiveRepeatingParser commentStamp: ''lr 4/3/2011 14:35'' prior: 0!! |
|
2888 The default repeating parser with standard PEG semantics (i.e. possessive, blind, eager).!! |
|
2889 |
|
2890 |
|
2891 !!PPPossessiveRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:43''!! |
|
2892 parseOn: aPPContext |
|
2893 | start element elements | |
|
2894 start := aPPContext remember. |
|
2895 elements := OrderedCollection new. |
|
2896 [ elements size < min ] whileTrue: [ |
|
2897 (element := parser parseOn: aPPContext) isPetitFailure ifTrue: [ |
|
2898 aPPContext restore: start. |
|
2899 ^ element ]. |
|
2900 elements addLast: element ]. |
|
2901 [ elements size < max ] whileTrue: [ |
|
2902 (element := parser parseOn: aPPContext) isPetitFailure |
|
2903 ifTrue: [ ^ elements asArray ]. |
|
2904 elements addLast: element ]. |
|
2905 ^ elements asArray!! !! |
|
2906 |
|
2907 |
|
2908 PPRepeatingParser subclass: #PPLimitedRepeatingParser |
|
2909 instanceVariableNames: ''limit'' |
|
2910 classVariableNames: '''' |
|
2911 poolDictionaries: '''' |
|
2912 category: ''PetitParser-Parsers''!! |
|
2913 !!PPLimitedRepeatingParser commentStamp: ''lr 4/3/2011 14:37'' prior: 0!! |
|
2914 An abstract parser that repeatedly parses between ''min'' and ''max'' instances of my delegate and that requires the input to be completed with a specified parser ''limit''. Subclasses provide repeating behavior as typically seen in regular expression implementations (non-blind). |
|
2915 |
|
2916 Instance Variables: |
|
2917 limit <PPParser> The parser to complete the input with.!! |
|
2918 |
|
2919 |
|
2920 !!PPLimitedRepeatingParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 4/4/2011 18:46''!! |
|
2921 replace: aParser with: anotherParser |
|
2922 super replace: aParser with: anotherParser. |
|
2923 limit == aParser ifTrue: [ limit := anotherParser ]!! !! |
|
2924 |
|
2925 |
|
2926 !!PPLimitedRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/2/2011 10:00''!! |
|
2927 setLimit: aParser |
|
2928 limit := aParser!! !! |
|
2929 |
|
2930 |
|
2931 !!PPLimitedRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/4/2011 18:46''!! |
|
2932 children |
|
2933 ^ Array with: parser with: limit!! !! |
|
2934 |
|
2935 !!PPLimitedRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/2/2011 10:00''!! |
|
2936 limit |
|
2937 "Answer the parser that limits (or ends) this repetition." |
|
2938 |
|
2939 ^ limit!! !! |
|
2940 |
|
2941 |
|
2942 !!PPLimitedRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 16:04''!! |
|
2943 matchesLimitOn: aPPContext |
|
2944 | element position | |
|
2945 position := aPPContext remember. |
|
2946 element := limit parseOn: aPPContext. |
|
2947 aPPContext restore: position. |
|
2948 ^ element isPetitFailure not!! !! |
|
2949 |
|
2950 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
2951 |
|
2952 PPLimitedRepeatingParser class |
|
2953 instanceVariableNames: ''''!! |
|
2954 !!PPLimitedRepeatingParser class commentStamp: ''<historical>'' prior: 0!! |
|
2955 !! |
|
2956 |
|
2957 |
|
2958 !!PPLimitedRepeatingParser class methodsFor: ''instance creation'' stamp: ''lr 4/3/2011 14:58''!! |
|
2959 on: aParser limit: aLimitParser |
|
2960 ^ (self on: aParser) setLimit: aLimitParser!! !! |
|
2961 |
|
2962 |
|
2963 PPLimitedRepeatingParser subclass: #PPGreedyRepeatingParser |
|
2964 instanceVariableNames: '''' |
|
2965 classVariableNames: '''' |
|
2966 poolDictionaries: '''' |
|
2967 category: ''PetitParser-Parsers''!! |
|
2968 !!PPGreedyRepeatingParser commentStamp: ''lr 4/3/2011 15:08'' prior: 0!! |
|
2969 A greedy repeating parser, commonly seen in regular expression implementations. It aggressively consumes as much input as possible and then backtracks to meet the ''limit'' condition. |
|
2970 |
|
2971 This class essentially implements the iterative version of the following recursive parser composition: |
|
2972 |
|
2973 | parser | |
|
2974 parser := PPChoiceParser new. |
|
2975 parser setParsers: (Array |
|
2976 with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ]) |
|
2977 with: (limit and ==> [ :each | OrderedCollection new ])). |
|
2978 ^ parser ==> [ :rest | rest asArray ]!! |
|
2979 |
|
2980 |
|
2981 !!PPGreedyRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:59''!! |
|
2982 parseOn: aPPContext |
|
2983 | start element elements positions | |
|
2984 start := aPPContext remember. |
|
2985 elements := OrderedCollection new. |
|
2986 [ elements size < min ] whileTrue: [ |
|
2987 (element := parser parseOn: aPPContext) isPetitFailure ifTrue: [ |
|
2988 aPPContext restore: start. |
|
2989 ^ element ]. |
|
2990 elements addLast: element ]. |
|
2991 positions := OrderedCollection with: aPPContext remember. |
|
2992 [ elements size < max and: [ (element := parser parseOn: aPPContext) isPetitFailure not ] ] whileTrue: [ |
|
2993 elements addLast: element. |
|
2994 positions addLast: aPPContext remember ]. |
|
2995 [ positions isEmpty ] whileFalse: [ |
|
2996 aPPContext restore: positions last. |
|
2997 element := limit parseOn: aPPContext. |
|
2998 element isPetitFailure ifFalse: [ |
|
2999 aPPContext restore: positions last. |
|
3000 ^ elements asArray ]. |
|
3001 elements isEmpty ifTrue: [ |
|
3002 aPPContext restore: start. |
|
3003 ^ element ]. |
|
3004 elements removeLast. |
|
3005 positions removeLast ]. |
|
3006 aPPContext restore: start. |
|
3007 ^ PPFailure message: ''overflow'' context: aPPContext at: start!! !! |
|
3008 |
|
3009 |
|
3010 PPParser subclass: #PPEpsilonParser |
|
3011 instanceVariableNames: '''' |
|
3012 classVariableNames: '''' |
|
3013 poolDictionaries: '''' |
|
3014 category: ''PetitParser-Parsers''!! |
|
3015 !!PPEpsilonParser commentStamp: ''lr 5/15/2008 15:09'' prior: 0!! |
|
3016 A parser that consumes nothing and always succeeds.!! |
|
3017 |
|
3018 |
|
3019 !!PPEpsilonParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 10/21/2009 12:11''!! |
|
3020 isNullable |
|
3021 ^ true!! !! |
|
3022 |
|
3023 |
|
3024 !!PPEpsilonParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 11:15''!! |
|
3025 morphicShapeSeen: aSet depth: anInteger |
|
3026 ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc | |
|
3027 self newRowMorph |
|
3028 addMorphBack: (self newColumnMorph |
|
3029 addMorphBack: (self newSpacerMorph height: 10); |
|
3030 addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1); |
|
3031 yourself); |
|
3032 yourself ]!! !! |
|
3033 |
|
3034 |
|
3035 !!PPEpsilonParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/6/2009 18:42''!! |
|
3036 displayName |
|
3037 ^ ''epsilon''!! !! |
|
3038 |
|
3039 |
|
3040 !!PPEpsilonParser methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:49''!! |
|
3041 parseOn: aStream |
|
3042 ^ nil!! !! |
|
3043 |
|
3044 |
|
3045 PPLimitedRepeatingParser subclass: #PPLazyRepeatingParser |
|
3046 instanceVariableNames: '''' |
|
3047 classVariableNames: '''' |
|
3048 poolDictionaries: '''' |
|
3049 category: ''PetitParser-Parsers''!! |
|
3050 !!PPLazyRepeatingParser commentStamp: ''lr 4/3/2011 15:08'' prior: 0!! |
|
3051 A lazy repeating parser, commonly seen in regular expression implementations. It limits its consumption to meet the ''limit'' condition as early as possible. |
|
3052 |
|
3053 This class essentially implements the iterative version of the following recursive parser composition: |
|
3054 |
|
3055 | parser | |
|
3056 parser := PPChoiceParser new. |
|
3057 parser setParsers: (Array |
|
3058 with: (limit and ==> [ :each | OrderedCollection new ]) |
|
3059 with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ])). |
|
3060 ^ parser ==> [ :rest | rest asArray ]!! |
|
3061 |
|
3062 |
|
3063 !!PPLazyRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:00''!! |
|
3064 parseOn: aPPContext |
|
3065 | start element elements | |
|
3066 start := aPPContext remember. |
|
3067 elements := OrderedCollection new. |
|
3068 [ elements size < min ] whileTrue: [ |
|
3069 (element := parser parseOn: aPPContext) isPetitFailure ifTrue: [ |
|
3070 aPPContext restore: start. |
|
3071 ^ element ]. |
|
3072 elements addLast: element ]. |
|
3073 [ self matchesLimitOn: aPPContext ] whileFalse: [ |
|
3074 elements size < max ifFalse: [ |
|
3075 aPPContext restore: start. |
|
3076 ^ PPFailure message: ''overflow'' context: aPPContext at: start ]. |
|
3077 element := parser parseOn: aPPContext. |
|
3078 element isPetitFailure ifTrue: [ |
|
3079 aPPContext restore: start. |
|
3080 ^ element ]. |
|
3081 elements addLast: element ]. |
|
3082 ^ elements asArray!! !! |
|
3083 |
|
3084 |
|
3085 PPListParser subclass: #PPSequenceParser |
|
3086 instanceVariableNames: '''' |
|
3087 classVariableNames: '''' |
|
3088 poolDictionaries: '''' |
|
3089 category: ''PetitParser-Parsers''!! |
|
3090 !!PPSequenceParser commentStamp: ''lr 4/18/2008 15:34'' prior: 0!! |
|
3091 A parser that parses a sequence of parsers.!! |
|
3092 |
|
3093 |
|
3094 !!PPSequenceParser methodsFor: ''operators-mapping'' stamp: ''lr 5/6/2011 20:27''!! |
|
3095 map: aBlock |
|
3096 ^ aBlock numArgs = self children size |
|
3097 ifTrue: [ self ==> [ :nodes | aBlock valueWithArguments: nodes ] ] |
|
3098 ifFalse: [ self error: aBlock numArgs asString , '' arguments expected.'' ]!! !! |
|
3099 |
|
3100 !!PPSequenceParser methodsFor: ''operators-mapping'' stamp: ''lr 1/8/2010 12:01''!! |
|
3101 permutation: anArrayOfIntegers |
|
3102 "Answer a permutation of the receivers sequence." |
|
3103 |
|
3104 anArrayOfIntegers do: [ :index | |
|
3105 (index isInteger and: [ index between: 1 and: parsers size ]) |
|
3106 ifFalse: [ self error: ''Invalid permutation index: '' , index printString ] ]. |
|
3107 ^ self ==> [ :nodes | anArrayOfIntegers collect: [ :index | nodes at: index ] ]!! !! |
|
3108 |
|
3109 |
|
3110 !!PPSequenceParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/17/2009 21:54''!! |
|
3111 morphicShapeSeen: aSet depth: anInteger |
|
3112 ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc | |
|
3113 self children |
|
3114 inject: self newRowMorph |
|
3115 into: [ :result :each | |
|
3116 result |
|
3117 addMorphBack: (cc value: each); |
|
3118 yourself ] ]!! !! |
|
3119 |
|
3120 |
|
3121 !!PPSequenceParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:24''!! |
|
3122 exampleOn: aStream |
|
3123 parsers do: [ :each | each exampleOn: aStream ]!! !! |
|
3124 |
|
3125 |
|
3126 !!PPSequenceParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:43''!! |
|
3127 parseOn: aPPContext |
|
3128 "This is optimized code that avoids unnecessary block activations, do not change." |
|
3129 |
|
3130 | start elements element | |
|
3131 start := aPPContext remember. |
|
3132 elements := Array new: parsers size. |
|
3133 1 to: parsers size do: [ :index | |
|
3134 element := (parsers at: index) |
|
3135 parseOn: aPPContext. |
|
3136 element isPetitFailure ifTrue: [ |
|
3137 aPPContext restore: start. |
|
3138 ^ element ]. |
|
3139 elements at: index put: element ]. |
|
3140 ^ elements!! !! |
|
3141 |
|
3142 |
|
3143 !!PPSequenceParser methodsFor: ''operators'' stamp: ''lr 9/17/2008 00:17''!! |
|
3144 , aRule |
|
3145 ^ self copyWith: aRule!! !! |
|
3146 |
|
3147 |
|
3148 !!PPSequenceParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 12/9/2010 10:37''!! |
|
3149 cycleSet: aDictionary |
|
3150 | firstSet | |
|
3151 1 to: parsers size do: [ :index | |
|
3152 firstSet := aDictionary at: (parsers at: index). |
|
3153 (firstSet anySatisfy: [ :each | each isNullable ]) |
|
3154 ifFalse: [ ^ parsers copyFrom: 1 to: index ] ]. |
|
3155 ^ parsers!! !! |
|
3156 |
|
3157 !!PPSequenceParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 9/16/2010 17:56''!! |
|
3158 firstSets: aFirstDictionary into: aSet |
|
3159 | nullable | |
|
3160 parsers do: [ :parser | |
|
3161 nullable := false. |
|
3162 (aFirstDictionary at: parser) do: [ :each | |
|
3163 each isNullable |
|
3164 ifTrue: [ nullable := true ] |
|
3165 ifFalse: [ aSet add: each ] ]. |
|
3166 nullable |
|
3167 ifFalse: [ ^ self ] ]. |
|
3168 aSet add: PPSentinel instance!! !! |
|
3169 |
|
3170 !!PPSequenceParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 8/14/2010 13:51''!! |
|
3171 followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet |
|
3172 parsers keysAndValuesDo: [ :index :parser | |
|
3173 | followSet firstSet | |
|
3174 followSet := aFollowDictionary at: parser. |
|
3175 index = parsers size |
|
3176 ifTrue: [ followSet addAll: aSet ] |
|
3177 ifFalse: [ |
|
3178 (self class withAll: (parsers |
|
3179 copyFrom: index + 1 to: parsers size)) |
|
3180 firstSets: aFirstDictionary |
|
3181 into: (firstSet := IdentitySet new). |
|
3182 (firstSet anySatisfy: [ :each | each isNullable ]) |
|
3183 ifTrue: [ followSet addAll: aSet ]. |
|
3184 followSet addAll: (firstSet |
|
3185 reject: [ :each | each isNullable ]) ] ]!! !! |
|
3186 |
|
3187 |
|
3188 !!PPSequenceParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:44''!! |
|
3189 visualizationGraphType |
|
3190 ^ '',''!! !! |
|
3191 Object subclass: #PPFailure |
|
3192 instanceVariableNames: ''message context position'' |
|
3193 classVariableNames: '''' |
|
3194 poolDictionaries: '''' |
|
3195 category: ''PetitParser-Core''!! |
|
3196 !!PPFailure commentStamp: ''<historical>'' prior: 0!! |
|
3197 The failure object in PetitParser. It is the only class that responds to #isPetitFailure with true. It contains an error message and a position of the occurrence of the failure. |
|
3198 |
|
3199 Instance Variables: |
|
3200 message <String> The error message of this failure. |
|
3201 position <Integer> The position of this failure in the input stream. |
|
3202 !! |
|
3203 |
|
3204 |
|
3205 !!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:39''!! |
|
3206 sampleIn: composite |
|
3207 |
|
3208 (composite text) |
|
3209 title: ''Sample''; |
|
3210 display: [:res | res findStream contents ifNil: [''''] ]; |
|
3211 allowNil.!! !! |
|
3212 |
|
3213 !!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:40''!! |
|
3214 treeViewIn: composite |
|
3215 composite tree |
|
3216 title: ''Execution Traces''; |
|
3217 format: [:resultNode | resultNode formattedText ]; |
|
3218 children: [:resultNode | resultNode showChildren |
|
3219 ifTrue: [ resultNode children ] |
|
3220 ifFalse: [ #() ] ]. !! !! |
|
3221 |
|
3222 !!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:53''!! |
|
3223 gtDebugView: composite |
|
3224 <gtInspectorPresentationOrder: 40> |
|
3225 |
|
3226 | browser | |
|
3227 browser := |
|
3228 composite tabulator. |
|
3229 |
|
3230 browser title: ''Debug View''. |
|
3231 browser row: #tree; |
|
3232 row: #source. |
|
3233 browser transmit |
|
3234 fromOutsideEntityPort; |
|
3235 toOutsidePort: #debugResult; |
|
3236 transformed: [ :failure | failure debugResult ]. |
|
3237 |
|
3238 browser transmit |
|
3239 from: #tree; |
|
3240 to: #source port: #selectionInterval; |
|
3241 transformed: [:debuggingResult | |
|
3242 debuggingResult ifNotNil: [ |
|
3243 debuggingResult start to: debuggingResult end] |
|
3244 ]. |
|
3245 |
|
3246 browser transmit |
|
3247 fromOutsidePort: #debugResult; |
|
3248 to: #source; |
|
3249 andShow: [ :a | self sampleIn: a ]. |
|
3250 |
|
3251 browser transmit |
|
3252 fromOutsidePort: #debugResult; |
|
3253 to: #tree; |
|
3254 andShow: [ :a | self treeViewIn: a ]. |
|
3255 |
|
3256 browser startOn: self!! !! |
|
3257 |
|
3258 !!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:54''!! |
|
3259 debugResult |
|
3260 ^ context root enableDebug parse: context stream reset!! !! |
|
3261 |
|
3262 |
|
3263 !!PPFailure methodsFor: ''testing'' stamp: ''lr 2/7/2010 20:54''!! |
|
3264 isPetitFailure |
|
3265 "I am the only class that should implement this method to return true." |
|
3266 |
|
3267 ^ true!! !! |
|
3268 |
|
3269 |
|
3270 !!PPFailure methodsFor: ''printing'' stamp: ''JanKurs 8/19/2014 16:30''!! |
|
3271 printOn: aStream |
|
3272 aStream nextPutAll: self message; nextPutAll: '' at ''; print: self position!! !! |
|
3273 |
|
3274 |
|
3275 !!PPFailure methodsFor: ''initialization'' stamp: ''JanKurs 8/19/2014 16:57''!! |
|
3276 initializeMessage: aString context: aPPContext |
|
3277 self initializeMessage: aString context: aPPContext position: aPPContext position!! !! |
|
3278 |
|
3279 !!PPFailure methodsFor: ''initialization'' stamp: ''JanKurs 8/19/2014 16:33''!! |
|
3280 initializeMessage: aString at: anInteger |
|
3281 self halt: ''deprecated''.!! !! |
|
3282 |
|
3283 !!PPFailure methodsFor: ''initialization'' stamp: ''JanKurs 8/19/2014 16:57''!! |
|
3284 initializeMessage: aString context: aPPContext position: position |
|
3285 message := aString. |
|
3286 context := aPPContext. |
|
3287 position := position.!! !! |
|
3288 |
|
3289 |
|
3290 !!PPFailure methodsFor: ''accessing'' stamp: ''lr 5/5/2010 13:56''!! |
|
3291 message |
|
3292 "Answer a human readable error message of this parse failure." |
|
3293 |
|
3294 ^ message!! !! |
|
3295 |
|
3296 !!PPFailure methodsFor: ''accessing'' stamp: ''lr 5/5/2010 13:55''!! |
|
3297 position |
|
3298 "Answer the position in the source string that caused this parse failure." |
|
3299 |
|
3300 ^ position!! !! |
|
3301 |
|
3302 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
3303 |
|
3304 PPFailure class |
|
3305 instanceVariableNames: ''''!! |
|
3306 !!PPFailure class commentStamp: ''<historical>'' prior: 0!! |
|
3307 !! |
|
3308 |
|
3309 |
|
3310 !!PPFailure class methodsFor: ''instance creation'' stamp: ''JanKurs 8/19/2014 16:33''!! |
|
3311 message: aString at: anInteger |
|
3312 self halt: ''deprecated, use message:context:''. |
|
3313 ^ self basicNew initializeMessage: aString at: anInteger!! !! |
|
3314 |
|
3315 !!PPFailure class methodsFor: ''instance creation'' stamp: ''JanKurs 8/19/2014 16:32''!! |
|
3316 message: aString context: aPPContext |
|
3317 ^ self basicNew initializeMessage: aString context: aPPContext!! !! |
|
3318 |
|
3319 !!PPFailure class methodsFor: ''instance creation'' stamp: ''JanKurs 8/19/2014 16:57''!! |
|
3320 message: aString context: aPPContext at: position |
|
3321 ^ self basicNew initializeMessage: aString context: aPPContext position: position!! !! |
|
3322 |
|
3323 |
|
3324 ReadStream subclass: #PPStream |
|
3325 instanceVariableNames: '''' |
|
3326 classVariableNames: '''' |
|
3327 poolDictionaries: '''' |
|
3328 category: ''PetitParser-Core''!! |
|
3329 !!PPStream commentStamp: ''<historical>'' prior: 0!! |
|
3330 A positional stream implementation used for parsing. It overrides some methods for optimization reasons.!! |
|
3331 |
|
3332 |
|
3333 !!PPStream methodsFor: ''accessing'' stamp: ''lr 4/29/2008 21:48''!! |
|
3334 peek |
|
3335 "An improved version of peek, that is slightly faster than the built in version." |
|
3336 |
|
3337 ^ self atEnd ifFalse: [ collection at: position + 1 ]!! !! |
|
3338 |
|
3339 !!PPStream methodsFor: ''accessing'' stamp: ''lr 10/5/2010 16:29''!! |
|
3340 uncheckedPeek |
|
3341 "An unchecked version of peek that throws an error if we try to peek over the end of the stream, even faster than #peek." |
|
3342 |
|
3343 ^ collection at: position + 1!! !! |
|
3344 |
|
3345 !!PPStream methodsFor: ''accessing'' stamp: ''lr 2/13/2012 20:25''!! |
|
3346 collection |
|
3347 "Answer the underlying collection." |
|
3348 |
|
3349 ^ collection!! !! |
|
3350 |
|
3351 !!PPStream methodsFor: ''accessing'' stamp: ''lr 8/25/2010 11:36''!! |
|
3352 position: anInteger |
|
3353 "The receiver does not check for invalid arguments passed to this method, as it is solely used with valid indexes for backtracking." |
|
3354 |
|
3355 position := anInteger!! !! |
|
3356 |
|
3357 |
|
3358 !!PPStream methodsFor: ''printing'' stamp: ''lr 11/4/2010 19:23''!! |
|
3359 printOn: aStream |
|
3360 collection isString |
|
3361 ifFalse: [ ^ super printOn: aStream ]. |
|
3362 aStream |
|
3363 nextPutAll: (collection copyFrom: 1 to: position); |
|
3364 nextPutAll: ''·''; |
|
3365 nextPutAll: (collection copyFrom: position + 1 to: readLimit)!! !! |
|
3366 |
|
3367 |
|
3368 !!PPStream methodsFor: ''converting'' stamp: ''lr 2/7/2010 20:53''!! |
|
3369 asPetitStream |
|
3370 ^ self!! !! |
|
3371 |
|
3372 |
|
3373 Object subclass: #PPToken |
|
3374 instanceVariableNames: ''collection start stop value'' |
|
3375 classVariableNames: ''NewLineParser'' |
|
3376 poolDictionaries: '''' |
|
3377 category: ''PetitParser-Core''!! |
|
3378 !!PPToken commentStamp: ''lr 2/25/2013 23:34'' prior: 0!! |
|
3379 PPToken represents a parsed part of the input stream. Contrary to a simple String it remembers where it came from, the original collection, its start and stop position and its parse value. |
|
3380 |
|
3381 Instance Variables: |
|
3382 collection <SequenceableCollection> The collection this token comes from. |
|
3383 start <Integer> The start position in the collection. |
|
3384 stop <Integer> The stop position in the collection. |
|
3385 value <Object> The parse result.!! |
|
3386 |
|
3387 |
|
3388 !!PPToken methodsFor: ''querying'' stamp: ''lr 9/7/2011 20:41''!! |
|
3389 line |
|
3390 "Answer the line number of this token in the underlying collection." |
|
3391 |
|
3392 | line | |
|
3393 line := 1. |
|
3394 (NewLineParser , [ :stream | |
|
3395 start <= stream position |
|
3396 ifTrue: [ ^ line ]. |
|
3397 line := line + 1 ] asParser |
|
3398 / #any asParser) star |
|
3399 parse: collection. |
|
3400 ^ line!! !! |
|
3401 |
|
3402 !!PPToken methodsFor: ''querying'' stamp: ''lr 9/7/2011 20:40''!! |
|
3403 column |
|
3404 "Answer the column number of this token in the underlying collection." |
|
3405 |
|
3406 | position | |
|
3407 position := 0. |
|
3408 (NewLineParser , [ :stream | |
|
3409 start <= stream position |
|
3410 ifTrue: [ ^ start - position ]. |
|
3411 position := stream position ] asParser |
|
3412 / #any asParser) star |
|
3413 parse: collection. |
|
3414 ^ start - position!! !! |
|
3415 |
|
3416 |
|
3417 !!PPToken methodsFor: ''initialization'' stamp: ''lr 2/25/2013 23:36''!! |
|
3418 initializeOn: aSequenceableCollection start: aStartInteger stop: aStopInteger value: anObject |
|
3419 collection := aSequenceableCollection. |
|
3420 start := aStartInteger. |
|
3421 stop := aStopInteger. |
|
3422 value := anObject!! !! |
|
3423 |
|
3424 |
|
3425 !!PPToken methodsFor: ''accessing'' stamp: ''lr 6/15/2010 23:33''!! |
|
3426 stop |
|
3427 "Answer the stop position of this token in the underlying collection." |
|
3428 |
|
3429 ^ stop!! !! |
|
3430 |
|
3431 !!PPToken methodsFor: ''accessing'' stamp: ''lr 2/25/2013 23:56''!! |
|
3432 size |
|
3433 "Answer the size of this token in the underlying collection." |
|
3434 |
|
3435 ^ stop - start + 1!! !! |
|
3436 |
|
3437 !!PPToken methodsFor: ''accessing'' stamp: ''lr 6/15/2010 23:34''!! |
|
3438 collection |
|
3439 "Answer the underlying collection of this token." |
|
3440 |
|
3441 ^ collection!! !! |
|
3442 |
|
3443 !!PPToken methodsFor: ''accessing'' stamp: ''lr 6/15/2010 23:33''!! |
|
3444 start |
|
3445 "Answer the start position of this token in the underlying collection." |
|
3446 |
|
3447 ^ start!! !! |
|
3448 |
|
3449 |
|
3450 !!PPToken methodsFor: ''printing'' stamp: ''lr 2/26/2013 00:37''!! |
|
3451 printOn: aStream |
|
3452 super printOn: aStream. |
|
3453 aStream nextPut: $[; print: self start; nextPut: $,; print: self stop; nextPut: $]. |
|
3454 aStream nextPut: $(; print: self parsedValue; nextPut: $)!! !! |
|
3455 |
|
3456 |
|
3457 !!PPToken methodsFor: ''copying'' stamp: ''lr 2/26/2013 00:34''!! |
|
3458 copyFrom: aStartInteger to: aStopInteger |
|
3459 ^ self class on: collection start: start + aStartInteger - 1 stop: stop + aStopInteger - 3 value: value!! !! |
|
3460 |
|
3461 |
|
3462 !!PPToken methodsFor: ''accessing-values'' stamp: ''lr 2/26/2013 00:34''!! |
|
3463 value |
|
3464 self notify: ''Token>>#value is no longer supported. Instead use Token>>#inputValue or the more pragmatic #parsedValue.''. |
|
3465 ^ self inputValue!! !! |
|
3466 |
|
3467 !!PPToken methodsFor: ''accessing-values'' stamp: ''lr 2/26/2013 00:32''!! |
|
3468 inputValue |
|
3469 "Answer the consumed input of this token." |
|
3470 |
|
3471 ^ collection copyFrom: start to: stop!! !! |
|
3472 |
|
3473 !!PPToken methodsFor: ''accessing-values'' stamp: ''lr 2/26/2013 00:32''!! |
|
3474 parsedValue |
|
3475 "Answer the parsed value of this token." |
|
3476 |
|
3477 ^ value!! !! |
|
3478 |
|
3479 |
|
3480 !!PPToken methodsFor: ''comparing'' stamp: ''lr 2/26/2013 00:34''!! |
|
3481 = anObject |
|
3482 ^ self class = anObject class and: [ self parsedValue = anObject parsedValue ]!! !! |
|
3483 |
|
3484 !!PPToken methodsFor: ''comparing'' stamp: ''lr 2/26/2013 00:34''!! |
|
3485 hash |
|
3486 ^ self parsedValue hash!! !! |
|
3487 |
|
3488 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
3489 |
|
3490 PPToken class |
|
3491 instanceVariableNames: ''''!! |
|
3492 !!PPToken class commentStamp: ''<historical>'' prior: 0!! |
|
3493 !! |
|
3494 |
|
3495 |
|
3496 !!PPToken class methodsFor: ''initialization'' stamp: ''lr 11/29/2011 20:42''!! |
|
3497 initialize |
|
3498 "Platform independent newline sequence. LF: Unix, CR+LF: Windows, and CR: Apple." |
|
3499 |
|
3500 NewLineParser := (Character lf asParser) / (Character cr asParser , Character lf asParser optional)!! !! |
|
3501 |
|
3502 |
|
3503 !!PPToken class methodsFor: ''instance creation'' stamp: ''lr 2/25/2013 23:39''!! |
|
3504 on: aSequenceableCollection start: aStartInteger stop: aStopInteger value: anObject |
|
3505 ^ self basicNew |
|
3506 initializeOn: aSequenceableCollection |
|
3507 start: aStartInteger stop: aStopInteger |
|
3508 value: anObject!! !! |
|
3509 |
|
3510 !!PPToken class methodsFor: ''instance creation'' stamp: ''lr 2/25/2013 23:36''!! |
|
3511 on: aSequenceableCollection |
|
3512 ^ self on: aSequenceableCollection start: 1 stop: aSequenceableCollection size value: nil!! !! |
|
3513 |
|
3514 !!PPToken class methodsFor: ''instance creation'' stamp: ''lr 4/6/2010 20:58''!! |
|
3515 new |
|
3516 self error: ''Token can only be created using a dedicated constructor.''!! !! |
|
3517 |
|
3518 |
|
3519 Object subclass: #PPContextMemento |
|
3520 instanceVariableNames: ''stream position properties'' |
|
3521 classVariableNames: '''' |
|
3522 poolDictionaries: '''' |
|
3523 category: ''PetitParser-Core''!! |
|
3524 !!PPContextMemento commentStamp: ''<historical>'' prior: 0!! |
|
3525 !! |
|
3526 |
|
3527 |
|
3528 !!PPContextMemento methodsFor: ''comparing'' stamp: ''JanKurs 3/19/2014 13:03''!! |
|
3529 = anObject |
|
3530 |
|
3531 (self == anObject) ifTrue: [ ^ true ]. |
|
3532 (anObject class = PPContextMemento) ifFalse: [ ^ false ]. |
|
3533 |
|
3534 (anObject stream == stream) ifFalse: [ ^ false ]. |
|
3535 (anObject position = position) ifFalse: [ ^ false ]. |
|
3536 (anObject properties = properties) ifFalse: [ ^ false ]. |
|
3537 |
|
3538 ^ true. |
|
3539 !! !! |
|
3540 |
|
3541 !!PPContextMemento methodsFor: ''comparing'' stamp: ''JanKurs 3/19/2014 13:04''!! |
|
3542 hash |
|
3543 ^ (position hash bitXor: stream hash) bitXor: properties hash.!! !! |
|
3544 |
|
3545 |
|
3546 !!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!! |
|
3547 propertyAt: aKey ifAbsentPut: aBlock |
|
3548 "Answer the property associated with aKey or, if aKey isn''t found store the result of evaluating aBlock as new value." |
|
3549 |
|
3550 ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]!! !! |
|
3551 |
|
3552 !!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!! |
|
3553 removeProperty: aKey ifAbsent: aBlock |
|
3554 "Remove the property with aKey. Answer the value or, if aKey isn''t found, answer the result of evaluating aBlock." |
|
3555 |
|
3556 | answer | |
|
3557 properties isNil ifTrue: [ ^ aBlock value ]. |
|
3558 answer := properties removeKey: aKey ifAbsent: aBlock. |
|
3559 properties isEmpty ifTrue: [ properties := nil ]. |
|
3560 ^ answer!! !! |
|
3561 |
|
3562 !!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:14''!! |
|
3563 propertyAt: aKey |
|
3564 "Answer the property value associated with aKey." |
|
3565 |
|
3566 ^ self propertyAt: aKey ifAbsent: [ self error: ''Property not found'' ]!! !! |
|
3567 |
|
3568 !!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!! |
|
3569 propertyAt: aKey ifAbsent: aBlock |
|
3570 "Answer the property value associated with aKey or, if aKey isn''t found, answer the result of evaluating aBlock." |
|
3571 |
|
3572 ^ properties isNil |
|
3573 ifTrue: [ aBlock value ] |
|
3574 ifFalse: [ properties at: aKey ifAbsent: aBlock ]!! !! |
|
3575 |
|
3576 !!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!! |
|
3577 propertyAt: aKey put: anObject |
|
3578 "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." |
|
3579 |
|
3580 ^ (properties ifNil: [ properties := Dictionary new: 1 ]) |
|
3581 at: aKey put: anObject!! !! |
|
3582 |
|
3583 !!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:14''!! |
|
3584 hasProperty: aKey |
|
3585 "Test if the property aKey is present." |
|
3586 |
|
3587 ^ properties notNil and: [ properties includesKey: aKey ]!! !! |
|
3588 |
|
3589 !!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!! |
|
3590 removeProperty: aKey |
|
3591 "Remove the property with aKey. Answer the property or raise an error if aKey isn''t found." |
|
3592 |
|
3593 ^ self removeProperty: aKey ifAbsent: [ self error: ''Property not found'' ]!! !! |
|
3594 |
|
3595 !!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 13:04''!! |
|
3596 properties |
|
3597 ^ properties !! !! |
|
3598 |
|
3599 |
|
3600 !!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:52''!! |
|
3601 stream: aStream |
|
3602 stream := aStream!! !! |
|
3603 |
|
3604 !!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:51''!! |
|
3605 position |
|
3606 ^ position!! !! |
|
3607 |
|
3608 !!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:52''!! |
|
3609 position: anInteger |
|
3610 position := anInteger !! !! |
|
3611 |
|
3612 !!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:51''!! |
|
3613 stream |
|
3614 ^ stream!! !! |
|
3615 |
|
3616 |
|
3617 Object subclass: #PPContext |
|
3618 instanceVariableNames: ''stream root properties'' |
|
3619 classVariableNames: '''' |
|
3620 poolDictionaries: '''' |
|
3621 category: ''PetitParser-Core''!! |
|
3622 !!PPContext commentStamp: ''<historical>'' prior: 0!! |
|
3623 !! |
|
3624 |
|
3625 |
|
3626 !!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:27''!! |
|
3627 remember |
|
3628 | memento | |
|
3629 memento := PPContextMemento new |
|
3630 stream: stream; |
|
3631 position: stream position; |
|
3632 yourself. |
|
3633 |
|
3634 self rememberProperties: memento. |
|
3635 ^ memento!! !! |
|
3636 |
|
3637 !!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:26''!! |
|
3638 restore: aPPContextMemento |
|
3639 aPPContextMemento stream == stream ifFalse: [ self error: ''Oops!!!!'' ]. |
|
3640 |
|
3641 stream position: aPPContextMemento position. |
|
3642 self restoreProperties: aPPContextMemento.!! !! |
|
3643 |
|
3644 !!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:29''!! |
|
3645 restoreProperties: aPPContextMemento |
|
3646 aPPContextMemento stream == stream ifFalse: [ self error: ''Oops!!!!'' ]. |
|
3647 |
|
3648 aPPContextMemento class selectorsAndMethodsDo: [ :selector :method | |
|
3649 (selector beginsWith: ''restore'') ifTrue: [ |
|
3650 aPPContextMemento withArgs: (Array with: self) executeMethod: method. |
|
3651 ] |
|
3652 ]!! !! |
|
3653 |
|
3654 !!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:28''!! |
|
3655 rememberProperties: aPPContextMemento |
|
3656 aPPContextMemento class selectorsAndMethodsDo: [ :selector :method | |
|
3657 (selector beginsWith: ''remember'') ifTrue: [ |
|
3658 aPPContextMemento withArgs: (Array with: self) executeMethod: method. |
|
3659 ] |
|
3660 ] |
|
3661 !! !! |
|
3662 |
|
3663 |
|
3664 !!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:25''!! |
|
3665 peekTwice |
|
3666 ^ stream peekTwice!! !! |
|
3667 |
|
3668 !!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/15/2014 16:02''!! |
|
3669 position |
|
3670 ^ stream position!! !! |
|
3671 |
|
3672 !!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 8/19/2014 14:08''!! |
|
3673 uncheckedPeek |
|
3674 ^ stream uncheckedPeek!! !! |
|
3675 |
|
3676 !!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/15/2014 16:11''!! |
|
3677 upTo: anObject |
|
3678 ^ stream upTo: anObject!! !! |
|
3679 |
|
3680 !!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 8/19/2014 14:08''!! |
|
3681 collection |
|
3682 ^ stream collection !! !! |
|
3683 |
|
3684 !!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/16/2014 12:13''!! |
|
3685 atEnd |
|
3686 ^ stream atEnd!! !! |
|
3687 |
|
3688 !!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:24''!! |
|
3689 peek |
|
3690 ^ stream peek!! !! |
|
3691 |
|
3692 !!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:29''!! |
|
3693 upToAll: whatever |
|
3694 ^ stream upToAll: whatever!! !! |
|
3695 |
|
3696 !!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 8/19/2014 14:08''!! |
|
3697 skip: anInteger |
|
3698 ^ stream skip: anInteger !! !! |
|
3699 |
|
3700 !!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:31''!! |
|
3701 upToAnyOf: whatever |
|
3702 ^ stream upToAnyOf: whatever!! !! |
|
3703 |
|
3704 !!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/15/2014 16:02''!! |
|
3705 next |
|
3706 ^ stream next!! !! |
|
3707 |
|
3708 |
|
3709 !!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!! |
|
3710 propertyAt: aKey ifAbsentPut: aBlock |
|
3711 "Answer the property associated with aKey or, if aKey isn''t found store the result of evaluating aBlock as new value." |
|
3712 |
|
3713 ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]!! !! |
|
3714 |
|
3715 !!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!! |
|
3716 removeProperty: aKey ifAbsent: aBlock |
|
3717 "Remove the property with aKey. Answer the value or, if aKey isn''t found, answer the result of evaluating aBlock." |
|
3718 |
|
3719 | answer | |
|
3720 properties isNil ifTrue: [ ^ aBlock value ]. |
|
3721 answer := properties removeKey: aKey ifAbsent: aBlock. |
|
3722 properties isEmpty ifTrue: [ properties := nil ]. |
|
3723 ^ answer!! !! |
|
3724 |
|
3725 !!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!! |
|
3726 propertyAt: aKey |
|
3727 "Answer the property value associated with aKey." |
|
3728 |
|
3729 ^ self propertyAt: aKey ifAbsent: [ self error: ''Property not found'' ]!! !! |
|
3730 |
|
3731 !!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!! |
|
3732 propertyAt: aKey ifAbsent: aBlock |
|
3733 "Answer the property value associated with aKey or, if aKey isn''t found, answer the result of evaluating aBlock." |
|
3734 |
|
3735 ^ properties isNil |
|
3736 ifTrue: [ aBlock value ] |
|
3737 ifFalse: [ properties at: aKey ifAbsent: aBlock ]!! !! |
|
3738 |
|
3739 !!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!! |
|
3740 propertyAt: aKey put: anObject |
|
3741 "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." |
|
3742 |
|
3743 ^ (properties ifNil: [ properties := Dictionary new: 1 ]) |
|
3744 at: aKey put: anObject!! !! |
|
3745 |
|
3746 !!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!! |
|
3747 hasProperty: aKey |
|
3748 "Test if the property aKey is present." |
|
3749 |
|
3750 ^ properties notNil and: [ properties includesKey: aKey ]!! !! |
|
3751 |
|
3752 !!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!! |
|
3753 removeProperty: aKey |
|
3754 "Remove the property with aKey. Answer the property or raise an error if aKey isn''t found." |
|
3755 |
|
3756 ^ self removeProperty: aKey ifAbsent: [ self error: ''Property not found'' ]!! !! |
|
3757 |
|
3758 |
|
3759 !!PPContext methodsFor: ''initialization'' stamp: ''JanKurs 1/16/2014 11:24''!! |
|
3760 initialize |
|
3761 stream := nil.!! !! |
|
3762 |
|
3763 |
|
3764 !!PPContext methodsFor: ''as yet unclassified'' stamp: ''JanKurs 3/19/2014 16:26''!! |
|
3765 parsed: aPPParser at: anInteger result: anObject |
|
3766 self halt. |
|
3767 ^ anObject!! !! |
|
3768 |
|
3769 |
|
3770 !!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 10/29/2013 10:13''!! |
|
3771 root: aPPParser |
|
3772 root := aPPParser !! !! |
|
3773 |
|
3774 !!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 10/29/2013 10:13''!! |
|
3775 root |
|
3776 ^ root !! !! |
|
3777 |
|
3778 !!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 1/15/2014 15:36''!! |
|
3779 stream: aStream |
|
3780 stream := aStream.!! !! |
|
3781 |
|
3782 !!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 1/16/2014 15:12''!! |
|
3783 stream |
|
3784 ^ stream!! !! |
|
3785 |
|
3786 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
3787 |
|
3788 PPContext class |
|
3789 instanceVariableNames: ''''!! |
|
3790 !!PPContext class commentStamp: ''<historical>'' prior: 0!! |
|
3791 !! |
|
3792 |
|
3793 |
|
3794 !!PPContext class methodsFor: ''as yet unclassified'' stamp: ''JanKurs 1/16/2014 14:38''!! |
|
3795 on: aPPParser stream: aStream |
|
3796 ^ self basicNew |
|
3797 initialize; |
|
3798 root: aPPParser; |
|
3799 stream: aStream asPetitStream; |
|
3800 yourself!! !! |
|
3801 |
|
3802 |
|
3803 Object subclass: #PPMemento |
|
3804 instanceVariableNames: ''result count context'' |
|
3805 classVariableNames: '''' |
|
3806 poolDictionaries: '''' |
|
3807 category: ''PetitParser-Core''!! |
|
3808 !!PPMemento commentStamp: ''<historical>'' prior: 0!! |
|
3809 PPMemento is an internal class used by PPMemoizedParser to cache results and detect left-recursive calls. |
|
3810 |
|
3811 Instance Variables: |
|
3812 result <Object> The cached result. |
|
3813 count <Integer> The number of recursive cycles followed. |
|
3814 position <Integer> The position of the cached result in the input stream.!! |
|
3815 |
|
3816 |
|
3817 !!PPMemento methodsFor: ''accessing'' stamp: ''JanKurs 1/15/2014 16:09''!! |
|
3818 contextMemento: aPPContextMemento |
|
3819 context := aPPContextMemento |
|
3820 !! !! |
|
3821 |
|
3822 !!PPMemento methodsFor: ''accessing'' stamp: ''JanKurs 1/15/2014 16:09''!! |
|
3823 contextMemento |
|
3824 ^ context!! !! |
|
3825 |
|
3826 !!PPMemento methodsFor: ''accessing'' stamp: ''lr 4/24/2008 10:15''!! |
|
3827 result |
|
3828 ^ result!! !! |
|
3829 |
|
3830 !!PPMemento methodsFor: ''accessing'' stamp: ''lr 4/22/2008 18:23''!! |
|
3831 result: anObject |
|
3832 result := anObject!! !! |
|
3833 |
|
3834 |
|
3835 !!PPMemento methodsFor: ''accessing-readonly'' stamp: ''lr 4/22/2008 18:23''!! |
|
3836 count |
|
3837 ^ count!! !! |
|
3838 |
|
3839 |
|
3840 !!PPMemento methodsFor: ''initialization'' stamp: ''lr 4/22/2008 18:21''!! |
|
3841 initialize |
|
3842 count := 0 |
|
3843 !! !! |
|
3844 |
|
3845 |
|
3846 !!PPMemento methodsFor: ''actions'' stamp: ''lr 4/22/2008 18:20''!! |
|
3847 increment |
|
3848 count := count + 1!! !! |
|
3849 |
|
3850 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!! |
|
3851 |
|
3852 PPMemento class |
|
3853 instanceVariableNames: ''''!! |
|
3854 !!PPMemento class commentStamp: ''<historical>'' prior: 0!! |
|
3855 !! |
|
3856 |
|
3857 |
|
3858 !!PPMemento class methodsFor: ''instance creation'' stamp: ''lr 4/22/2008 18:21''!! |
|
3859 new |
|
3860 ^ self basicNew initialize!! !! |
|
3861 |
|
3862 PPToken initialize!!''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!! |
|
3863 |
|
3864 !!SequenceableCollection methodsFor: ''*petitparser-core-converting'' stamp: ''lr 2/7/2010 20:53''!! |
|
3865 asPetitStream |
|
3866 ^ PPStream on: self!! !! |
|
3867 ''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!! |
|
3868 |
|
3869 !!Character methodsFor: ''*petitparser-core-operators'' stamp: ''lr 6/12/2010 09:04''!! |
|
3870 - aCharacter |
|
3871 "Create a range of characters between the receiver and the argument." |
|
3872 |
|
3873 ^ PPPredicateObjectParser between: self and: aCharacter!! !! |
|
3874 ''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!! |
|
3875 |
|
3876 !!Character methodsFor: ''*petitparser-core-converting'' stamp: ''lr 12/18/2011 15:58''!! |
|
3877 asParser |
|
3878 "Answer a parser that accepts the receiving character." |
|
3879 |
|
3880 ^ PPLiteralObjectParser on: self!! !! |
|
3881 ''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!! |
|
3882 |
|
3883 !!PositionableStream methodsFor: ''*petitparser-core'' stamp: ''sback 9/3/2010 10:00''!! |
|
3884 peekTwice |
|
3885 "Answer what would be returned if the message next were sent to the |
|
3886 receiver. If the receiver is at the end, answer nil." |
|
3887 |
|
3888 | array | |
|
3889 self atEnd |
|
3890 ifTrue: [^Array with: nil with: nil]. |
|
3891 array := Array with: (self next) with: (self peek). |
|
3892 position := position - 1. |
|
3893 ^array!! !! |
|
3894 ''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!! |
|
3895 |
|
3896 !!Stream methodsFor: ''*petitparser-core-converting'' stamp: ''lr 4/8/2010 14:46''!! |
|
3897 asPetitStream |
|
3898 ^ self contents asPetitStream!! !! |
|
3899 ''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!! |
|
3900 |
|
3901 !!Symbol methodsFor: ''*petitparser-core-converting'' stamp: ''lr 12/18/2011 15:58''!! |
|
3902 asParser |
|
3903 "Answer a predicate parser named after the receiving symbol. Possible symbols are the method selectors on the class-side of PPPredicateObjectParser." |
|
3904 |
|
3905 ^ PPPredicateObjectParser perform: self!! !! |
|
3906 ''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!! |
|
3907 |
|
3908 !!String methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:48''!! |
|
3909 asParser |
|
3910 "Answer a parser that accepts the receiving string." |
|
3911 |
|
3912 ^ PPLiteralSequenceParser on: self!! !! |
|
3913 ''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!! |
|
3914 |
|
3915 !!BlockClosure methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:48''!! |
|
3916 asParser |
|
3917 "Answer a parser implemented in the receiving one-argument block." |
|
3918 |
|
3919 ^ PPPluggableParser on: self!! !! |
|
3920 ''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!! |
|
3921 |
|
3922 !!UndefinedObject methodsFor: ''*petitparser-converting'' stamp: ''lr 11/29/2011 20:49''!! |
|
3923 asParser |
|
3924 "Answer a parser that succeeds and does not consume anything." |
|
3925 |
|
3926 ^ PPEpsilonParser new!! !! |
|
3927 ''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!! |
|
3928 |
|
3929 !!Text methodsFor: ''*petitparser-core-converting'' stamp: ''lr 2/7/2010 20:53''!! |
|
3930 asPetitStream |
|
3931 ^ string asPetitStream!! !! |
|
3932 ''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!! |
|
3933 |
|
3934 !!Collection methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:38''!! |
|
3935 asChoiceParser |
|
3936 ^ PPChoiceParser withAll: (self collect: [ :each | each asParser ])!! !! |
|
3937 ''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!! |
|
3938 |
|
3939 !!Collection methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:38''!! |
|
3940 asSequenceParser |
|
3941 ^ PPSequenceParser withAll: (self collect: [ :each | each asParser ])!! !! |
|
3942 ''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!! |
|
3943 |
|
3944 !!Object methodsFor: ''*petitparser-core-testing'' stamp: ''lr 8/6/2010 16:44''!! |
|
3945 isPetitParser |
|
3946 ^ false!! !! |
|
3947 ''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!! |
|
3948 |
|
3949 !!Object methodsFor: ''*petitparser-core-converting'' stamp: ''lr 12/18/2011 15:58''!! |
|
3950 asParser |
|
3951 "Answer a parser accepting the receiving object." |
|
3952 |
|
3953 ^ PPPredicateObjectParser expect: self!! !! |
|
3954 ''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.314418 pm''!! |
|
3955 |
|
3956 !!Object methodsFor: ''*petitparser-core-testing'' stamp: ''lr 2/7/2010 20:54''!! |
|
3957 isPetitFailure |
|
3958 ^ false!! !! |
|
3959 ' |
|
3960 ! |
|
3961 |
|
3962 smalltalkInDirectory: directory |
40 smalltalkInDirectory: directory |
3963 | files | |
41 | files | |
3964 files := self readDirectory: directory. |
42 files := self readDirectory: directory. |
3965 files := self files: files withExtension: 'st'. |
43 files := self files: files withExtension: 'st'. |
3966 |
44 |
3967 ^ files collect: [ :f | (FileStream fileNamed: f) contents asString ] |
45 ^ files collect: [ :f | (FileStream fileNamed: f) contents ] |
3968 ! |
46 ! |
3969 |
47 |
3970 smalltalkObjectMethods |
48 smalltalkObjectMethods |
3971 ^ Object allMethods collect: [ :m | m sourceCode ]. |
49 ^ Object allMethods collect: [ :m | m sourceCode ]. |
3972 ! |
50 ! |