"{ 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'.
! !