--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCTokenizingCodeGenerator.st	Thu Apr 30 23:43:14 2015 +0200
@@ -0,0 +1,62 @@
+"{ 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'.
+! !
+