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