compiler/PPCCodeGenerator.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Thu, 21 May 2015 14:12:22 +0100
changeset 464 f6d77fee9811
parent 459 4751c407bb40
child 465 f729f6cd3c76
child 502 1e45d3c96ec5
permissions -rw-r--r--
Updated to PetitCompiler-JanKurs.118, PetitCompiler-Tests-JanKurs.46, PetitCompiler-Extras-Tests-JanKurs.11, and PetitCompiler-Benchmarks-JanKurs.11 Name: PetitCompiler-JanKurs.118 Author: JanKurs Time: 13-05-2015, 03:59:01.292 PM UUID: 4a8ccd94-3131-4cc7-9098-528f8e5ea0b5 Name: PetitCompiler-Tests-JanKurs.46 Author: JanKurs Time: 04-05-2015, 04:25:06.162 PM UUID: 9f4cf8b7-876e-4a13-9579-b833f016db66 Name: PetitCompiler-Extras-Tests-JanKurs.11 Author: JanKurs Time: 13-05-2015, 04:27:27.940 PM UUID: e9f30c31-fbd0-4e96-ad2a-868f88d20ea8 Name: PetitCompiler-Benchmarks-JanKurs.11 Author: JanKurs Time: 13-05-2015, 02:21:49.932 PM UUID: 6a23fd1e-a86f-46db-8221-cc41b778d32c

"{ Package: 'stx:goodies/petitparser/compiler' }"

"{ NameSpace: Smalltalk }"

PPCNodeVisitor subclass:#PPCCodeGenerator
	instanceVariableNames:'compiler'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Visitors'
!

!PPCCodeGenerator class methodsFor:'as yet unclassified'!

new
    ^ self basicNew
        initialize;
        yourself 
!

on: aPPCCompiler
    ^ self new 
        compiler: aPPCCompiler;
        yourself
! !

!PPCCodeGenerator methodsFor:'accessing'!

compiler: aPPCCompiler
    compiler := aPPCCompiler 
!

guards
    ^ arguments guards
! !

!PPCCodeGenerator methodsFor:'guards'!

addGuard: node ifTrue: trueBlock ifFalse: falseBlock
    |  guard id |
    (self guards not or: [(guard := PPCGuard on: node) makesSense not]) ifTrue: [ ^ false].
    id := compiler idFor: node.

