|
1 "{ Package: 'stx:goodies/petitparser/compiler/benchmarks' }" |
|
2 |
|
3 "{ NameSpace: Smalltalk }" |
|
4 |
|
5 PPCompositeParser subclass:#PPCLRPParser_johanfabry_39 |
|
6 instanceVariableNames:'program variable block bra ket identifier machine body event |
|
7 transition epsilon wildcard state onentry running onexit comment |
|
8 lineTerminator statebody spawn integer errorNode success failed |
|
9 lastError styler timeoutIdentifier timeoutInteger endOfComment |
|
10 error' |
|
11 classVariableNames:'' |
|
12 poolDictionaries:'' |
|
13 category:'PetitCompiler-Benchmarks-Core' |
|
14 ! |
|
15 |
|
16 !PPCLRPParser_johanfabry_39 class methodsFor:'accessing'! |
|
17 |
|
18 ignoredNames |
|
19 |
|
20 ^super ignoredNames , #(styler failed lastError) |
|
21 ! ! |
|
22 |
|
23 !PPCLRPParser_johanfabry_39 methodsFor:'accessing'! |
|
24 |
|
25 error |
|
26 ^error |
|
27 |
|
28 "Modified (format): / 18-08-2015 / 16:56:20 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
29 ! |
|
30 |
|
31 failed |
|
32 ^failed |
|
33 ! |
|
34 |
|
35 lastError |
|
36 ^lastError |
|
37 ! |
|
38 |
|
39 start |
|
40 ^program end |
|
41 ! |
|
42 |
|
43 styler |
|
44 ^styler ifNil:[styler := PPCLRPRubricStyler new] |
|
45 ! |
|
46 |
|
47 styler: aSHStyler |
|
48 |
|
49 styler := aSHStyler. |
|
50 ! |
|
51 |
|
52 success |
|
53 ^success |
|
54 ! ! |
|
55 |
|
56 !PPCLRPParser_johanfabry_39 methodsFor:'block creation'! |
|
57 |
|
58 createSTBlockFrom: aBlockNode withVariables: aDictionary |
|
59 |compiled retval keys| |
|
60 |
|
61 keys := OrderedCollection new: aDictionary size. |
|
62 aDictionary associations do: [:asoc| |
|
63 keys add: asoc key. |
|
64 ]. |
|
65 |
|
66 compiled := (self methodizeBlock: aBlockNode withArguments: keys) compiledMethod. |
|
67 retval := compiled valueWithReceiver: Object new arguments: {aDictionary}. |
|
68 |
|
69 ^retval. |
|
70 ! |
|
71 |
|
72 methodizeBlock: parsedBlock withArguments: anArray |
|
73 |
|
74 |method retval inspoint| |
|
75 |
|
76 method := 'captureV: PPCLRPScopeVariables'. |
|
77 |
|
78 retval := PPSmalltalkParser new method parse: method , '^[1]'. |
|
79 inspoint := retval body statements first. |
|
80 parsedBlock scope: inspoint value scope. |
|
81 parsedBlock parent: inspoint. |
|
82 inspoint value: parsedBlock. |
|
83 retval source: retval asString. |
|
84 |
|
85 anArray do: [:aVarName| |
|
86 retval := retval rewriteLRPVarNamedWrite: aVarName. |
|
87 retval := retval rewriteLRPVarNamedRead: aVarName. |
|
88 ]. |
|
89 ^retval |
|
90 ! ! |
|
91 |
|
92 !PPCLRPParser_johanfabry_39 methodsFor:'error handing'! |
|
93 |
|
94 failWithValue: anObject |
|
95 |
|
96 failed := true. |
|
97 lastError := anObject. |
|
98 ! ! |
|
99 |
|
100 !PPCLRPParser_johanfabry_39 methodsFor:'grammar'! |
|
101 |
|
102 body |
|
103 ^(variable / event / state / transition / timeoutIdentifier / timeoutInteger / epsilon / wildcard / comment / errorNode) star |
|
104 ! |
|
105 |
|
106 errorNode |
|
107 ^(bra, (bra/ket)negate star , ket) token |
|
108 ==> [ :token | |
|
109 PPCLRPErrorNode new start: token start stop: token stop; yourself. |
|
110 ] |
|
111 ! |
|
112 |
|
113 event |
|
114 ^ (bra, 'event' asParser trim, identifier, block, ket) token |
|
115 ==> [:token | | ident | |
|
116 ident := (token parsedValue at: 3). |
|
117 (LRPEvent named: ident parsedValue |
|
118 trigger: (token parsedValue at: 4)) |
|
119 start: token start stop: token stop; |
|
120 nameRange: (ident start to: ident stop); |
|
121 yourself. |
|
122 ] |
|
123 ! |
|
124 |
|
125 integer |
|
126 ^(#digit asParser) plus flatten trim token |
|
127 ! |
|
128 |
|
129 machine |
|
130 ^(bra , 'machine' asParser trim , identifier , body , ket) token |
|
131 ==> [:token | | ident bod stop | |
|
132 ident := (token parsedValue at: 3). |
|
133 bod := (token parsedValue at: 4). |
|
134 bod isEmpty |
|
135 ifTrue: [ stop := token stop - 1 ] |
|
136 ifFalse: [ stop := (bod at: 1) start - 1 ]. |
|
137 (LRPMachine name: ident parsedValue body: bod) |
|
138 start: token start stop: token stop; |
|
139 nameRange: (ident start to: stop); |
|
140 yourself. |
|
141 ] |
|
142 ! |
|
143 |
|
144 onentry |
|
145 ^ (bra, 'onentry' asParser trim, (block/spawn) , ket ) token |
|
146 ==> [:token | |
|
147 (LRPOnEntry block: (token parsedValue at: 3)) |
|
148 start: token start stop: token stop; |
|
149 keywordEnd: (token parsedValue at: 3) start -1; |
|
150 yourself. |
|
151 ] |
|
152 ! |
|
153 |
|
154 onexit |
|
155 ^ (bra, 'onexit' asParser trim, (block/spawn), ket) token |
|
156 ==> [:token | |
|
157 (LRPOnExit block: (token parsedValue at: 3)) |
|
158 start: token start stop: token stop; |
|
159 keywordEnd: (token parsedValue at: 3) start -1; |
|
160 yourself. |
|
161 ] |
|
162 ! |
|
163 |
|
164 program |
|
165 ^ (variable / machine / comment / spawn / errorNode) star |
|
166 ! |
|
167 |
|
168 running |
|
169 ^ (bra, 'running' asParser trim, (block/spawn), ket) token |
|
170 ==> [:token | |
|
171 (LRPRunning block: (token parsedValue at: 3)) |
|
172 start: token start stop: token stop; |
|
173 keywordEnd: (token parsedValue at: 3) start -1; |
|
174 yourself. |
|
175 ] |
|
176 ! |
|
177 |
|
178 spawn |
|
179 ^(bra , 'spawn' asParser trim , identifier , identifier , ket) token |
|
180 ==> [ :token | |
|
181 (LRPSpawn |
|
182 machine: (token parsedValue at: 3) parsedValue |
|
183 state: (token parsedValue at: 4) parsedValue) |
|
184 start: token start stop: token stop; |
|
185 nameRange: ((token parsedValue at: 3) start to: (token parsedValue at: 4) stop) |
|
186 yourself. |
|
187 ] |
|
188 |
|
189 ! |
|
190 |
|
191 state |
|
192 ^(bra , 'state' asParser trim , identifier , statebody , ket) token |
|
193 ==> [ :token | | ident | |
|
194 ident := (token parsedValue at: 3). |
|
195 (LRPState name: ident parsedValue |
|
196 body: (token parsedValue at: 4)) |
|
197 start: token start stop: token stop; |
|
198 nameRange: (ident start to: ident stop); |
|
199 yourself. |
|
200 ] |
|
201 |
|
202 ! |
|
203 |
|
204 statebody |
|
205 ^(onentry / running / onexit / machine / comment / errorNode) star |
|
206 |
|
207 ! |
|
208 |
|
209 variable |
|
210 ^ (bra , 'var' asParser trim , identifier , ':=' asParser trim , block , ket) token |
|
211 ==> [ :token | |ident| |
|
212 ident := (token parsedValue at: 3). |
|
213 (LRPVariable name: ident parsedValue |
|
214 value: (token parsedValue at: 5)) |
|
215 start: token start stop: token stop; |
|
216 nameRange: (ident start to: ident stop); |
|
217 yourself. |
|
218 ] |
|
219 ! ! |
|
220 |
|
221 !PPCLRPParser_johanfabry_39 methodsFor:'grammar-comments'! |
|
222 |
|
223 comment |
|
224 ^ ((PPPredicateObjectParser blank / lineTerminator) star, ( $; asParser , (endOfComment negate star) flatten, endOfComment)) token |
|
225 ==> [ :token | |text| |
|
226 text := token parsedValue at: 2. |
|
227 (LRPComment text: (text copyFrom: 2 to: text size -1)) |
|
228 start: token start stop: token stop; |
|
229 yourself. |
|
230 ] |
|
231 ! |
|
232 |
|
233 endOfComment |
|
234 ^ #eof asParser / lineTerminator |
|
235 ! |
|
236 |
|
237 lineTerminator |
|
238 |
|
239 ^ (Character lf asParser) / (Character cr asParser , (Character lf asParser ) optional ) |
|
240 ! ! |
|
241 |
|
242 !PPCLRPParser_johanfabry_39 methodsFor:'grammar-common'! |
|
243 |
|
244 block |
|
245 ^PPSmalltalkParser new block |
|
246 ! |
|
247 |
|
248 bra |
|
249 ^ $( asParser trim |
|
250 ! |
|
251 |
|
252 identifier |
|
253 ^(#letter asParser ,(#letter asParser / #digit asParser / $_ asParser) star) flatten trim token |
|
254 ! |
|
255 |
|
256 ket |
|
257 ^ $) asParser trim |
|
258 ! ! |
|
259 |
|
260 !PPCLRPParser_johanfabry_39 methodsFor:'grammar-transitions'! |
|
261 |
|
262 epsilon |
|
263 ^ (bra, 'eps' asParser trim, identifier, '->' asParser trim, identifier, identifier optional, ket) token |
|
264 ==> [ :token | | trans name | |
|
265 name := (token parsedValue at: 6). |
|
266 name ifNil: [name := '' ] ifNotNil: [ name := name parsedValue ]. |
|
267 trans := |
|
268 (LRPEpsilonTransition |
|
269 from: (token parsedValue at: 3) parsedValue |
|
270 to: (token parsedValue at: 5) parsedValue |
|
271 name: name). |
|
272 self setTransitionRangesIn: trans for: token withArrowAt: 3. |
|
273 trans |
|
274 ] |
|
275 ! |
|
276 |
|
277 timeoutIdentifier |
|
278 ^ (bra, 'ontime' asParser trim, identifier , identifier, '->' asParser trim, identifier, identifier optional, ket) token |
|
279 ==> (self transitionActionHandlerFor: PPCLRPTimeoutTransition). |
|
280 ! |
|
281 |
|
282 timeoutInteger |
|
283 ^ (bra, 'ontime' asParser trim, integer, identifier, '->' asParser trim, identifier, identifier optional, ket) token |
|
284 ==> [ :token | | trans name | |
|
285 name := (token parsedValue at: 7). |
|
286 name ifNil: [name := '' ] ifNotNil: [ name := name parsedValue ]. |
|
287 trans := |
|
288 (LRPTimeoutTransition |
|
289 on: (Integer readFrom: (token parsedValue at: 3) parsedValue) |
|
290 from: (token parsedValue at: 4) parsedValue |
|
291 to: (token parsedValue at: 6) parsedValue |
|
292 name: name). |
|
293 self setTransitionRangesIn: trans for: token withArrowAt: 4. |
|
294 trans. |
|
295 ] |
|
296 ! |
|
297 |
|
298 transition |
|
299 ^ (bra, 'on' asParser trim, identifier, identifier, '->' asParser trim, identifier, identifier optional , ket) token |
|
300 ==> (self transitionActionHandlerFor: PPCLRPTransition). |
|
301 ! |
|
302 |
|
303 wildcard |
|
304 ^ (bra, 'on' asParser trim, identifier, '*->' asParser trim, identifier, identifier optional, ket) token |
|
305 ==> [ :token | | trans name | |
|
306 name := (token parsedValue at: 6). |
|
307 name ifNil: [name := '' ] ifNotNil: [ name := name parsedValue ]. |
|
308 trans := |
|
309 (LRPWildcardTransition |
|
310 on: (token parsedValue at: 3) parsedValue |
|
311 to: (token parsedValue at: 5) parsedValue |
|
312 name: name ). |
|
313 self setTransitionRangesIn: trans for: token withArrowAt: 3. |
|
314 trans |
|
315 ] |
|
316 |
|
317 ! ! |
|
318 |
|
319 !PPCLRPParser_johanfabry_39 methodsFor:'parsing'! |
|
320 |
|
321 parse: aString |
|
322 |
|
323 |parsedProgram | |
|
324 failed := false. |
|
325 parsedProgram := super parse: aString. |
|
326 |
|
327 parsedProgram isPetitFailure ifTrue:[ |
|
328 parsedProgram := |
|
329 {LRPErrorNode new |
|
330 start: 1; |
|
331 stop: aString size; |
|
332 yourself. |
|
333 } |
|
334 ]. |
|
335 |
|
336 "visit pattern?" |
|
337 parsedProgram do:[:aNode| |
|
338 (aNode onErrorNode: [:anErrorNode| ] parser: self) |
|
339 ]. |
|
340 |
|
341 ^parsedProgram. |
|
342 ! |
|
343 |
|
344 parse: aString onError: aBlock |
|
345 |parsedProgram| |
|
346 |
|
347 parsedProgram := self parse: aString. |
|
348 |
|
349 failed ifTrue:[ |
|
350 "visit pattern?" |
|
351 parsedProgram do:[:aNode| |
|
352 (aNode onErrorNode: aBlock parser: self) |
|
353 ]. |
|
354 ]. |
|
355 |
|
356 ^parsedProgram. |
|
357 ! |
|
358 |
|
359 parse: aText styleOn: aViewOrMorph |
|
360 |parsedProgram| |
|
361 |
|
362 parsedProgram := self parse: aText. |
|
363 self styler view: aViewOrMorph; parser: self; nodes: parsedProgram; style: aText. |
|
364 |
|
365 ^parsedProgram. |
|
366 ! ! |
|
367 |
|
368 !PPCLRPParser_johanfabry_39 methodsFor:'transitions'! |
|
369 |
|
370 setTransitionRangesIn: aTransition for: aToken withArrowAt: index |
|
371 | ident | |
|
372 ident := (aToken parsedValue at: index + 3). |
|
373 ident |
|
374 ifNil: [ aTransition nameRange: (1 to: 1) ] |
|
375 ifNotNil: [ aTransition nameRange: (ident start to: ident stop) ]. |
|
376 aTransition |
|
377 start: aToken start stop: aToken stop; |
|
378 arrowRange: |
|
379 ((aToken parsedValue at: index) stop + 1 |
|
380 to: (aToken parsedValue at: index + 2) start -1); |
|
381 keywordEnd: (aToken parsedValue at: 3) start -1 |
|
382 ! |
|
383 |
|
384 transitionActionHandlerFor: aTransitionClass |
|
385 ^[ :token | | trans name| |
|
386 name := (token parsedValue at: 7). |
|
387 name ifNil: [name := '' ] ifNotNil: [ name := name parsedValue ]. |
|
388 trans := |
|
389 (aTransitionClass |
|
390 on: (token parsedValue at: 3) parsedValue |
|
391 from: (token parsedValue at: 4) parsedValue |
|
392 to: (token parsedValue at: 6) parsedValue |
|
393 name: name). |
|
394 self setTransitionRangesIn: trans for: token withArrowAt: 4. |
|
395 trans. |
|
396 ] |
|
397 ! ! |
|
398 |