--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCFSAVisitor.st	Mon Aug 24 15:34:14 2015 +0100
@@ -0,0 +1,113 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCNodeVisitor subclass:#PPCFSAVisitor
+	instanceVariableNames:'fsaCache idGen'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Visitors'
+!
+
+!PPCFSAVisitor methodsFor:'accessing'!
+
+idGen: anObject
+    idGen := anObject
+! !
+
+!PPCFSAVisitor methodsFor:'as yet unclassified'!
+
+unorderedChoiceFromFollowSet: followSet
+    | followFsas  |
+    
+    ^ fsaCache at: followSet ifAbsentPut: [ 
+        followFsas := followSet collect: [ :followNode | 
+            followNode asFsa 
+                name: (idGen idFor: followNode);
+                retval: (idGen idFor: followNode); 
+                yourself
+        ].
+        self unorderedChoiceFromFsas: followFsas.
+    ]
+     
+!
+
+unorderedChoiceFromFsas: fsas
+    | result startState |
+    result := PEGFsa new.
+    startState := PEGFsaState new.
+    
+    result addState: startState.
+    result startState: startState.
+
+    fsas do: [ :fsa | 
+        result adopt: fsa.
+        result addTransitionFrom: startState to: fsa startState.
+    ].
+
+    result determinizeStandard.
+    ^ result
+!
+
+visitToken: tokenNode
+    | anFsa |
+
+    anFsa := tokenNode asFsa determinize.
+    anFsa name: (idGen idFor: tokenNode).
+    anFsa retval: (idGen idFor: tokenNode).
+    
+    tokenNode fsa: anFsa.
+    ^ tokenNode
+!
+
+visitTokenConsumeNode: node
+    | epsilon anFsa followSet |
+    followSet := node followSetWithTokens.
+    
+    epsilon := followSet anySatisfy: [ :e | e acceptsEpsilon ].
+    followSet := followSet reject: [ :e | e acceptsEpsilon ].
+    epsilon ifTrue: [ followSet add: PPCEndOfFileNode instance ].
+    
+    anFsa := self unorderedChoiceFromFollowSet: followSet.
+    anFsa name: 'nextToken_', (idGen idFor: node).
+
+    node nextFsa: anFsa.
+!
+
+visitTokenNode: node
+    ^ self visitToken: node
+!
+
+visitTokenizingParserNode: node
+    "TODO JK: hack alert, change the handling of WS!!"
+    self visitWhitespace: node whitespace.
+
+    self visit: node tokens.
+    self visit: node parser.
+    ^ node
+!
+
+visitTrimmingTokenNode: node
+    ^ self visitToken: node
+!
+
+visitWhitespace: node
+    "JK HACK: treat ws as token -> create FSA for whitespace"
+    | retval |
+    retval := self visitToken: node.
+    "we don't care about the finals of whitespace"
+    node fsa removeFinals.
+    ^ retval
+! !
+
+!PPCFSAVisitor methodsFor:'initialization'!
+
+initialize
+    super initialize.
+    
+    "for the given set of nodes, remember the unordered choice fsa
+        see `unorderedChoiceFromFollowSet:`
+    "
+    fsaCache := Dictionary new.
+! !
+