|
1 "{ Package: 'stx:goodies/petitparser/compiler' }" |
|
2 |
|
3 PPCListNode subclass:#PPCTrimmingTokenNode |
|
4 instanceVariableNames:'tokenClass' |
|
5 classVariableNames:'' |
|
6 poolDictionaries:'' |
|
7 category:'PetitCompiler-Nodes' |
|
8 ! |
|
9 |
|
10 PPCTrimmingTokenNode comment:'' |
|
11 ! |
|
12 |
|
13 !PPCTrimmingTokenNode methodsFor:'accessing'! |
|
14 |
|
15 child |
|
16 |
|
17 ^ children at: 2 |
|
18 ! |
|
19 |
|
20 child: anObject |
|
21 |
|
22 children at: 2 put: anObject |
|
23 ! |
|
24 |
|
25 compileWhitespace: compiler |
|
26 compiler add: 'context atWs ifFalse: ['. |
|
27 compiler indent. |
|
28 compiler call: (self whitespace compileWith: compiler). |
|
29 compiler add: 'context setWs.'. |
|
30 compiler dedent. |
|
31 compiler add: '].'. |
|
32 ! |
|
33 |
|
34 initialize |
|
35 super initialize. |
|
36 children := Array new: 2 |
|
37 ! |
|
38 |
|
39 rewrite: changeStatus |
|
40 | | |
|
41 super rewrite: changeStatus. |
|
42 |
|
43 (self allNodes anySatisfy: [ :node | node asFast ~= node ]) ifTrue: [ |
|
44 changeStatus change. |
|
45 self replace: self whitespace with: (self whitespace transform: [ :node | node asFast ]). |
|
46 self replace: self child with: (self child transform: [:node | node asFast]). |
|
47 ] |
|
48 ! |
|
49 |
|
50 tokenClass |
|
51 |
|
52 ^ tokenClass |
|
53 ! |
|
54 |
|
55 tokenClass: anObject |
|
56 |
|
57 tokenClass := anObject |
|
58 ! |
|
59 |
|
60 whitespace |
|
61 |
|
62 ^ children at: 1 |
|
63 ! |
|
64 |
|
65 whitespace: anObject |
|
66 (anObject name isNil and: [ self child name isNotNil ]) ifTrue: [ |
|
67 anObject name: self child name, '_water'. |
|
68 ]. |
|
69 children at: 1 put: anObject |
|
70 ! ! |
|
71 |
|
72 !PPCTrimmingTokenNode methodsFor:'analyzing'! |
|
73 |
|
74 acceptsEpsilon |
|
75 ^ self child acceptsEpsilonOpenSet: (IdentitySet with: self). |
|
76 ! |
|
77 |
|
78 acceptsEpsilonOpenSet: set |
|
79 (set includes: self child) ifFalse: [ |
|
80 set add: self child. |
|
81 ^ self child acceptsEpsilonOpenSet: set |
|
82 ]. |
|
83 ^ false |
|
84 ! |
|
85 |
|
86 firstSetSuchThat: block into: aCollection openSet: aSet |
|
87 (aSet includes: self) ifTrue: [ ^ aCollection ]. |
|
88 aSet add: self. |
|
89 |
|
90 (block value: self) ifTrue: [ aCollection add: self. ^ aCollection ]. |
|
91 |
|
92 ^ self child firstSetSuchThat: block into: aCollection openSet: aSet. |
|
93 ! ! |
|
94 |
|
95 !PPCTrimmingTokenNode methodsFor:'as yet unclassified'! |
|
96 |
|
97 compileWith: compiler effect: effect id: id |
|
98 | guardSetId guardSet | |
|
99 |
|
100 compiler startMethod: id. |
|
101 compiler startTokenMode. |
|
102 compiler addVariable: 'start'. |
|
103 compiler addVariable: 'end'. |
|
104 |
|
105 self compileWhitespace: compiler. |
|
106 |
|
107 (compiler guards and: [ (guardSet := compiler guardCharSet: self) isNil not ]) ifTrue: [ |
|
108 guardSetId := id, '_guard'. |
|
109 compiler addConstant: guardSet as: guardSetId. |
|
110 compiler add: 'context atEnd ifTrue: [ ^ self error ].'. |
|
111 compiler add: '(', guardSetId, ' value: context peek) ifFalse: [ ^ self error ].'. |
|
112 ]. |
|
113 |
|
114 compiler add: 'start := context position + 1.'. |
|
115 compiler call: (self child compileWith: compiler). |
|
116 compiler add: 'error ifTrue: [ ^ self ].'. |
|
117 compiler add: 'end := context position.'. |
|
118 |
|
119 self compileWhitespace: compiler. |
|
120 |
|
121 compiler add: '^ ', tokenClass asString, ' on: (context collection) |
|
122 start: start |
|
123 stop: end |
|
124 value: nil'. |
|
125 compiler stopTokenMode. |
|
126 ^ compiler stopMethod. |
|
127 ! |
|
128 |
|
129 prefix |
|
130 ^ #token |
|
131 ! ! |
|
132 |