|
1 "{ Package: 'stx:goodies/petitparser/compiler' }" |
|
2 |
|
3 PPCListNode subclass:#PPCChoiceNode |
|
4 instanceVariableNames:'' |
|
5 classVariableNames:'' |
|
6 poolDictionaries:'' |
|
7 category:'PetitCompiler-Nodes' |
|
8 ! |
|
9 |
|
10 PPCChoiceNode comment:'' |
|
11 ! |
|
12 |
|
13 !PPCChoiceNode methodsFor:'as yet unclassified'! |
|
14 |
|
15 acceptsEpsilon |
|
16 ^ self acceptsEpsilonOpenSet: IdentitySet new. |
|
17 ! |
|
18 |
|
19 acceptsEpsilonOpenSet: set |
|
20 set add: self. |
|
21 ^ self children anySatisfy: [:e | e acceptsEpsilonOpenSet: set ]. |
|
22 ! |
|
23 |
|
24 compileWith: compiler effect: effect id: id |
|
25 | firsts guard | |
|
26 compiler addVariable: 'element'. |
|
27 |
|
28 firsts := (self firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]). |
|
29 |
|
30 compiler startMethod: id. |
|
31 compiler addVariable: 'element'. |
|
32 |
|
33 "If we start with trimming token, we should invoke the whitespace parser" |
|
34 (firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [ |
|
35 firsts anyOne compileWhitespace: compiler. |
|
36 ]. |
|
37 |
|
38 (1 to: children size) do: [ :idx | |child| |
|
39 child := children at: idx. |
|
40 |
|
41 (compiler guards and: [ (guard := PPCGuard on: child) makesSense ]) ifTrue: [ |
|
42 guard id: (compiler idFor: guard prefixed: #guard). |
|
43 guard compileGuard: compiler. |
|
44 compiler add: ' ifTrue: [ '. |
|
45 compiler indent. |
|
46 compiler add: 'self clearError.'. |
|
47 compiler add: 'element := '. |
|
48 compiler callOnLine: (child compileWith: compiler). |
|
49 compiler add: 'error ifFalse: [ ^ element ].'. |
|
50 compiler dedent. |
|
51 compiler add: ' ].'. |
|
52 ] ifFalse: [ |
|
53 compiler add: 'self clearError.'. |
|
54 compiler add: 'element := '. |
|
55 compiler callOnLine: (child compileWith: compiler). |
|
56 compiler add: 'error ifFalse: [ ^ element ].'. |
|
57 ] |
|
58 ]. |
|
59 compiler add: '^ self error: ''no choice suitable'''. |
|
60 ^ compiler stopMethod. |
|
61 ! |
|
62 |
|
63 prefix |
|
64 ^ #ch |
|
65 ! ! |
|
66 |
|
67 !PPCChoiceNode methodsFor:'optimizing'! |
|
68 |
|
69 optimize: params status: changeStatus |
|
70 | retval | |
|
71 retval := self. |
|
72 retval := retval rewrite: params status: changeStatus. |
|
73 retval := retval inline: params status: changeStatus. |
|
74 |
|
75 ^ retval |
|
76 ! ! |
|
77 |