|
1 "{ Package: 'stx:goodies/petitparser/compiler' }" |
|
2 |
|
3 "{ NameSpace: Smalltalk }" |
|
4 |
|
5 PPCNodeVisitor subclass:#PPCCodeGenerator |
|
6 instanceVariableNames:'compiler' |
|
7 classVariableNames:'' |
|
8 poolDictionaries:'' |
|
9 category:'PetitCompiler-Visitors' |
|
10 ! |
|
11 |
|
12 !PPCCodeGenerator class methodsFor:'as yet unclassified'! |
|
13 |
|
14 on: aPPCCompiler |
|
15 ^ self new |
|
16 compiler: aPPCCompiler; |
|
17 yourself |
|
18 ! ! |
|
19 |
|
20 !PPCCodeGenerator methodsFor:'accessing'! |
|
21 |
|
22 compiler: aPPCCompiler |
|
23 compiler := aPPCCompiler |
|
24 ! ! |
|
25 |
|
26 !PPCCodeGenerator methodsFor:'hooks'! |
|
27 |
|
28 afterAccept: node retval: retval |
|
29 "return the method from compiler" |
|
30 ^ self stopMethodForNode: node. |
|
31 ! |
|
32 |
|
33 beforeAccept: node |
|
34 self startMethodForNode: node |
|
35 ! |
|
36 |
|
37 closedDetected: node |
|
38 ^ node isMarkedForInline ifFalse: [ |
|
39 self error: 'Should not happen!!' |
|
40 ] |
|
41 ! |
|
42 |
|
43 openDetected: node |
|
44 ^ compiler checkCache: (compiler idFor: node) |
|
45 ! ! |
|
46 |
|
47 !PPCCodeGenerator methodsFor:'support'! |
|
48 |
|
49 addGuard: node |
|
50 | guard firsts id | |
|
51 (arguments guards not or: [(guard := PPCGuard on: node) makesSense not]) ifTrue: [ ^ self]. |
|
52 |
|
53 id := compiler idFor: node. |
|
54 firsts := (node firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]). |
|
55 |
|
56 |
|
57 (firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [ |
|
58 "If we start with trimming, we should invoke the whitespace parser" |
|
59 self compileTokenWhitespace: firsts anyOne. |
|
60 |
|
61 compiler add: 'context atEnd ifTrue: [ ^ self error ].'. |
|
62 guard id: id, '_guard'. |
|
63 guard compileGuard: compiler. |
|
64 compiler addOnLine: 'ifFalse: [ ^ self error ].' |
|
65 ]. |
|
66 |
|
67 (firsts allSatisfy: [ :e | e isTerminal ]) ifTrue: [ |
|
68 compiler add: 'context atEnd ifTrue: [ ^ self error ].'. |
|
69 guard id: id, '_guard'. |
|
70 guard compileGuard: compiler. |
|
71 compiler addOnLine: 'ifFalse: [ ^ self error ].' |
|
72 ]. |
|
73 ! |
|
74 |
|
75 compileTokenWhitespace: node |
|
76 compiler add: 'context atWs ifFalse: ['. |
|
77 compiler indent. |
|
78 compiler call: (self visit: node whitespace). |
|
79 compiler add: 'context setWs.'. |
|
80 compiler dedent. |
|
81 compiler add: '].'. |
|
82 ! |
|
83 |
|
84 notCharSetPredicateBody: node |
|
85 | classificationId classification | |
|
86 self error: 'deprecated.'. |
|
87 classification := node extendClassification: node predicate classification. |
|
88 classificationId := (compiler idFor: classification prefixed: #classification). |
|
89 compiler addConstant: classification as: classificationId. |
|
90 |
|
91 compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'. |
|
92 compiler indent. |
|
93 compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'. |
|
94 compiler add: ' ifFalse: [ nil ].'. |
|
95 compiler dedent. |
|
96 ! |
|
97 |
|
98 notMessagePredicateBody: node |
|
99 self error: 'deprecated'. |
|
100 compiler addOnLine: '(context peek ', node message, ')'. |
|
101 compiler indent. |
|
102 compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'. |
|
103 compiler add: ' ifFalse: [ nil ].'. |
|
104 compiler dedent. |
|
105 ! |
|
106 |
|
107 predicateBody: node |
|
108 | tmpId | |
|
109 self error:'deprecated'. |
|
110 tmpId := (compiler idFor: node predicate prefixed: #predicate). |
|
111 compiler addConstant: node predicate as: tmpId. |
|
112 |
|
113 compiler addOnLine: '(context atEnd not and: [ ', tmpId , ' value: context uncheckedPeek])'. |
|
114 compiler indent. |
|
115 compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'. |
|
116 compiler add: 'ifTrue: [ context next ].'. |
|
117 compiler dedent. |
|
118 ! |
|
119 |
|
120 retvalVar |
|
121 ^ compiler currentReturnVariable |
|
122 ! |
|
123 |
|
124 startMethodForNode:node |
|
125 node isMarkedForInline ifTrue:[ |
|
126 compiler startInline: (compiler idFor: node). |
|
127 compiler addComment: 'BEGIN inlined code of ' , node printString. |
|
128 compiler indent. |
|
129 ] ifFalse:[ |
|
130 compiler startMethod: (compiler idFor: node). |
|
131 compiler addComment: 'GENERATED by ' , node printString. |
|
132 compiler allocateReturnVariable. |
|
133 ]. |
|
134 |
|
135 "Created: / 23-04-2015 / 15:51:06 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
136 "Modified: / 23-04-2015 / 19:13:25 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
137 "Modified (comment): / 23-04-2015 / 21:31:24 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
138 ! |
|
139 |
|
140 stopMethodForNode:aPPCNode |
|
141 ^ aPPCNode isMarkedForInline ifTrue:[ |
|
142 compiler dedent. |
|
143 compiler add: '"END inlined code of ' , aPPCNode printString , '"'. |
|
144 compiler stopInline. |
|
145 ] ifFalse:[ |
|
146 compiler stopMethod |
|
147 ]. |
|
148 |
|
149 "Created: / 23-04-2015 / 15:51:09 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
150 "Modified: / 23-04-2015 / 18:35:41 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
151 ! ! |
|
152 |
|
153 !PPCCodeGenerator methodsFor:'traversing - caching'! |
|
154 |
|
155 cache: node value: retval |
|
156 "this is compiler thing, not mine" |
|
157 ! |
|
158 |
|
159 cachedDetected: node |
|
160 ^ compiler checkCache: (compiler idFor: node) |
|
161 ! |
|
162 |
|
163 isCached: node |
|
164 ^ (compiler checkCache: (compiler idFor: node)) isNil not |
|
165 ! ! |
|
166 |
|
167 !PPCCodeGenerator methodsFor:'visiting'! |
|
168 |
|
169 visitActionNode: node |
|
170 compiler addConstant: node block as: (compiler idFor: node). |
|
171 |
|
172 compiler addVariable: 'element'. |
|
173 compiler add: 'element := '. |
|
174 compiler callOnLine: (self visit: node child). |
|
175 compiler add: 'error ifFalse: [ ^ ', (compiler idFor: node), ' value: element ].'. |
|
176 compiler add: '^ failure'. |
|
177 |
|
178 "Modified: / 23-04-2015 / 15:59:00 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
179 ! |
|
180 |
|
181 visitAndNode: node |
|
182 | mementoVar | |
|
183 |
|
184 mementoVar := compiler allocateTemporaryVariableNamed: 'memento'. |
|
185 compiler add: (compiler smartRemember: node child to: mementoVar). |
|
186 |
|
187 compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar. |
|
188 compiler add: (compiler smartRestore: node child from: mementoVar). |
|
189 |
|
190 compiler codeReturn. |
|
191 |
|
192 "Modified: / 23-04-2015 / 15:59:07 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
193 ! |
|
194 |
|
195 visitAnyNode: node |
|
196 |
|
197 compiler codeReturn: 'context next ifNil: [ error := true. ].'. |
|
198 |
|
199 "Modified: / 23-04-2015 / 20:52:15 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
200 ! |
|
201 |
|
202 visitCharSetPredicateNode: node |
|
203 |
|
204 | classification classificationId | |
|
205 classification := node extendClassification: node predicate classification. |
|
206 classificationId := compiler idFor: classification prefixed: #classification. |
|
207 compiler addConstant: classification as: classificationId. |
|
208 |
|
209 compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'. |
|
210 compiler indent. |
|
211 compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'. |
|
212 compiler add: 'ifTrue: [ '. |
|
213 compiler codeReturn: 'context next'. |
|
214 compiler add: '].'. |
|
215 compiler dedent. |
|
216 ! |
|
217 |
|
218 visitCharacterNode: node |
|
219 | chid | |
|
220 node character ppcPrintable ifTrue: [ |
|
221 chid := node character storeString |
|
222 ] ifFalse: [ |
|
223 chid := compiler idFor: node character prefixed: #char. |
|
224 compiler addConstant: (Character value: node character asInteger) as: chid . |
|
225 ]. |
|
226 |
|
227 compiler add: '(context peek == ', chid, ')'. |
|
228 compiler indent. |
|
229 compiler add: 'ifFalse: [ self error: ''', node character asInteger asString, ' expected'' at: context position ] '. |
|
230 compiler add: 'ifTrue: [ '. |
|
231 compiler codeReturn: 'context next'. |
|
232 compiler add: '].'. |
|
233 compiler dedent. |
|
234 ! |
|
235 |
|
236 visitChild: child of: node |
|
237 | | |
|
238 |
|
239 (self isOpen: child) ifTrue: [ |
|
240 "already processing..." |
|
241 ^ nil |
|
242 ]. |
|
243 |
|
244 "TODO JK: this is is wrong,.. to tired now to fix this :(" |
|
245 " (self isCached: child) ifTrue: [ |
|
246 node replace: child with: (self cachedValue: child). |
|
247 ^ nil |
|
248 ]. |
|
249 " |
|
250 ^ self visit: child. |
|
251 ! |
|
252 |
|
253 visitChoiceNode: node |
|
254 | firsts guard whitespaceConsumed | |
|
255 |
|
256 |
|
257 whitespaceConsumed := false. |
|
258 firsts := (node firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]). |
|
259 |
|
260 |
|
261 compiler addVariable: 'element'. |
|
262 "If we start with trimming token, we should invoke the whitespace parser" |
|
263 (firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [ |
|
264 self compileTokenWhitespace: firsts anyOne. |
|
265 whitespaceConsumed := true. |
|
266 ]. |
|
267 |
|
268 1 to: node children size do: [ :idx | |child allowGuard | |
|
269 child := node children at: idx. |
|
270 " allowGuard := ((child isKindOf: PPCTrimmingTokenNode) and: [ whitespaceConsumed not ]) not. |
|
271 " |
|
272 allowGuard := whitespaceConsumed. |
|
273 |
|
274 (allowGuard and: [arguments guards and: [ (guard := PPCGuard on: child) makesSense ]]) ifTrue: [ |
|
275 guard id: (compiler idFor: guard prefixed: #guard). |
|
276 guard compileGuard: compiler. |
|
277 compiler add: ' ifTrue: [ '. |
|
278 compiler indent. |
|
279 compiler add: 'self clearError.'. |
|
280 compiler codeStoreValueOf: [self visit: child] intoVariable: 'element'. |
|
281 compiler add: 'error ifFalse: [ ^ element ].'. |
|
282 compiler dedent. |
|
283 compiler add: ' ].'. |
|
284 ] ifFalse: [ |
|
285 compiler add: 'self clearError.'. |
|
286 compiler codeStoreValueOf: [self visit: child] intoVariable: 'element'. |
|
287 compiler add: 'error ifFalse: [ ^ element ].'. |
|
288 ] |
|
289 ]. |
|
290 compiler add: '^ self error: ''no choice suitable'''. |
|
291 |
|
292 "Modified: / 23-04-2015 / 21:40:23 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
293 ! |
|
294 |
|
295 visitEndOfFileNode: node |
|
296 compiler codeReturn: 'context atEnd ifTrue: [ #EOF ] ifFalse: [ self error: ''EOF expected!!'' ].'. |
|
297 ! |
|
298 |
|
299 visitForwardNode: node |
|
300 |
|
301 compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar. |
|
302 compiler codeReturn. |
|
303 ! |
|
304 |
|
305 visitLiteralNode: node |
|
306 | positionVar encodedLiteral | |
|
307 encodedLiteral := node encodeQuotes: node literal. |
|
308 positionVar := compiler allocateTemporaryVariableNamed: 'position'. |
|
309 |
|
310 compiler codeAssign: 'context position.' to: positionVar. |
|
311 compiler add: '((context next: ', node literal size asString, ') = #''', encodedLiteral, ''') ifTrue: ['. |
|
312 compiler codeReturn: '#''', encodedLiteral, ''' '. |
|
313 compiler add: '] ifFalse: ['. |
|
314 compiler add: ' context position: ', positionVar, '.'. |
|
315 compiler add: ' self error: ''', encodedLiteral, ' expected'' at: position'. |
|
316 compiler add: '].'. |
|
317 ! |
|
318 |
|
319 visitMessagePredicateNode: node |
|
320 compiler add: '(context peek ', node message, ') ifFalse: ['. |
|
321 compiler add: ' self error: ''predicate not found'''. |
|
322 compiler add: '] ifTrue: [ '. |
|
323 compiler codeReturn: ' context next'. |
|
324 compiler add: '].'. |
|
325 |
|
326 "Modified: / 23-04-2015 / 18:39:03 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
327 ! |
|
328 |
|
329 visitNilNode: node |
|
330 |
|
331 compiler codeReturn: 'nil.'. |
|
332 ! |
|
333 |
|
334 visitNotCharSetPredicateNode: node |
|
335 | classificationId classification | |
|
336 classification := node extendClassification: node predicate classification. |
|
337 classificationId := (compiler idFor: classification prefixed: #classification). |
|
338 compiler addConstant: classification as: classificationId. |
|
339 |
|
340 compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'. |
|
341 compiler indent. |
|
342 compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'. |
|
343 compiler add: ' ifFalse: ['. |
|
344 compiler codeReturn: 'nil'. |
|
345 compiler add: '].'. |
|
346 compiler dedent. |
|
347 ! |
|
348 |
|
349 visitNotLiteralNode: node |
|
350 | encodedLiteral size | |
|
351 encodedLiteral := node encodeQuotes: node literal. |
|
352 size := node literal size asString. |
|
353 |
|
354 compiler add: '((context peek: ', size, ') =#''', encodedLiteral, ''')'. |
|
355 compiler indent. |
|
356 compiler add: 'ifTrue: [ self error: ''', encodedLiteral, ' not expected'' ]'. |
|
357 compiler add: 'ifFalse: [ '. |
|
358 compiler codeReturn: 'nil' . |
|
359 compiler add: '].'. |
|
360 compiler dedent. |
|
361 ! |
|
362 |
|
363 visitNotMessagePredicateNode: node |
|
364 compiler addOnLine: '(context peek ', node message, ')'. |
|
365 compiler indent. |
|
366 compiler add: ' ifTrue: [ '. |
|
367 compiler codeError: 'predicate not expected'. |
|
368 compiler add: '] ifFalse: ['. |
|
369 compiler codeReturn: 'nil'. |
|
370 compiler add: ' ].'. |
|
371 compiler dedent. |
|
372 ! |
|
373 |
|
374 visitNotNode: node |
|
375 |
|
376 |
|
377 compiler addVariable: 'memento'. |
|
378 compiler add: (compiler smartRemember: node child). |
|
379 |
|
380 compiler call: (self visit: node child). |
|
381 compiler add: (compiler smartRestore: node child). |
|
382 |
|
383 compiler add: '^ error ifFalse: [ self error ] ifTrue: [ self clearError. nil ]'. |
|
384 ! |
|
385 |
|
386 visitOptionalNode: node |
|
387 compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar. |
|
388 compiler add: 'error ifTrue: [ '. |
|
389 compiler add: ' self clearError. '. |
|
390 compiler codeAssign: 'nil.' to: self retvalVar. |
|
391 compiler add: '].'. |
|
392 compiler codeReturn. |
|
393 ! |
|
394 |
|
395 visitPluggableNode: node |
|
396 | blockId | |
|
397 blockId := compiler idFor: node block prefixed: #block. |
|
398 |
|
399 compiler addConstant: node block as: blockId. |
|
400 compiler codeReturn: blockId, ' value: context.'. |
|
401 ! |
|
402 |
|
403 visitPlusNode: node |
|
404 | elementVar | |
|
405 |
|
406 elementVar := compiler allocateTemporaryVariableNamed: 'element'. |
|
407 |
|
408 compiler codeAssign: 'OrderedCollection new.' to: self retvalVar. |
|
409 compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar. |
|
410 |
|
411 compiler add: 'error ifTrue: [ self error: ''at least one occurence expected'' ] ifFalse: ['. |
|
412 compiler indent. |
|
413 compiler add: self retvalVar , ' add: ',elementVar , '.'. |
|
414 |
|
415 compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar. |
|
416 compiler add: '[ error ] whileFalse: ['. |
|
417 compiler indent. |
|
418 compiler add: self retvalVar , ' add: ',elementVar , '.'. |
|
419 compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar. |
|
420 compiler dedent. |
|
421 compiler add: '].'. |
|
422 compiler add: 'self clearError.'. |
|
423 compiler codeReturn: self retvalVar , ' asArray.'. |
|
424 compiler dedent. |
|
425 compiler add: '].'. |
|
426 |
|
427 "Modified (comment): / 23-04-2015 / 21:30:49 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
428 ! |
|
429 |
|
430 visitPredicateNode: node |
|
431 | pid | |
|
432 pid := (compiler idFor: node predicate prefixed: #predicate). |
|
433 |
|
434 compiler addConstant: node predicate as: pid. |
|
435 |
|
436 compiler add: '(context atEnd not and: [ ', pid , ' value: context uncheckedPeek])'. |
|
437 compiler indent. |
|
438 compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'. |
|
439 compiler add: 'ifTrue: [ ', self retvalVar ,' := context next ].'. |
|
440 compiler dedent. |
|
441 compiler codeReturn. |
|
442 |
|
443 "Modified: / 23-04-2015 / 21:48:11 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
444 ! |
|
445 |
|
446 visitSequenceNode: node |
|
447 |
|
448 | elementVar mementoVar | |
|
449 |
|
450 elementVar := compiler allocateTemporaryVariableNamed: 'element'. |
|
451 mementoVar := compiler allocateTemporaryVariableNamed: 'memento'. |
|
452 |
|
453 compiler add: (compiler smartRemember: node to: mementoVar). |
|
454 compiler codeAssign: 'Array new: ', node children size asString, '.' to: self retvalVar. |
|
455 self addGuard: node. |
|
456 |
|
457 1 to: (node children size) do: [ :idx | |child| |
|
458 child := node children at: idx. |
|
459 compiler codeStoreValueOf: [ self visit: child ] intoVariable: elementVar. |
|
460 |
|
461 compiler add: 'error ifTrue: [ ', (compiler smartRestore: node) ,' ^ failure ].'. |
|
462 compiler add: self retvalVar , ' at: ', idx asString, ' put: ',elementVar,'.'. |
|
463 ]. |
|
464 compiler codeReturn |
|
465 |
|
466 "Modified: / 23-04-2015 / 22:03:11 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
467 ! |
|
468 |
|
469 visitStarAnyNode: node |
|
470 |
|
471 compiler addVariable: 'retval size'. |
|
472 compiler add: 'size := context size - context position.'. |
|
473 compiler add: 'retval := Array new: size.'. |
|
474 compiler add: '(1 to: size) do: [ :e | retval at: e put: context next ].'. |
|
475 compiler add: '^ retval'. |
|
476 |
|
477 ! |
|
478 |
|
479 visitStarCharSetPredicateNode: node |
|
480 | classification classificationId | |
|
481 |
|
482 |
|
483 classification := node extendClassification: node predicate classification. |
|
484 classificationId := compiler idFor: classification prefixed: #classification. |
|
485 compiler addConstant: classification as: classificationId. |
|
486 |
|
487 compiler codeAssign: 'OrderedCollection new.' to: self retvalVar. |
|
488 compiler add: '[ ', classificationId, ' at: context peek asInteger ] whileTrue: ['. |
|
489 compiler indent. |
|
490 compiler add: self retvalVar, ' add: context next.'. |
|
491 compiler dedent. |
|
492 compiler add: '].'. |
|
493 compiler codeReturn: 'retval asArray'. |
|
494 ! |
|
495 |
|
496 visitStarMessagePredicateNode: node |
|
497 |
|
498 compiler codeAssign: 'OrderedCollection new.' to: self retvalVar. |
|
499 compiler add: '[ context peek ', node message, ' ] whileTrue: ['. |
|
500 compiler indent. |
|
501 compiler add: self retvalVar, ' add: context next.'. |
|
502 compiler dedent. |
|
503 compiler add: '].'. |
|
504 compiler codeReturn: 'retval asArray'. |
|
505 ! |
|
506 |
|
507 visitStarNode: node |
|
508 | elementVar | |
|
509 |
|
510 elementVar := compiler allocateTemporaryVariableNamed: 'element'. |
|
511 |
|
512 compiler codeAssign: 'OrderedCollection new.' to: self retvalVar. |
|
513 compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar. |
|
514 compiler add: '[ error ] whileFalse: ['. |
|
515 compiler indent. |
|
516 compiler add: self retvalVar, ' add: element.'. |
|
517 compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar. |
|
518 compiler dedent. |
|
519 compiler add: '].'. |
|
520 compiler codeClearError. |
|
521 compiler codeReturn: self retvalVar, ' asArray'. |
|
522 ! |
|
523 |
|
524 visitSymbolActionNode: node |
|
525 | elementVar | |
|
526 |
|
527 elementVar := compiler allocateTemporaryVariableNamed: 'element'. |
|
528 compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar. |
|
529 compiler add: 'error ifFalse: [ '. |
|
530 compiler codeReturn: elementVar, ' ', node block asString, '.'. |
|
531 compiler add: '] ifTrue: ['. |
|
532 compiler codeReturn: 'failure'. |
|
533 compiler add: ']'. |
|
534 ! |
|
535 |
|
536 visitTokenActionNode: node |
|
537 " |
|
538 Actually, do nothing, we are in Token mode and the |
|
539 child does not return any result and token takes only |
|
540 the input value. |
|
541 " |
|
542 |
|
543 compiler add: '^ '. |
|
544 compiler callOnLine: (node child compileWith: compiler). |
|
545 ! |
|
546 |
|
547 visitTokenNode: node |
|
548 | startVar endVar | |
|
549 startVar := compiler allocateTemporaryVariableNamed: 'start'. |
|
550 endVar := compiler allocateTemporaryVariableNamed: 'end'. |
|
551 |
|
552 compiler codeAssign: 'context position + 1.' to: startVar. |
|
553 compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever. |
|
554 compiler add: 'error ifFalse: [ '. |
|
555 compiler indent. |
|
556 compiler codeAssign: 'context position.' to: endVar. |
|
557 |
|
558 compiler codeReturn: node tokenClass asString, ' on: (context collection) |
|
559 start: ', startVar, ' |
|
560 stop: ', endVar, ' |
|
561 value: nil.'. |
|
562 compiler dedent. |
|
563 compiler add: '].'. |
|
564 ! |
|
565 |
|
566 visitTokenSequenceNode: node |
|
567 |
|
568 |
|
569 compiler addVariable: 'memento'. |
|
570 compiler add: (compiler smartRemember: node). |
|
571 |
|
572 " self addGuard: compiler." |
|
573 |
|
574 compiler codeStoreValueOf: [ self visit: (node children at: 1) ] intoVariable: #whatever. |
|
575 compiler add: 'error ifTrue: [ ^ failure ].'. |
|
576 |
|
577 2 to: (node children size) do: [ :idx | |child| |
|
578 child := node children at: idx. |
|
579 compiler codeStoreValueOf: [ self visit: child ] intoVariable: #whatever. |
|
580 compiler add: 'error ifTrue: [ ', (compiler smartRestore: node) ,' ^ failure ].'. |
|
581 ]. |
|
582 ! |
|
583 |
|
584 visitTokenStarMessagePredicateNode: node |
|
585 |
|
586 compiler add: '[ context peek ', node message,' ] whileTrue: ['. |
|
587 compiler indent. |
|
588 compiler add: 'context next'. |
|
589 compiler indent. |
|
590 compiler dedent. |
|
591 compiler add: '].'. |
|
592 ! |
|
593 |
|
594 visitTokenStarSeparatorNode: node |
|
595 |
|
596 compiler add: 'context skipSeparators.'. |
|
597 ! |
|
598 |
|
599 visitTrimNode: node |
|
600 | mementoVar | |
|
601 "TODO: This ignores the TrimmingParser trimmer object!!" |
|
602 |
|
603 mementoVar := compiler allocateTemporaryVariableNamed: 'memento'. |
|
604 |
|
605 compiler add: (compiler smartRemember: node child to: mementoVar). |
|
606 compiler add: 'context skipSeparators.'. |
|
607 |
|
608 compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar. |
|
609 |
|
610 compiler add: 'error ifTrue: [ '. |
|
611 compiler indent. |
|
612 compiler add: (compiler smartRestore: node child from: mementoVar). |
|
613 compiler codeReturn. |
|
614 compiler dedent. |
|
615 compiler add: '] ifFalse: [' . |
|
616 compiler indent. |
|
617 compiler add: 'context skipSeparators.'. |
|
618 compiler codeReturn. |
|
619 compiler dedent. |
|
620 compiler add: '].'. |
|
621 ! |
|
622 |
|
623 visitTrimmingTokenNode: node |
|
624 | id guard startVar endVar | |
|
625 |
|
626 startVar := compiler allocateTemporaryVariableNamed: 'start'. |
|
627 endVar := compiler allocateTemporaryVariableNamed: 'end'. |
|
628 |
|
629 id := compiler idFor: node. |
|
630 " (id beginsWith: 'kw') ifTrue: [ self halt. ]." |
|
631 "self compileFirstWhitespace: compiler." |
|
632 self compileTokenWhitespace: node. |
|
633 |
|
634 (arguments guards and: [(guard := PPCGuard on: node) makesSense]) ifTrue: [ |
|
635 compiler add: 'context atEnd ifTrue: [ ^ self error ].'. |
|
636 guard id: id, '_guard'. |
|
637 guard compileGuard: compiler. |
|
638 compiler addOnLine: 'ifFalse: [ ^ self error ].' |
|
639 ]. |
|
640 |
|
641 compiler codeAssign: 'context position + 1.' to: startVar. |
|
642 compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever. |
|
643 compiler add: 'error ifFalse: [ '. |
|
644 compiler indent. |
|
645 compiler codeAssign: 'context position.' to: endVar. |
|
646 |
|
647 " self compileSecondWhitespace: compiler." |
|
648 self compileTokenWhitespace: node. |
|
649 |
|
650 compiler codeReturn: node tokenClass asString, ' on: (context collection) |
|
651 start: ', startVar, ' |
|
652 stop: ', endVar, ' |
|
653 value: nil'. |
|
654 compiler dedent. |
|
655 compiler add: '].' |
|
656 ! |
|
657 |
|
658 visitUnknownNode: node |
|
659 | compiledChild compiledParser id | |
|
660 |
|
661 id := compiler idFor: node. |
|
662 |
|
663 compiledParser := node parser copy. |
|
664 "Compile all the children and call compiled version of them instead of the original one" |
|
665 compiledParser children do: [ :child | |
|
666 compiledChild := self visit: child. |
|
667 compiledParser replace: child with: compiledChild bridge. |
|
668 ]. |
|
669 |
|
670 compiler addConstant: compiledParser as: id. |
|
671 |
|
672 compiler codeClearError. |
|
673 compiler add: '(', self retvalVar, ' := ', id, ' parseOn: context) isPetitFailure'. |
|
674 compiler indent. |
|
675 compiler add: ' ifTrue: [self error: retval message at: ', self retvalVar, ' position ].'. |
|
676 compiler dedent. |
|
677 compiler add: 'error := ', self retvalVar, ' isPetitFailure.'. |
|
678 compiler codeReturn. |
|
679 ! ! |
|
680 |