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

"{ NameSpace: Smalltalk }"

PPCCodeGenerator subclass:#PPCTokenizingCodeGenerator

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Visitors'

!

!PPCTokenizingCodeGenerator methodsFor:'visiting'!

visitLLChoiceNode: node

	| dictionary currentTokenVar |

	dictionary := IdentityDictionary new.

	node children do: [ :child |

		| firstSet |

		firstSet := child firstSetSuchThat: [ :e | e isKindOf: PPCTokenNode ].

		self assert: firstSet size = 1.

		dictionary at: child 

			put: firstSet anyOne.

	].

	"Tokens are unique"

	self assert: dictionary values asSet size = node children size.

	compiler addConstant: (dictionary values collect: [ :e | compiler idFor: e ])

				as: #tokenMethods.

	currentTokenVar := compiler allocateTemporaryVariableNamed: 'currentToken'.

	compiler codeAssign: 'self currentTokenType.' to: currentTokenVar.

	node children do: [ :child |

		| tokenMethodName |

		tokenMethodName := compiler idFor: (dictionary at: child).

		compiler add: currentTokenVar , ' = ',  tokenMethodName storeString.

		compiler add: 'ifTrue: ['.

		compiler codeStoreValueOf: [ self visit: child ] intoVariable: self retvalVar.

		compiler codeReturn: self retvalVar.

		compiler add: '].'

	].

	compiler codeError: 'no choice found'.

!

visitTokenConsumeNode: node

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

!

visitTokenNode: node

	| tokenType |

	self assert: node isMarkedForInline.

	super visitTokenNode: node.

	tokenType := compiler idFor: node.

	compiler codeAssign: tokenType storeString, '.' to: 'currentTokenType'.

	compiler codeAssign: self retvalVar, '.' to: 'currentTokenValue'.

! !