"{ 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

!

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 |

            possibleError := false.

        ] 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'.

    ]

!

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

!

visitTokenNode: node

!

visitTokenizingParserNode: node

    self visit: node whitespace.

    compiler codeHaltIfShiftPressed.

    compiler 

          codeAssignParsedValueOf:[ self visit:node parser ]

          to:self retvalVar.

    compiler codeReturn.

!

visitTrimmingTokenNode: node

! !