1 "{ Package: 'stx:goodies/petitparser/compiler' }" |
1 "{ Package: 'stx:goodies/petitparser/compiler' }" |
2 |
2 |
3 "{ NameSpace: Smalltalk }" |
3 "{ NameSpace: Smalltalk }" |
4 |
4 |
5 PPCCodeGenerator subclass:#PPCTokenCodeGenerator |
5 PPCNodeVisitor subclass:#PPCTokenCodeGenerator |
6 instanceVariableNames:'' |
6 instanceVariableNames:'compiler scannerGenerator fsaCache' |
7 classVariableNames:'' |
7 classVariableNames:'' |
8 poolDictionaries:'' |
8 poolDictionaries:'' |
9 category:'PetitCompiler-Visitors' |
9 category:'PetitCompiler-Visitors' |
10 ! |
10 ! |
11 |
11 |
12 !PPCTokenCodeGenerator methodsFor:'as yet unclassified'! |
12 !PPCTokenCodeGenerator methodsFor:'accessing'! |
13 |
13 |
14 afterAccept: node retval: retval |
14 arguments: args |
15 | return | |
15 super arguments: args. |
16 return := super afterAccept: node retval: retval. |
16 scannerGenerator arguments: args |
17 return category: 'generated - tokens'. |
17 ! |
18 ^ return |
18 |
19 ! |
19 compiler |
20 |
20 ^ compiler |
21 fromTokenMode |
21 ! |
22 compiler rememberStrategy: (PPCCompilerTokenizingRememberStrategy on: compiler). |
22 |
23 compiler errorStrategy: (PPCCompilerTokenizingErrorStrategy on: compiler). |
23 compiler: anObject |
24 ! |
24 compiler := anObject. |
25 |
25 |
26 toTokenMode |
26 scannerGenerator compiler idGen: compiler idGen. |
27 compiler rememberStrategy: (PPCCompilerTokenRememberStrategy on: compiler). |
27 ! ! |
28 compiler errorStrategy: (PPCCompilerTokenErrorStrategy on: compiler). |
28 |
|
29 !PPCTokenCodeGenerator methodsFor:'code support'! |
|
30 |
|
31 consumeWhitespace: node |
|
32 self assert: node isTokenNode. |
|
33 |
|
34 node isTrimmingTokenNode ifTrue: [ |
|
35 compiler code: 'self consumeWhitespace.' |
|
36 ] |
|
37 ! |
|
38 |
|
39 createTokenInsance: node id: idCode start: startVar end: endVar |
|
40 compiler codeTranscriptShow: 'current token type: ', idCode. |
|
41 compiler codeAssign: idCode, '.' to: 'currentTokenType'. |
|
42 compiler codeAssign: node tokenClass asString, ' on: (context collection) |
|
43 start: ', startVar, ' |
|
44 stop: ', endVar, ' |
|
45 value: nil.' |
|
46 to: 'currentTokenValue'. |
|
47 ! |
|
48 |
|
49 scan: node start: startVar end: endVar |
|
50 node child hasName ifFalse: [ |
|
51 node child name: node name |
|
52 ]. |
|
53 |
|
54 compiler codeAssign: 'context position + 1.' to: startVar. |
|
55 compiler add: ((self generateScan: node child) callOn: 'scanner'). |
|
56 ! |
|
57 |
|
58 unorderedChoiceFromFollowSet: followSet |
|
59 | followFsas | |
|
60 |
|
61 ^ fsaCache at: followSet ifAbsentPut: [ |
|
62 followFsas := followSet collect: [ :followNode | |
|
63 (followNode asFsa) |
|
64 name: (compiler idFor: followNode); |
|
65 retval: (compiler idFor: followNode); |
|
66 yourself |
|
67 ]. |
|
68 self unorderedChoiceFromFsas: followFsas. |
|
69 ] |
|
70 |
|
71 ! |
|
72 |
|
73 unorderedChoiceFromFsas: fsas |
|
74 | result startState | |
|
75 result := PEGFsa new. |
|
76 startState := PEGFsaState new. |
|
77 |
|
78 result addState: startState. |
|
79 result startState: startState. |
|
80 |
|
81 fsas do: [ :fsa | |
|
82 result adopt: fsa. |
|
83 result addTransitionFrom: startState to: fsa startState. |
|
84 ]. |
|
85 |
|
86 result determinizeStandard. |
|
87 ^ result |
|
88 ! ! |
|
89 |
|
90 !PPCTokenCodeGenerator methodsFor:'compiling support'! |
|
91 |
|
92 compileScanner |
|
93 ^ scannerGenerator compileScannerClass |
|
94 ! |
|
95 |
|
96 retvalVar |
|
97 ^ compiler currentReturnVariable |
|
98 ! |
|
99 |
|
100 startMethodForNode:node |
|
101 node isMarkedForInline ifTrue:[ |
|
102 compiler startInline: (compiler idFor: node). |
|
103 compiler codeComment: 'BEGIN inlined code of ' , node printString. |
|
104 compiler indent. |
|
105 ] ifFalse:[ |
|
106 compiler startMethod: (compiler idFor: node). |
|
107 compiler currentMethod category: 'generated - tokens'. |
|
108 compiler codeComment: 'GENERATED by ' , node printString. |
|
109 compiler allocateReturnVariable. |
|
110 ] |
|
111 ! |
|
112 |
|
113 stopMethodForNode:aPPCNode |
|
114 ^ aPPCNode isMarkedForInline ifTrue:[ |
|
115 compiler dedent. |
|
116 compiler add: '"END inlined code of ' , aPPCNode printString , '"'. |
|
117 compiler stopInline. |
|
118 ] ifFalse:[ |
|
119 compiler stopMethod |
|
120 ]. |
|
121 ! ! |
|
122 |
|
123 !PPCTokenCodeGenerator methodsFor:'initialization'! |
|
124 |
|
125 initialize |
|
126 super initialize. |
|
127 |
|
128 scannerGenerator := PPCScannerCodeGenerator new. |
|
129 scannerGenerator arguments: arguments. |
|
130 |
|
131 "for the given set of nodes, remember the unordered choice fsa |
|
132 see `unorderedChoiceFromFollowSet:` |
|
133 " |
|
134 fsaCache := Dictionary new. |
|
135 ! ! |
|
136 |
|
137 !PPCTokenCodeGenerator methodsFor:'scanning'! |
|
138 |
|
139 generateNextScan: node |
|
140 | epsilon followSet anFsa | |
|
141 followSet := node followSetWithTokens. |
|
142 |
|
143 epsilon := followSet anySatisfy: [ :e | e acceptsEpsilon ]. |
|
144 followSet := followSet reject: [ :e | e acceptsEpsilon ]. |
|
145 epsilon ifTrue: [ followSet add: PPCEndOfFileNode instance ]. |
|
146 |
|
147 anFsa := self unorderedChoiceFromFollowSet: followSet. |
|
148 |
|
149 anFsa name: 'nextToken_', (compiler idFor: node). |
|
150 node nextFsa: anFsa. |
|
151 ^ scannerGenerator generate: anFsa. |
|
152 ! |
|
153 |
|
154 generateScan: node |
|
155 | anFsa | |
|
156 anFsa := node asFsa determinize. |
|
157 anFsa name: (compiler idFor: node). |
|
158 anFsa retval: (compiler idFor: node). |
|
159 |
|
160 ^ scannerGenerator generate: anFsa. |
29 ! ! |
161 ! ! |
30 |
162 |
31 !PPCTokenCodeGenerator methodsFor:'visiting'! |
163 !PPCTokenCodeGenerator methodsFor:'visiting'! |
32 |
164 |
33 visitOptionalNode: node |
165 visitToken: tokenNode |
34 compiler |
166 | id startVar endVar numberId | |
35 codeAssignParsedValueOf:[ self visit:node child ] |
167 self startMethodForNode: tokenNode. |
36 to:self retvalVar. |
168 |
37 compiler codeAssign: 'false.' to: 'error'. |
|
38 compiler codeReturn. |
|
39 ! |
|
40 |
|
41 visitTokenNode: node |
|
42 | id startVar endVar | |
|
43 "Tokens cannot be inlined, |
169 "Tokens cannot be inlined, |
44 - their result is true/false |
170 - their result is true/false |
45 - the return value is always stored in currentTokenValue |
171 - the return value is always stored in currentTokenValue |
46 - the current token type is always stored in currentTokenType |
172 - the current token type is always stored in currentTokenType |
47 " |
173 " |
48 self assert: node isMarkedForInline not. |
174 self assert: tokenNode isMarkedForInline not. |
49 |
175 |
50 startVar := compiler allocateTemporaryVariableNamed: 'start'. |
176 startVar := compiler allocateTemporaryVariableNamed: 'start'. |
51 endVar := compiler allocateTemporaryVariableNamed: 'end'. |
177 endVar := compiler allocateTemporaryVariableNamed: 'end'. |
52 |
178 |
53 id := compiler idFor: node. |
179 id := compiler idFor: tokenNode. |
54 self toTokenMode. |
180 numberId := compiler numberIdFor: id. |
55 |
181 |
56 compiler add: 'currentTokenType isNil ifFalse: [ ^ currentTokenType == ', id storeString, '].'. |
182 compiler add: 'currentTokenType isNil ifFalse: [ ^ currentTokenType == ', id storeString, '].'. |
|
183 |
|
184 " compiler codeComment: 'number for: ', id storeString, ' is: ', numberId storeString. |
|
185 compiler codeIf: 'scanner match: ', numberId storeString then: [ |
|
186 compiler codeAssign: '(scanner resultPosition: ', numberId storeString, ').' to: endVar. |
|
187 self createTokenInsance: tokenNode |
|
188 id: id storeString |
|
189 start: '(context position + 1)' |
|
190 end: endVar. |
|
191 |
|
192 compiler code: 'context position: ', endVar, '.'. |
|
193 |
|
194 self consumeWhitespace: tokenNode. |
|
195 compiler codeReturn: 'true'. |
|
196 ]. |
|
197 compiler codeIf: 'scanner backtracked not' then: [ |
|
198 compiler codeReturn: 'false'. |
|
199 ]. |
|
200 compiler codeComment: 'No match, no fail, scanner does not know about this...'. |
|
201 " |
57 compiler profileTokenRead: id. |
202 compiler profileTokenRead: id. |
58 |
203 |
59 node allNodes size > 2 ifTrue: [ |
204 " self scan: tokenNode start: startVar end: endVar." |
60 self addGuard: node ifTrue: nil ifFalse: [ compiler addOnLine: '^ false' ]. |
205 " compiler add: 'self assert: scanner isSingleMatch.'." |
61 ]. |
206 " compiler codeIf: 'scanner match ' then: [" |
62 |
207 |
63 |
208 tokenNode child hasName ifFalse: [ |
|
209 tokenNode child name: tokenNode name |
|
210 ]. |
|
211 |
64 compiler codeAssign: 'context position + 1.' to: startVar. |
212 compiler codeAssign: 'context position + 1.' to: startVar. |
65 compiler codeAssignParsedValueOf:[ self visit:node child ] to:#whatever. |
213 compiler codeIf: [ compiler code: ((self generateScan: tokenNode child) callOn: 'scanner') ] then: [ |
66 compiler add: 'error ifTrue: [ ^ error := false ].'. |
214 compiler add: 'context position: scanner resultPosition.'. |
67 |
215 compiler codeAssign: 'context position.' to: endVar. |
68 compiler codeAssign: 'context position.' to: endVar. |
216 self consumeWhitespace: tokenNode. |
69 |
217 self createTokenInsance: tokenNode id: id storeString start: startVar end: endVar. |
70 compiler codeTranscriptShow: 'current token type: ', id storeString. |
218 compiler codeReturn: 'true'. |
71 compiler codeAssign: id storeString, '.' to: 'currentTokenType'. |
219 ] else: [ |
72 compiler codeAssign: node tokenClass asString, ' on: (context collection) |
220 compiler code: 'scanner backtrackDistinct.'. |
73 start: ', startVar, ' |
221 compiler code: 'context position: ', startVar, ' - 1.'. |
74 stop: ', endVar, ' |
222 compiler codeReturn: 'false'. |
75 value: nil.' |
223 ]. |
76 to: 'currentTokenValue := ', self retvalVar. |
224 |
77 |
225 ^ self stopMethodForNode: tokenNode |
|
226 ! |
|
227 |
|
228 visitTokenConsumeNode: node |
|
229 | id nextScan | |
|
230 self startMethodForNode: node. |
|
231 id := (compiler idFor: node child). |
|
232 |
|
233 compiler add: 'self ', id asString, ' ifTrue: ['. |
|
234 compiler indent. |
|
235 |
|
236 nextScan := self generateNextScan: node. |
78 |
237 |
79 compiler codeClearError. |
238 node nextFsa hasDistinctRetvals ifTrue: [ |
80 compiler add: '^ true'. |
239 compiler codeAssign: 'currentTokenValue.' to: self retvalVar. |
81 |
240 |
82 self fromTokenMode. |
241 compiler add: (nextScan callOn: 'scanner'), '.'. |
|
242 compiler codeIf: 'scanner match' then: [ |
|
243 compiler add: 'context position: scanner resultPosition.'. |
|
244 self createTokenInsance: node child |
|
245 id: 'scanner result' |
|
246 start: 'scanner position + 1' |
|
247 end: 'scanner resultPosition'. |
|
248 self consumeWhitespace: node child. |
|
249 compiler codeReturn. |
|
250 ] else: [ |
|
251 compiler codeComment: 'Looks like there is an error on its way...'. |
|
252 compiler code: 'context position: scanner position.'. |
|
253 compiler codeAssign: 'nil.' to: 'currentTokenType'. |
|
254 compiler codeReturn. |
|
255 ] |
|
256 |
|
257 ] ifFalse: [ |
|
258 compiler codeAssign: 'nil.' to: 'currentTokenType'. |
|
259 compiler codeReturn: 'currentTokenValue'. |
|
260 ]. |
|
261 compiler dedent. |
|
262 |
|
263 "Token not found" |
|
264 compiler add: '] ifFalse: ['. |
|
265 compiler indent. |
|
266 compiler codeError: id asString, ' expected'. |
|
267 compiler dedent. |
|
268 compiler add: '].'. |
|
269 |
|
270 ^ self stopMethodForNode: node |
|
271 ! |
|
272 |
|
273 visitTokenNode: node |
|
274 ^ self visitToken: node |
83 ! |
275 ! |
84 |
276 |
85 visitTrimmingTokenCharacterNode: node |
277 visitTrimmingTokenCharacterNode: node |
86 | id | |
278 | id | |
|
279 self startMethodForNode:node. |
87 |
280 |
88 "Tokens cannot be inlined, |
281 "Tokens cannot be inlined, |
89 - their result is true/false |
282 - their result is true/false |
90 - the return value is always stored in currentTokenValue |
283 - the return value is always stored in currentTokenValue |
91 - the current token type is always stored in currentTokenType |
284 - the current token type is always stored in currentTokenType |
92 " |
285 " |
93 self assert: node isMarkedForInline not. |
286 self assert: node isMarkedForInline not. |
94 |
287 |
95 id := compiler idFor: node. |
288 id := compiler idFor: node. |
96 self toTokenMode. |
|
97 |
289 |
98 compiler add: 'currentTokenType isNil ifFalse: [ ^ currentTokenType == ', id storeString, '].'. |
290 compiler add: 'currentTokenType isNil ifFalse: [ ^ currentTokenType == ', id storeString, '].'. |
99 compiler profileTokenRead: id. |
291 compiler profileTokenRead: id. |
100 |
292 |
101 self addGuard: node ifTrue: nil ifFalse: [ compiler addOnLine: ' ^ false' ]. |
293 compiler add: '(context peek == ', node child character storeString, ') ifFalse: [ ^ false ].'. |
102 |
|
103 compiler add: 'context next.'. |
294 compiler add: 'context next.'. |
104 |
295 |
105 compiler codeTranscriptShow: 'current token type: ', id storeString. |
296 self createTokenInsance: node id: id storeString start: 'context position' end: 'context position'. |
106 compiler codeAssign: id storeString, '.' to: 'currentTokenType'. |
297 self consumeWhitespace: node. |
107 compiler codeAssign: node tokenClass asString, ' on: (context collection) |
298 |
108 start: context position |
299 compiler codeReturn: 'true'. |
109 stop: context position |
300 |
110 value: nil.' |
301 ^ self stopMethodForNode: node |
111 to: 'currentTokenValue := ', self retvalVar. |
|
112 |
|
113 compiler addComment: 'Consume Whitespace:'. |
|
114 compiler |
|
115 codeAssignParsedValueOf:[ self visit:node whitespace ] |
|
116 to:#whatever. |
|
117 compiler nl. |
|
118 |
|
119 compiler add: '^ true'. |
|
120 |
|
121 self fromTokenMode. |
|
122 ! |
302 ! |
123 |
303 |
124 visitTrimmingTokenNode: node |
304 visitTrimmingTokenNode: node |
125 | id startVar endVar | |
305 ^ self visitToken: node |
126 |
306 ! ! |
127 "Tokens cannot be inlined, |
307 |
128 - their result is true/false |
|
129 - the return value is always stored in currentTokenValue |
|
130 - the current token type is always stored in currentTokenType |
|
131 " |
|
132 self assert: node isMarkedForInline not. |
|
133 |
|
134 startVar := compiler allocateTemporaryVariableNamed: 'start'. |
|
135 endVar := compiler allocateTemporaryVariableNamed: 'end'. |
|
136 |
|
137 id := compiler idFor: node. |
|
138 self toTokenMode. |
|
139 |
|
140 compiler add: 'currentTokenType isNil ifFalse: [ ^ currentTokenType == ', id storeString, '].'. |
|
141 compiler profileTokenRead: id. |
|
142 |
|
143 node allNodes size > 2 ifTrue: [ |
|
144 self addGuard: node ifTrue: nil ifFalse: [ compiler addOnLine: '^ false' ]. |
|
145 ]. |
|
146 |
|
147 compiler codeAssign: 'context position + 1.' to: startVar. |
|
148 compiler codeAssignParsedValueOf:[ self visit:node child ] to:#whatever. |
|
149 |
|
150 compiler add: 'error ifTrue: [ ^ error := false ].'. |
|
151 |
|
152 compiler codeAssign: 'context position.' to: endVar. |
|
153 |
|
154 compiler addComment: 'Consume Whitespace:'. |
|
155 compiler |
|
156 codeAssignParsedValueOf:[ self visit:node whitespace ] |
|
157 to:#whatever. |
|
158 compiler nl. |
|
159 |
|
160 |
|
161 compiler codeTranscriptShow: 'current token type: ', id storeString. |
|
162 compiler codeAssign: id storeString, '.' to: 'currentTokenType'. |
|
163 compiler codeAssign: node tokenClass asString, ' on: (context collection) |
|
164 start: ', startVar, ' |
|
165 stop: ', endVar, ' |
|
166 value: nil.' |
|
167 to: 'currentTokenValue := ', self retvalVar. |
|
168 |
|
169 compiler codeClearError. |
|
170 compiler add: '^ true'. |
|
171 |
|
172 self fromTokenMode. |
|
173 ! ! |
|
174 |
|