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

        child acceptsEpsilon ifTrue: [  

            possibleError := false.

            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 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: / 10-05-2015 / 07:37:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitDeterministicChoiceNode: node

    | dictionary |

    dictionary := IdentityDictionary new.

    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 codeReturn: self retvalVar.

        compiler dedent.

        compiler add: '] ifFalse:['

    ].

    compiler codeError: 'no choice found'.

    node children size timesRepeat: [ compiler add: ']' ].

    compiler add: '.'.

    "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 codeReturn.

!

visitTrimmingTokenNode: node

    self error: 'shoudl not happend!!'

! !

!PPCTokenizingCodeGenerator class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'

! !