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 |
12 !PPCTokenCodeGenerator methodsFor:'accessing'! |
13 !PPCTokenCodeGenerator methodsFor:'as yet unclassified'! |
13 |
14 |
14 arguments: args |
15 afterAccept: node retval: retval |
15 super arguments: args. |
16 | return | |
16 scannerGenerator arguments: args |
17 return := super afterAccept: node retval: retval. |
17 ! |
18 return category: 'generated - tokens'. |
18 |
19 ^ return |
19 compiler |
20 ! |
20 ^ compiler |
21 |
21 ! |
22 fromTokenMode |
22 |
23 compiler rememberStrategy: (PPCCompilerTokenizingRememberStrategy on: compiler). |
23 compiler: anObject |
24 compiler errorStrategy: (PPCCompilerTokenizingErrorStrategy on: compiler). |
24 compiler := anObject. |
25 ! |
25 |
26 |
26 scannerGenerator compiler idGen: compiler idGen. |
27 toTokenMode |
27 ! ! |
28 compiler rememberStrategy: (PPCCompilerTokenRememberStrategy on: compiler). |
28 |
29 compiler errorStrategy: (PPCCompilerTokenErrorStrategy on: compiler). |
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. |
30 ! ! |
161 ! ! |
31 |
162 |
32 !PPCTokenCodeGenerator methodsFor:'visiting'! |
163 !PPCTokenCodeGenerator methodsFor:'visiting'! |
33 |
164 |
34 visitOptionalNode: node |
165 visitToken: tokenNode |
35 compiler |
166 | id startVar endVar numberId | |
36 codeAssignParsedValueOf:[ self visit:node child ] |
167 self startMethodForNode: tokenNode. |
37 to:self retvalVar. |
168 |
38 compiler codeAssign: 'false.' to: 'error'. |
|
39 compiler codeReturn. |
|
40 ! |
|
41 |
|
42 visitTokenNode: node |
|
43 | id startVar endVar | |
|
44 "Tokens cannot be inlined, |
169 "Tokens cannot be inlined, |
45 - their result is true/false |
170 - their result is true/false |
46 - the return value is always stored in currentTokenValue |
171 - the return value is always stored in currentTokenValue |
47 - the current token type is always stored in currentTokenType |
172 - the current token type is always stored in currentTokenType |
48 " |
173 " |
49 self assert: node isMarkedForInline not. |
174 self assert: tokenNode isMarkedForInline not. |
50 |
175 |
51 startVar := compiler allocateTemporaryVariableNamed: 'start'. |
176 startVar := compiler allocateTemporaryVariableNamed: 'start'. |
52 endVar := compiler allocateTemporaryVariableNamed: 'end'. |
177 endVar := compiler allocateTemporaryVariableNamed: 'end'. |
53 |
178 |
54 id := compiler idFor: node. |
179 id := compiler idFor: tokenNode. |
55 self toTokenMode. |
180 numberId := compiler numberIdFor: id. |
56 |
181 |
57 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 " |
58 compiler profileTokenRead: id. |
202 compiler profileTokenRead: id. |
59 |
203 |
60 node allNodes size > 2 ifTrue: [ |
204 " self scan: tokenNode start: startVar end: endVar." |
61 self addGuard: node ifTrue: nil ifFalse: [ compiler addOnLine: '^ false' ]. |
205 " compiler add: 'self assert: scanner isSingleMatch.'." |
62 ]. |
206 " compiler codeIf: 'scanner match ' then: [" |
63 |
207 |
64 |
208 tokenNode child hasName ifFalse: [ |
|
209 tokenNode child name: tokenNode name |
|
210 ]. |
|
211 |
65 compiler codeAssign: 'context position + 1.' to: startVar. |
212 compiler codeAssign: 'context position + 1.' to: startVar. |
66 compiler codeAssignParsedValueOf:[ self visit:node child ] to:#whatever. |
213 compiler codeIf: [ compiler code: ((self generateScan: tokenNode child) callOn: 'scanner') ] then: [ |
67 compiler add: 'error ifTrue: [ ^ error := false ].'. |
214 compiler add: 'context position: scanner resultPosition.'. |
68 |
215 compiler codeAssign: 'context position.' to: endVar. |
69 compiler codeAssign: 'context position.' to: endVar. |
216 self consumeWhitespace: tokenNode. |
70 |
217 self createTokenInsance: tokenNode id: id storeString start: startVar end: endVar. |
71 compiler codeTranscriptShow: 'current token type: ', id storeString. |
218 compiler codeReturn: 'true'. |
72 compiler codeAssign: id storeString, '.' to: 'currentTokenType'. |
219 ] else: [ |
73 compiler codeAssign: node tokenClass asString, ' on: (context collection) |
220 compiler code: 'scanner backtrackDistinct.'. |
74 start: ', startVar, ' |
221 compiler code: 'context position: ', startVar, ' - 1.'. |
75 stop: ', endVar, ' |
222 compiler codeReturn: 'false'. |
76 value: nil.' |
223 ]. |
77 to: 'currentTokenValue := ', self retvalVar. |
224 |
78 |
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. |
79 |
237 |
80 compiler codeClearError. |
238 node nextFsa hasDistinctRetvals ifTrue: [ |
81 compiler add: '^ true'. |
239 compiler codeAssign: 'currentTokenValue.' to: self retvalVar. |
82 |
240 |
83 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 |
84 ! |
275 ! |
85 |
276 |
86 visitTrimmingTokenCharacterNode: node |
277 visitTrimmingTokenCharacterNode: node |
87 | id | |
278 | id | |
|
279 self startMethodForNode:node. |
88 |
280 |
89 "Tokens cannot be inlined, |
281 "Tokens cannot be inlined, |
90 - their result is true/false |
282 - their result is true/false |
91 - the return value is always stored in currentTokenValue |
283 - the return value is always stored in currentTokenValue |
92 - the current token type is always stored in currentTokenType |
284 - the current token type is always stored in currentTokenType |
93 " |
285 " |
94 self assert: node isMarkedForInline not. |
286 self assert: node isMarkedForInline not. |
95 |
287 |
96 id := compiler idFor: node. |
288 id := compiler idFor: node. |
97 self toTokenMode. |
|
98 |
289 |
99 compiler add: 'currentTokenType isNil ifFalse: [ ^ currentTokenType == ', id storeString, '].'. |
290 compiler add: 'currentTokenType isNil ifFalse: [ ^ currentTokenType == ', id storeString, '].'. |
100 compiler profileTokenRead: id. |
291 compiler profileTokenRead: id. |
101 |
292 |
102 self addGuard: node ifTrue: nil ifFalse: [ compiler addOnLine: ' ^ false' ]. |
293 compiler add: '(context peek == ', node child character storeString, ') ifFalse: [ ^ false ].'. |
103 |
|
104 compiler add: 'context next.'. |
294 compiler add: 'context next.'. |
105 |
295 |
106 compiler codeTranscriptShow: 'current token type: ', id storeString. |
296 self createTokenInsance: node id: id storeString start: 'context position' end: 'context position'. |
107 compiler codeAssign: id storeString, '.' to: 'currentTokenType'. |
297 self consumeWhitespace: node. |
108 compiler codeAssign: node tokenClass asString, ' on: (context collection) |
298 |
109 start: context position |
299 compiler codeReturn: 'true'. |
110 stop: context position |
300 |
111 value: nil.' |
301 ^ self stopMethodForNode: node |
112 to: 'currentTokenValue := ', self retvalVar. |
|
113 |
|
114 compiler addComment: 'Consume Whitespace:'. |
|
115 compiler |
|
116 codeAssignParsedValueOf:[ self visit:node whitespace ] |
|
117 to:#whatever. |
|
118 compiler nl. |
|
119 |
|
120 compiler add: '^ true'. |
|
121 |
|
122 self fromTokenMode. |
|
123 ! |
302 ! |
124 |
303 |
125 visitTrimmingTokenNode: node |
304 visitTrimmingTokenNode: node |
126 | id startVar endVar | |
305 ^ self visitToken: node |
127 |
306 ! ! |
128 "Tokens cannot be inlined, |
307 |
129 - their result is true/false |
|
130 - the return value is always stored in currentTokenValue |
|
131 - the current token type is always stored in currentTokenType |
|
132 " |
|
133 self assert: node isMarkedForInline not. |
|
134 |
|
135 startVar := compiler allocateTemporaryVariableNamed: 'start'. |
|
136 endVar := compiler allocateTemporaryVariableNamed: 'end'. |
|
137 |
|
138 id := compiler idFor: node. |
|
139 self toTokenMode. |
|
140 |
|
141 compiler add: 'currentTokenType isNil ifFalse: [ ^ currentTokenType == ', id storeString, '].'. |
|
142 compiler profileTokenRead: id. |
|
143 |
|
144 node allNodes size > 2 ifTrue: [ |
|
145 self addGuard: node ifTrue: nil ifFalse: [ compiler addOnLine: '^ false' ]. |
|
146 ]. |
|
147 |
|
148 compiler codeAssign: 'context position + 1.' to: startVar. |
|
149 compiler codeAssignParsedValueOf:[ self visit:node child ] to:#whatever. |
|
150 |
|
151 compiler add: 'error ifTrue: [ ^ error := false ].'. |
|
152 |
|
153 compiler codeAssign: 'context position.' to: endVar. |
|
154 |
|
155 compiler addComment: 'Consume Whitespace:'. |
|
156 compiler |
|
157 codeAssignParsedValueOf:[ self visit:node whitespace ] |
|
158 to:#whatever. |
|
159 compiler nl. |
|
160 |
|
161 |
|
162 compiler codeTranscriptShow: 'current token type: ', id storeString. |
|
163 compiler codeAssign: id storeString, '.' to: 'currentTokenType'. |
|
164 compiler codeAssign: node tokenClass asString, ' on: (context collection) |
|
165 start: ', startVar, ' |
|
166 stop: ', endVar, ' |
|
167 value: nil.' |
|
168 to: 'currentTokenValue := ', self retvalVar. |
|
169 |
|
170 compiler codeClearError. |
|
171 compiler add: '^ true'. |
|
172 |
|
173 self fromTokenMode. |
|
174 ! ! |
|
175 |
|
176 !PPCTokenCodeGenerator class methodsFor:'documentation'! |
|
177 |
|
178 version_HG |
|
179 |
|
180 ^ '$Changeset: <not expanded> $' |
|
181 ! ! |
|
182 |
|