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

"{ NameSpace: Smalltalk }"

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


!PPCTokenizingCodeGenerator methodsFor:'accessing'!

guards
    "When tokenizing, do not use guards"
    ^ false
!

tokenGenerator
    tokenGenerator isNil ifTrue: [ 
        tokenGenerator := PPCTokenCodeGenerator on: compiler.
        tokenGenerator arguments: arguments.
    ].
    ^ tokenGenerator
!

tokenGenerator: whatever
    tokenGenerator := whatever
!

tokenGuards
    "When tokenizing, do not use guards"
    ^ arguments guards
! !

!PPCTokenizingCodeGenerator methodsFor:'guards'!

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

    compiler add: 'self ', id asString.

    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
! !

!PPCTokenizingCodeGenerator methodsFor:'visiting'!

visitAndNode: node
    | mementoVar currentTokenVar |
    
    mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
    currentTokenVar := compiler allocateTemporaryVariableNamed: 'currentToken'.

    compiler smartRemember: node child to: mementoVar.
    compiler codeAssign: '{ currentTokenValue . currentTokenType }.' to: currentTokenVar.

    compiler 
          codeAssignParsedValueOf:[ self visit:node child ]
          to:self retvalVar.

    compiler smartRestore: node child from: mementoVar.
    compiler codeAssign: '(', currentTokenVar, ' at: 1).' to: 'currentTokenValue'.
    compiler codeAssign: '(', currentTokenVar, ' at: 2).' to: 'currentTokenType'.

    compiler codeReturn.
!

visitChoiceNode: node
"       true ifTrue: [ ^ super visitChoiceNode: node ]."
    | possibleError |
    possibleError := true.

    node children do: [ :child |
        | tokenMethodName |

        "TODO: JK: fix this in a proper way. Commented for now to make LRPParser cimpilable 
         with tokenizing"
        "child acceptsEpsilon"false ifTrue: [  
            possibleError := false.
            compiler codeAssignParsedValueOf:[ self visit:child ] to:self retvalVar.
            compiler codeReturn
        ] ifFalse: [
            child firstSetWithTokens do: [ :first |
                "For each child, for each first compile this:"
            
                tokenMethodName := compiler idFor: first.
                compiler add: '(self ', tokenMethodName asString, ')'.
                compiler addOnLine: ' ifTrue: ['.
                compiler indent.
                    compiler codeAssignParsedValueOf:[ self visit:child ] to:self retvalVar.
                    compiler add: 'error ifFalse: ['.
                    compiler indent.
                        compiler codeReturn: self retvalVar.
                    compiler dedent.
                    compiler add: '] ifTrue: ['.
                    compiler indent.
                        compiler codeClearError.
                        compiler codeAssign: 'nil.' to: 'currentTokenType'.
                        compiler add: 'context position: currentTokenValue start - 1.'.
                    compiler dedent.
                    compiler add: ']'.
                compiler dedent.
                compiler add: '].'
            ]
        ]
    ].
    possibleError ifTrue: [
        compiler codeError: 'no choice found'.
    ]

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

visitDeterministicChoiceNode: node
    | dictionary isInlined |
    dictionary := IdentityDictionary new.
    
    isInlined := node isMarkedForInline.
    
    node children do: [ :child |
        | firstSet |
        firstSet := child firstSetWithTokens.
        self assert: firstSet size = 1.
        dictionary at: child put: firstSet anyOne.
    ].
    "Tokens are unique"
    self assert: dictionary values asSet size = node children size.
    
    node children do: [ :child |
        | tokenMethodName |
        tokenMethodName := compiler idFor: (dictionary at: child).
        compiler add: '(self ', tokenMethodName asString, ')'.
        compiler addOnLine: ' ifTrue: ['.
        compiler indent.
        compiler codeReturnParsedValueOf:[ self visit:child ].
        compiler dedent.
        isInlined ifTrue:[
            compiler add: '] ifFalse: ['
        ] ifFalse:[
            compiler add: '].'.
        ]
    ].
    compiler codeError: 'no choice found'.
    isInlined ifTrue:[
        node children size timesRepeat: [ compiler addOnLine: ']' ].
        compiler addOnLine: '.'.
    ]

    "Modified: / 21-05-2015 / 15:31:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

visitTokenChoiceNode: node
    | trimmingToken |
    self assert: (node children allSatisfy: [ :e | e isMarkedForInline not ]).
    
    node children do: [ :child |
        self tokenGenerator visit: child
    ]
    
"	
    trimmingToken := node children detect: [ :e | e isTrimmingTokenNode ] ifNone: [ nil ].
    trimmingToken isNil ifFalse: [ 
        compiler codeStoreValueOf: [ self visit: trimmingToken whitespace ] intoVariable: #whatever.
    ].
    super visitChoiceNode: node."
!

visitTokenConsumeNode: node
    | id |
    id := (compiler idFor: node child).
    compiler add: 'self ', id asString, ' ifTrue: ['.
        compiler indent.
        compiler codeAssign: 'nil.' to: 'currentTokenType'.
        compiler codeReturn: 'currentTokenValue'.
        compiler dedent.
    compiler add: '] ifFalse: ['.
    compiler indent.
    compiler codeError: id asString, ' expected'.
    compiler dedent.
    compiler add: '].'.

"
    compiler codeReturn: 'self consume: ', (compiler idFor: node child) storeString, '.'
"
!

visitTokenNode: node
    self error: 'shoudl not happend!!'
!

visitTokenizingParserNode: node
    self visit: node tokenizer.
    self visit: node whitespace.
    
    compiler codeHaltIfShiftPressed.
    compiler 
          codeAssignParsedValueOf:[ self visit:node parser ]
          to:self retvalVar.
    compiler codeReturn.
!

visitTrimmingTokenNode: node
    self error: 'shoudl not happend!!'
! !

!PPCTokenizingCodeGenerator class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'
! !