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