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

"{ NameSpace: Smalltalk }"

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

!PPCTokenCodeGenerator methodsFor:'as yet unclassified'!

afterAccept: node retval: retval
    | return |
    return := super afterAccept: node retval: retval.
    return category: 'generated - tokens'.
    ^ return
!

fromTokenMode
    compiler rememberStrategy: (PPCCompilerTokenizingRememberStrategy on: compiler).
    compiler errorStrategy: (PPCCompilerTokenizingErrorStrategy on: compiler).
!

toTokenMode
    compiler rememberStrategy: (PPCCompilerTokenRememberStrategy on: compiler).	
    compiler errorStrategy: (PPCCompilerTokenErrorStrategy on: compiler).
! !

!PPCTokenCodeGenerator methodsFor:'visiting'!

visitOptionalNode: node
    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
    compiler codeAssign: 'false.' to: 'error'.
    compiler codeReturn.
!

visitTokenNode: node
    | id startVar endVar  |
    "Tokens cannot be inlined, 
        - their result is true/false
        - the return value is always stored in currentTokenValue
        - the current token type is always stored in currentTokenType
    "
    self assert: node isMarkedForInline not.	
    
    startVar := compiler allocateTemporaryVariableNamed: 'start'.
    endVar := compiler allocateTemporaryVariableNamed: 'end'.

    id := compiler idFor: node.
    self toTokenMode.

    compiler add: 'currentTokenType isNil ifFalse: [ ^ currentTokenType == ', id storeString, '].'.	
    compiler profileTokenRead: id.
    
    node allNodes size > 2 ifTrue: [ 
        self addGuard: node ifTrue: nil  ifFalse: [ compiler addOnLine: '^ false' ].
    ].

    
    compiler codeAssign: 'context position + 1.' to: startVar.
    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
    compiler add: 'error ifTrue: [ ^ error := false ].'.

    compiler codeAssign: 'context position.' to: endVar.

    compiler codeTranscriptShow: 'current token type: ', id storeString.
    compiler codeAssign: id storeString, '.' to: 'currentTokenType'.
    compiler codeAssign: node tokenClass asString, ' on: (context collection) 
                                                                start: ', startVar, '  
                                                                stop: ', endVar, '
                                                                value: nil.'
                to: 'currentTokenValue := ', self retvalVar.
    
        
    compiler codeClearError.
    compiler add: '^ true'.

    self fromTokenMode.
!

visitTrimmingTokenCharacterNode: node
    |  id     |

    "Tokens cannot be inlined, 
        - their result is true/false
        - the return value is always stored in currentTokenValue
        - the current token type is always stored in currentTokenType
    "
    self assert: node isMarkedForInline not.
    
    id := compiler idFor: node.
    self toTokenMode.
    
    compiler add: 'currentTokenType isNil ifFalse: [ ^ currentTokenType == ', id storeString, '].'.
    compiler profileTokenRead: id.

    self addGuard: node ifTrue: nil ifFalse: [ compiler addOnLine: ' ^ false' ].

    compiler add: 'context next.'.

    compiler codeTranscriptShow: 'current token type: ', id storeString.
    compiler codeAssign: id storeString, '.' to: 'currentTokenType'.
    compiler codeAssign: node tokenClass asString, ' on: (context collection) 
                                                            start: context position 
                                                            stop: context position
                                                            value: nil.'
               to: 'currentTokenValue := ', self retvalVar.
    
    compiler addComment: 'Consume Whitespace:'.
    compiler codeStoreValueOf: [ self visit: node whitespace ] intoVariable: #whatever.
    compiler nl.
    
    compiler add: '^ true'.

    self fromTokenMode.
!

visitTrimmingTokenNode: node
    |  id  startVar endVar  |

    "Tokens cannot be inlined, 
        - their result is true/false
        - the return value is always stored in currentTokenValue
        - the current token type is always stored in currentTokenType
    "
    self assert: node isMarkedForInline not.
    
    startVar := compiler allocateTemporaryVariableNamed: 'start'.
    endVar := compiler allocateTemporaryVariableNamed:  'end'.
    
    id := compiler idFor: node.
    self toTokenMode.
    
    compiler add: 'currentTokenType isNil ifFalse: [ ^ currentTokenType == ', id storeString, '].'.
    compiler profileTokenRead: id.
    
    node allNodes size > 2 ifTrue: [ 
        self addGuard: node ifTrue: nil  ifFalse: [ compiler addOnLine: '^ false' ].
    ].

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

    compiler add: 'error ifTrue: [ ^ error := false ].'.

        compiler codeAssign: 'context position.' to: endVar.
    
        compiler addComment: 'Consume Whitespace:'.
        compiler codeStoreValueOf: [ self visit: node whitespace ] intoVariable: #whatever.
        compiler nl.
    
    
        compiler codeTranscriptShow: 'current token type: ', id storeString.
        compiler codeAssign: id storeString, '.' to: 'currentTokenType'.
        compiler codeAssign: node tokenClass asString, ' on: (context collection) 
                                                                start: ', startVar, ' 
                                                                stop: ', endVar, '
                                                                value: nil.'
                   to: 'currentTokenValue := ', self retvalVar.

    compiler codeClearError.
    compiler add: '^ true'.

    self fromTokenMode.
! !