"	falseBlock isNil ifFalse: [ 
        compiler add: 'context atEnd'.
        compiler addOnLine: ' ifTrue: ['.
        compiler indent.
        falseBlock value.
        compiler dedent.
        compiler addOnLine: '].'.
    ]."
    
    guard id: (compiler idFor: guard prefixed: #guard).
    guard compileGuard: compiler.

    trueBlock isNil ifFalse: [ 
        compiler addOnLine: ' ifTrue: ['.
        compiler indent.
        trueBlock value.
        compiler dedent.
        falseBlock isNil 	ifTrue: [ compiler addOnLine: '].' ]
                              	ifFalse: [ compiler add: ']'. ]
    ].
    falseBlock isNil ifFalse: [ 
        compiler addOnLine: ' ifFalse: ['.
        compiler indent.
        falseBlock value.
        compiler dedent.
        compiler addOnLine: '].'.
    ].
    ^ true
!

addGuardTrimming: node
    |  guard firsts id |
    (self guards not or: [(guard := PPCGuard on: node) makesSense not]) ifTrue: [ ^ false].

    id := compiler idFor: node.
    firsts := node firstSetWithTokens.

    
    (firsts allSatisfy: [ :e | e isTrimmingTokenNode ]) ifTrue: [  
        "If we start with trimming, we should invoke the whitespace parser"
        self compileTokenWhitespace: firsts anyOne.
        ^ true
    ].
    ^ false
! !

!PPCCodeGenerator methodsFor:'hooks'!

afterAccept: node retval: retval
    "return the method from compiler"
    ^ self stopMethodForNode: node.
!

beforeAccept: node
    self startMethodForNode: node
!

closedDetected: node
    ^ node isMarkedForInline ifFalse: [ 
        self error: 'Should not happen!!'
    ]
!

openDetected: node
    ^ compiler checkCache: (compiler idFor: node)
! !

!PPCCodeGenerator methodsFor:'support'!

compileTokenWhitespace: node
    compiler add: 'context atWs ifFalse: ['.
    compiler indent.
        compiler codeStoreValueOf: [ self visit: node whitespace ] intoVariable: #whatever.
        compiler add: 'context setWs.'.
    compiler dedent.
    compiler add: '].'.
!

notCharSetPredicateBody: node
    | classificationId  classification |
    self error: 'deprecated.'.
    classification := node extendClassification: node predicate classification.
    classificationId := (compiler idFor: classification prefixed: #classification).
    compiler  addConstant: classification as: classificationId.
    
    compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.
    compiler indent.
    compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.
    compiler add: ' ifFalse: [ nil ].'.
    compiler dedent.
!

notMessagePredicateBody: node
    self error: 'deprecated'.
    compiler addOnLine: '(context peek ', node message, ')'.
    compiler indent.
    compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.
    compiler add: ' ifFalse: [ nil ].'.
    compiler dedent.
!

predicateBody: node
    | tmpId |
    self error:'deprecated'.
    tmpId := (compiler idFor: node predicate prefixed: #predicate).
    compiler addConstant: node predicate as: tmpId.

    compiler addOnLine: '(context atEnd not and: [ ', tmpId , ' value: context uncheckedPeek])'.
    compiler indent.
    compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'.
    compiler add: 'ifTrue: [ context next ].'.
    compiler dedent.	
!

retvalVar
    ^ compiler currentReturnVariable 
!

startMethodForNode:node
    node isMarkedForInline ifTrue:[ 
		compiler startInline: (compiler idFor: node).
		compiler addComment: 'BEGIN inlined code of ' , node printString.
		compiler indent.
    ] ifFalse:[ 
		compiler startMethod: (compiler idFor: node).
		compiler addComment: 'GENERATED by ' , node printString.
		compiler allocateReturnVariable.
    ].

    "Created: / 23-04-2015 / 15:51:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 23-04-2015 / 19:13:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (comment): / 23-04-2015 / 21:31:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

stopMethodForNode:aPPCNode
    ^ aPPCNode isMarkedForInline ifTrue:[ 
		compiler dedent.
		compiler add: '"END inlined code of ' , aPPCNode printString , '"'.
		compiler stopInline.
    ] ifFalse:[ 
		compiler stopMethod
    ].

    "Created: / 23-04-2015 / 15:51:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 23-04-2015 / 18:35:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PPCCodeGenerator methodsFor:'traversing - caching'!

cache: node value: retval
    "this is compiler thing, not mine"
!

cachedDetected: node
    ^ compiler checkCache: (compiler idFor: node)
!

isCached: node
    ^ (compiler checkCache: (compiler idFor: node)) isNil not
! !

!PPCCodeGenerator methodsFor:'visiting'!

visitActionNode: node
    | blockId |

    blockId := 'block_', (compiler idFor: node).
    compiler addConstant: node block as: blockId.
        
    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
    compiler add: 'error ifFalse: ['.
    compiler codeReturn: blockId, ' value: ', self retvalVar.
    compiler add: '] ifTrue: ['.
    compiler codeReturn: 'failure'.
    compiler add: '].'.

    "Modified: / 23-04-2015 / 15:59:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

visitAndNode: node
    | mementoVar |
    
    mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
    compiler smartRemember: node child to: mementoVar.

    compiler codeStoreValueOf: [ self visit: node child  ] intoVariable: self retvalVar.
    compiler smartRestore: node child from: mementoVar.

    compiler codeReturn.

    "Modified: / 23-04-2015 / 15:59:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

visitAnyNode: node

    compiler codeReturn: 'context next ifNil: [ error := true. ].'.

    "Modified: / 23-04-2015 / 20:52:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

visitCharSetPredicateNode: node

    | classification classificationId |
    classification := node extendClassification: node predicate classification.
    classificationId := compiler idFor: classification prefixed: #classification.
    compiler addConstant: classification as: classificationId.
    
    compiler add: '(', classificationId, ' at: context peek asInteger)'.
    compiler indent.
    compiler add: 'ifFalse: ['.
    compiler codeError: 'predicate not found'.
    compiler add: '] ifTrue: [ '.
    compiler codeReturn: 'context next'.
    compiler add: '].'.
    compiler dedent.
!

visitCharacterNode: node
    | chid |
    node character ppcPrintable ifTrue: [ 
        chid := node character storeString 
    ] ifFalse: [ 
        chid := compiler idFor: node character prefixed: #char.
        compiler addConstant: (Character value: node character asInteger) as: chid .
    ].
    
    compiler add: '(context peek == ', chid, ')'.
    compiler indent.
    compiler add: 'ifFalse: ['.
    compiler indent.
    compiler codeError: node character asInteger asString, ' expected'.
    compiler dedent.
    compiler add: '] ifTrue: [ '.
    compiler indent.
    compiler codeReturn: 'context next'.
    compiler dedent.
    compiler add: '].'.
    compiler dedent.
!

visitChild: child of: node
    |  |

    (self isOpen: child) ifTrue: [ 
        "already processing..."
        ^ nil
    ].

    ^ self visit: child.
!

visitChoiceNode: node
    |  whitespaceConsumed elementVar |
    "The code is not ready for inlining"
    self assert: node isMarkedForInline not.
    

    elementVar := compiler allocateTemporaryVariableNamed: 'element'.
    whitespaceConsumed :=	 self addGuardTrimming: node.

    1 to: node children size do: [ :idx  | |child allowGuard |
        child := node children at: idx.
        allowGuard := whitespaceConsumed.

        allowGuard ifTrue: [ 
            self addGuard: child ifTrue: [ 
                compiler add: 'self clearError.'.
                compiler codeStoreValueOf:  [self visit: child] intoVariable: elementVar.
                compiler add: 'error ifFalse: [ ^ ', elementVar, ' ].'.
            ] ifFalse: nil.
        ] ifFalse: [ 
                compiler add: 'self clearError.'.
                compiler codeStoreValueOf:  [self visit: child] intoVariable: elementVar.
                compiler add: 'error ifFalse: [ ^ ', elementVar, ' ].'.
        ]
    ].
    compiler codeError: 'no choice suitable'.

    "Modified: / 23-04-2015 / 21:40:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

visitEndOfFileNode: node
    compiler codeReturn: 'context atEnd ifTrue: [ #EOF ] ifFalse: [ self error: ''EOF expected!!'' ].'.
!

visitEndOfInputNode: node

    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
    compiler add: 'context atEnd ifTrue: ['.
    compiler codeReturn.	
    compiler add: '] ifFalse: ['.
    compiler codeError: 'End of input expected'.
    compiler add: ']'.
!

visitForwardNode: node

    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
    compiler codeReturn.
!

visitLiteralNode: node
    | positionVar encodedLiteral |
    encodedLiteral := node encodeQuotes: node literal.
    positionVar := compiler allocateTemporaryVariableNamed: 'position'.

    compiler codeAssign: 'context position.' to: positionVar.
    compiler add: '((context next: ', node literal size asString, ') = #''', encodedLiteral, ''') ifTrue: ['.
    compiler codeReturn: '#''', encodedLiteral, ''' '.
    compiler add: '] ifFalse: ['.
    compiler indent.
        compiler add: 'context position: ', positionVar, '.'.
        compiler codeError: encodedLiteral,  ' expected' at: positionVar.
    compiler dedent.
    compiler add: '].'.
!

visitMessagePredicateNode: node
    compiler add: '(context peek ', node message, ') ifFalse: ['.
    compiler codeError: 'predicate not found'.
    compiler add: '] ifTrue: [ '.
    compiler codeReturn: ' context next'.
    compiler add: '].'.

    "Modified: / 23-04-2015 / 18:39:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

visitNilNode: node

    compiler codeReturn: 'nil.'.
!

visitNotCharSetPredicateNode: node
    | classificationId  classification |
    classification := node extendClassification: node predicate classification.
    classificationId := (compiler idFor: classification prefixed: #classification).
    compiler  addConstant: classification as: classificationId.
    
    compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.
    compiler indent.
    compiler add: ' ifTrue: ['.
    compiler codeError: 'predicate not expected'.
    compiler add: '] ifFalse: ['.
    compiler codeReturn: 'nil'.
    compiler add: '].'.
    compiler dedent.
!

visitNotCharacterNode: node
    | chid |
    node character ppcPrintable ifTrue: [ 
        chid := node character storeString 
    ] ifFalse: [ 
        chid := compiler idFor: node character prefixed: #char.
        compiler addConstant: (Character value: node character asInteger) as: chid .
    ].
    
    compiler add: '(context peek == ', chid, ')'.
    compiler indent.
    compiler add: 'ifTrue: ['.
    compiler indent.
    compiler codeError: node character asInteger asString, ' not expected'.
    compiler dedent.
    compiler add: '] ifFalse: [ '.
    compiler indent.
    compiler codeReturn: 'nil.'.
    compiler dedent.
    compiler add: '].'.
    compiler dedent.
!

visitNotLiteralNode: node
    | encodedLiteral size |
    encodedLiteral := node encodeQuotes: node literal.
    size := node literal size asString.
    
    compiler add: '((context peek: ', size, ') =#''', encodedLiteral, ''')'.
    compiler indent.
    compiler add: 'ifTrue: ['.
    compiler codeError: encodedLiteral, ' not expected'.
    compiler add: '] ifFalse: [ '.
    compiler codeReturn: 'nil' .
    compiler add: '].'.
    compiler dedent.
!

visitNotMessagePredicateNode: node
    compiler addOnLine: '(context peek ', node message, ')'.
    compiler indent.
    compiler add: ' ifTrue: [ '.
    compiler codeError: 'predicate not expected'.
    compiler add: '] ifFalse: ['.
    compiler codeReturn: 'nil'.
    compiler add: ' ].'.
    compiler dedent. 
!

visitNotNode: node
    | mementoVar |

    mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
    compiler smartRemember: node child to: mementoVar.
    
    compiler codeStoreValueOf: [ self visit: node child  ] intoVariable: #whatever.
    compiler smartRestore: node child from: mementoVar.

    compiler add: '^ error ifFalse: [ self error ] ifTrue: [ self clearError. nil ]'.

    "Modified: / 05-05-2015 / 14:29:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

visitOptionalNode: node
    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
    compiler add: 'error ifTrue: [ '.
    compiler indent.
    compiler add: 'self clearError. '.
    compiler codeAssign: 'nil.' to: self retvalVar.
    compiler dedent.
    compiler add: '].'.
    compiler codeReturn.
!

visitPluggableNode: node
    | blockId |
    blockId := compiler idFor: node block prefixed: #block.
    
    compiler addConstant: node block as: blockId.
    compiler codeReturn: blockId, ' value: context.'.
!

visitPlusNode: node
    | elementVar  |
                
    elementVar := compiler allocateTemporaryVariableNamed:  'element'.
     
"	self tokenGuards ifTrue: [ 
        compiler codeTokenGuard: node ifFalse: [ compiler codeError: 'at least one occurence expected' ].   
    ].
"        
    compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.

    compiler add: 'error ifTrue: ['.
    compiler codeError: 'at least one occurence expected'.
    compiler add: '] ifFalse: ['.
    compiler indent.
        compiler add: self retvalVar , ' add: ',elementVar , '.'.
            
        compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
        compiler add: '[ error ] whileFalse: ['.
        compiler indent.
        compiler add: self retvalVar , ' add: ',elementVar , '.'.
        compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
        compiler dedent.
        compiler add: '].'.
        compiler add: 'self clearError.'.
        compiler codeReturn: self retvalVar , ' asArray.'.         
    compiler dedent.
    compiler add: '].'.

    "Modified (comment): / 23-04-2015 / 21:30:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

visitPredicateNode: node
    | pid |
    pid := (compiler idFor: node predicate prefixed: #predicate).

    compiler addConstant: node predicate as: pid.

    compiler add: '(context atEnd not and: [ ', pid , ' value: context uncheckedPeek])'.
    compiler indent.
    compiler add: 'ifFalse: ['.
    compiler codeError: 'predicate not found'.
    compiler add: '] ifTrue: [ ', self retvalVar ,' := context next ].'.
    compiler dedent.   
    compiler codeReturn.

    "Modified: / 23-04-2015 / 21:48:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

visitRecognizingSequenceNode: node
    | mementoVar canBacktrack |

    canBacktrack := (node children allButFirst allSatisfy: [:e | e acceptsEpsilon ]) not.

    canBacktrack ifTrue: [ 
        mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.			
        compiler smartRemember: node to: mementoVar.
    ].

    compiler codeStoreValueOf: [ self visit: (node children at: 1) ] intoVariable: #whatever.
    compiler add: 'error ifTrue: [ ^ failure ].'.

    2 to: (node children size) do: [ :idx  | |child|
        child := node children at: idx.
        compiler codeStoreValueOf: [ self visit: child ] intoVariable: #whatever.
        
        child acceptsEpsilon ifFalse: [   
            compiler add: 'error ifTrue: [ '.
            compiler indent.
            compiler smartRestore: node from: mementoVar.
            compiler add: ' ^ failure .'.
            compiler dedent.
            compiler add: '].'.
        ].
    ].
!

visitSequenceNode: node

    | elementVar mementoVar canBacktrack |

    elementVar := compiler allocateTemporaryVariableNamed: 'element'.
    canBacktrack := (node children allButFirst allSatisfy: [:e | e acceptsEpsilon ]) not.

"	self addGuardTrimming: node.
    self addGuard: node ifTrue: nil ifFalse: [ compiler addOnLine: ' ^ self error' ].
"
    canBacktrack ifTrue: [ 
        mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
        compiler smartRemember: node to: mementoVar.
    ].
    
    compiler codeAssign: 'Array new: ', node children size asString, '.' to: self retvalVar.

    compiler codeStoreValueOf: [ self visit: (node children at: 1)]  intoVariable: elementVar.
    compiler add: 'error ifTrue: [ ^ failure ].'.
    compiler add: self retvalVar , ' at: 1 put: ', elementVar, '.'.
    
    2 to: (node children size) do: [ :idx  | |child|
        child := node children at: idx.
        compiler codeStoreValueOf: [ self visit: child ]  intoVariable: elementVar.
      
        child acceptsEpsilon ifFalse: [   
            compiler add: 'error ifTrue: [ '.
            compiler indent.
            compiler smartRestore: node from: mementoVar.
            compiler add: '^ failure.'.
            compiler dedent.
            compiler add: '].'.
        ].
        compiler add: self retvalVar , ' at: ', idx asString, ' put: ',elementVar,'.'.
    ].
    compiler codeReturn

    "Modified: / 23-04-2015 / 22:03:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

visitStarAnyNode: node
    | retvalVar sizeVar |

    retvalVar := compiler allocateReturnVariable.
    sizeVar := compiler allocateTemporaryVariableNamed: 'size'.  
    compiler add: sizeVar , ' := context size - context position.'.
    compiler add: retvalVar,' := Array new: ',sizeVar,'.'.
    compiler add: '(1 to: ',sizeVar,') do: [ :e | ',retvalVar,' at: e put: context next ].'.
    compiler codeReturn.
    
    "Modified: / 05-05-2015 / 14:13:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

visitStarCharSetPredicateNode: node
    | classification classificationId |
    

    classification := node extendClassification: node predicate classification.
    classificationId := compiler idFor: classification prefixed: #classification.
    compiler addConstant: classification as: classificationId.
    
    compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.	
    compiler add: '[ ', classificationId, ' at: context peek asInteger ] whileTrue: ['.
    compiler indent.
    compiler codeEvaluate: 'add:' argument: 'context next.' on: self retvalVar.
    compiler dedent.
    compiler add: '].'.
    compiler codeAssign: self retvalVar, ' asArray.' to: self retvalVar.
   compiler codeReturn.
!

visitStarMessagePredicateNode: node

    compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.	
    compiler add: '[ context peek ', node message, ' ] whileTrue: ['.
    compiler indent.
    compiler codeEvaluate: 'add:' argument: 'context next.' on: self retvalVar.
    compiler dedent.
    compiler add: '].'.
    compiler codeAssign: self retvalVar, ' asArray.' to: self retvalVar.
   compiler codeReturn.
!

visitStarNode: node
    | elementVar |
    
    elementVar := compiler allocateTemporaryVariableNamed: 'element'.

    self addGuard: node child ifTrue: nil ifFalse: [ compiler codeReturn: '#()' ].

    compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
    compiler add: '[ error ] whileFalse: ['.
    compiler indent.
    compiler add: self retvalVar, ' add: ', elementVar, '.'.
    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
    compiler dedent.
    compiler add: '].'.
    compiler codeClearError.
    compiler codeReturn: self retvalVar, ' asArray.'.
!

visitSymbolActionNode: node
    | elementVar |
    
    elementVar := compiler allocateTemporaryVariableNamed: 'element'.	
    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
    compiler add: 'error ifFalse: [ '.
    compiler codeReturn: elementVar, ' ', node block asString, '.'.
    compiler add: '] ifTrue: ['.
    compiler codeReturn: 'failure'.
    compiler add: ']'.
!

visitTokenActionNode: node
    "
        Actually, do nothing, we are in Token mode and the 
        child does not return any result and token takes only
        the input value.
    "	

    compiler add: '^ '.
    compiler callOnLine: (node child compileWith: compiler).
!

visitTokenNode: node
    | startVar endVar |
    startVar := compiler allocateTemporaryVariableNamed: 'start'.
    endVar := compiler allocateTemporaryVariableNamed: 'end'.
    
    compiler profileTokenRead: (compiler idFor: node).
    
    compiler codeAssign: 'context position + 1.' to: startVar.
    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
    compiler add: 'error ifFalse: [ '.
    compiler indent.	
    compiler codeAssign: 'context position.' to: endVar.
    
    compiler codeReturn: node tokenClass asString, ' on: (context collection) 
                                                                start: ', startVar, '  
                                                                stop: ', endVar, '
                                                                value: nil.'.
    compiler dedent.
    compiler add: '].'.
!

visitTokenStarMessagePredicateNode: node

    compiler add: '[ context peek ', node message,' ] whileTrue: ['.
    compiler indent.
    compiler add: 'context next'.
    compiler indent.
    compiler dedent.
    compiler add: '].'.
!

visitTokenStarSeparatorNode: node

    compiler add: 'context skipSeparators.'.
!

visitTokenWhitespaceNode: node
    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
    compiler codeReturn.
!

visitTrimNode: node
    | mementoVar |
    "TODO: This ignores the TrimmingParser trimmer object!!"

    mementoVar := compiler allocateTemporaryVariableNamed:  'memento'.

    compiler smartRemember: node child to: mementoVar.
    compiler add: 'context skipSeparators.'.

    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
    
    compiler add: 'error ifTrue: [ '.
    compiler indent.
        compiler smartRestore: node child from: mementoVar.
        compiler codeReturn.
    compiler dedent.
    compiler add: '] ifFalse: ['	.
        compiler indent.
        compiler add: 'context skipSeparators.'.
        compiler codeReturn.
        compiler dedent.
    compiler add: '].'.
!

visitTrimmingTokenCharacterNode: node
    ^ self visitTrimmingTokenNode: node
!

visitTrimmingTokenNode: node
    |  id guard startVar endVar |

    startVar := compiler allocateTemporaryVariableNamed: 'start'.
    endVar := compiler allocateTemporaryVariableNamed:  'end'.
    
    id := compiler idFor: node.
    compiler profileTokenRead: id.
    
    self compileTokenWhitespace: node.

    (arguments guards and: [(guard := PPCGuard on: node) makesSense]) ifTrue: [ 
        guard id: id, '_guard'.
        compiler add: 'context atEnd ifTrue: [ self error ].'.
        guard compileGuard: compiler.
        compiler addOnLine: 'ifFalse: [ self error ].'.
        compiler add: 'error ifFalse: ['.
        compiler indent.
    ].

    compiler codeAssign: 'context position + 1.' to: startVar.
    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.

    (arguments guards and: [(guard := PPCGuard on: node) makesSense]) ifTrue: [ 
        compiler dedent.
        compiler add: '].'.
    ].

    compiler add: 'error ifFalse: [ '.
    compiler indent.	
    compiler codeAssign: 'context position.' to: endVar.
    
"	self compileSecondWhitespace: compiler."
    self compileTokenWhitespace: node.

    compiler codeReturn: node tokenClass asString, ' on: (context collection) 
                                                                start: ', startVar, ' 
                                                                stop: ', endVar, '
                                                                value: nil'.
    compiler dedent.																
    compiler add: '].'
!

visitUnknownNode: node
    | compiledChild compiledParser id |

    id := compiler idFor: node.
    
    compiledParser := node parser copy.
    "Compile all the children and call compiled version of them instead of the original one"
    compiledParser children do: [ :child | 
        compiledChild := self visit: child.
        compiledParser replace: child with: compiledChild bridge.
    ].
    
    compiler addConstant: compiledParser as: id. 
    
    compiler codeClearError.
    compiler add: '(', self retvalVar, ' := ', id, ' parseOn: context) isPetitFailure'.
    compiler indent.
    compiler add: ' ifTrue: [self error: retval message at: ', self retvalVar, ' position ].'.
    compiler dedent.
    compiler add: 'error := ', self retvalVar, ' isPetitFailure.'.
    compiler codeReturn.
! !