Updated to PetitCompiler-JanVrany.135, PetitCompiler-Tests-JanKurs.93, PetitCompiler-Extras-Tests-JanVrany.16, PetitCompiler-Benchmarks-JanKurs.12
authorJan Vrany <jan.vrany@fit.cvut.cz>
Fri, 24 Jul 2015 15:06:54 +0100
changeset 502 1e45d3c96ec5
parent 464 f6d77fee9811
child 503 ff58cd9f1f3c
child 515 b5316ef15274
Updated to PetitCompiler-JanVrany.135, PetitCompiler-Tests-JanKurs.93, PetitCompiler-Extras-Tests-JanVrany.16, PetitCompiler-Benchmarks-JanKurs.12 Name: PetitCompiler-JanVrany.135 Author: JanVrany Time: 22-07-2015, 06:53:29.127 PM UUID: 890178b5-275d-46af-a2ad-1738998f07cb Ancestors: PetitCompiler-JanVrany.134 Name: PetitCompiler-Tests-JanKurs.93 Author: JanKurs Time: 20-07-2015, 11:30:10.283 PM UUID: 6473e671-ad70-42ca-b6c3-654b78edc531 Ancestors: PetitCompiler-Tests-JanKurs.92 Name: PetitCompiler-Extras-Tests-JanVrany.16 Author: JanVrany Time: 22-07-2015, 05:18:22.387 PM UUID: 8f6f9129-dbba-49b1-9402-038470742f98 Ancestors: PetitCompiler-Extras-Tests-JanKurs.15 Name: PetitCompiler-Benchmarks-JanKurs.12 Author: JanKurs Time: 06-07-2015, 02:10:06.901 PM UUID: cb24f1ac-46a4-494d-9780-64576f0f0dba Ancestors: PetitCompiler-Benchmarks-JanKurs.11, PetitCompiler-Benchmarks-JanVrany.e29bd90f388e.20150619081300
PPCompositeParser.st
PPDelegateParser.st
PPFlattenParser.st
PPSequenceParser.st
analyzer/bmake.bat
analyzer/mingwmake.bat
analyzer/tests/Make.proto
analyzer/tests/bc.mak
analyzer/tests/bmake.bat
analyzer/tests/mingwmake.bat
analyzer/tests/vcmake.bat
analyzer/vcmake.bat
bmake.bat
compiler/FooScanner.st
compiler/Make.proto
compiler/Make.spec
compiler/PEGFsa.st
compiler/PEGFsaFailure.st
compiler/PEGFsaGenerator.st
compiler/PEGFsaInterpret.st
compiler/PEGFsaPair.st
compiler/PEGFsaState.st
compiler/PEGFsaTransition.st
compiler/PPCArguments.st
compiler/PPCClassBuilder.st
compiler/PPCCodeBlock.st
compiler/PPCCodeGen.st
compiler/PPCCodeGenerator.st
compiler/PPCCompiler.st
compiler/PPCConfiguration.st
compiler/PPCContextMemento.st
compiler/PPCFSACodeGen.st
compiler/PPCInlinedMethod.st
compiler/PPCInliningVisitor.st
compiler/PPCMappedActionNode.st
compiler/PPCMethod.st
compiler/PPCNilNode.st
compiler/PPCNode.st
compiler/PPCNodeVisitor.st
compiler/PPCProfilingContext.st
compiler/PPCScanner.st
compiler/PPCScannerCodeGenerator.st
compiler/PPCSequenceNode.st
compiler/PPCSpecializingVisitor.st
compiler/PPCTokenCodeGenerator.st
compiler/PPCTokenizingCodeGenerator.st
compiler/PPCTokenizingVisitor.st
compiler/PPMappedActionParser.st
compiler/PPTokenizingCompiledParser.st
compiler/abbrev.stc
compiler/bc.mak
compiler/benchmarks/Make.proto
compiler/benchmarks/Make.spec
compiler/benchmarks/PPCBenchmark.st
compiler/benchmarks/PPCSmalltalkNoopParser.st
compiler/benchmarks/PPCSmalltalkNoopParserTests.st
compiler/benchmarks/abbrev.stc
compiler/benchmarks/bc.mak
compiler/benchmarks/bmake.bat
compiler/benchmarks/libInit.cc
compiler/benchmarks/mingwmake.bat
compiler/benchmarks/stx_goodies_petitparser_compiler_benchmarks.st
compiler/benchmarks/vcmake.bat
compiler/bmake.bat
compiler/extensions.st
compiler/libInit.cc
compiler/mingwmake.bat
compiler/stx_goodies_petitparser_compiler.st
compiler/tests/FooScannerTest.st
compiler/tests/Make.proto
compiler/tests/Make.spec
compiler/tests/PEGFsaDeterminizationTest.st
compiler/tests/PEGFsaGeneratorTest.st
compiler/tests/PEGFsaInterpretTest.st
compiler/tests/PEGFsaScannerIntegrationTest.st
compiler/tests/PEGFsaStateTest.st
compiler/tests/PEGFsaTest.st
compiler/tests/PEGFsaTransitionTest.st
compiler/tests/PPCClassBuilderTest.st
compiler/tests/PPCCodeGeneratorTest.st
compiler/tests/PPCScannerCodeGeneratorTest.st
compiler/tests/abbrev.stc
compiler/tests/bc.mak
compiler/tests/bmake.bat
compiler/tests/extras/Make.proto
compiler/tests/extras/PPCExpressionsVerificationTest.st
compiler/tests/extras/PPCompiledExpressionGrammarResource.st
compiler/tests/extras/PPCompiledJavaResource.st
compiler/tests/extras/PPCompiledJavaSyntaxTest.st
compiler/tests/extras/PPCompiledSmalltalkGrammarResource.st
compiler/tests/extras/PPCompiledSmalltalkParserResource.st
compiler/tests/extras/PPCompiledSmalltalkParserTests.st
compiler/tests/extras/PPLL1ExpressionGrammar.st
compiler/tests/extras/PPTokenizedExpressionGrammarResource.st
compiler/tests/extras/PPTokenizedLL1ExpressionGrammarResource.st
compiler/tests/extras/PPTokenizedSmalltalkGrammarResource.st
compiler/tests/extras/PPTokenizedSmalltalkParserResource.st
compiler/tests/extras/PPTokenizedSmalltalkParserTests.st
compiler/tests/extras/PPTokenizedSmalltalkParserVerificationTest.st
compiler/tests/extras/abbrev.stc
compiler/tests/extras/bc.mak
compiler/tests/extras/bmake.bat
compiler/tests/extras/mingwmake.bat
compiler/tests/extras/stx_goodies_petitparser_compiler_tests_extras.st
compiler/tests/extras/vcmake.bat
compiler/tests/libInit.cc
compiler/tests/mingwmake.bat
compiler/tests/stx_goodies_petitparser_compiler_tests.st
compiler/tests/vcmake.bat
compiler/vcmake.bat
islands/bmake.bat
islands/mingwmake.bat
islands/tests/bmake.bat
islands/tests/mingwmake.bat
islands/tests/vcmake.bat
islands/vcmake.bat
mingwmake.bat
tests/Make.proto
tests/PPArithmeticParser.st
tests/bc.mak
tests/bmake.bat
tests/mingwmake.bat
tests/vcmake.bat
vcmake.bat
--- a/PPCompositeParser.st	Thu May 21 14:12:22 2015 +0100
+++ b/PPCompositeParser.st	Fri Jul 24 15:06:54 2015 +0100
@@ -1,5 +1,7 @@
 "{ Package: 'stx:goodies/petitparser' }"
 
+"{ NameSpace: Smalltalk }"
+
 PPDelegateParser subclass:#PPCompositeParser
 	instanceVariableNames:'dependencies'
 	classVariableNames:''
@@ -83,6 +85,7 @@
 	^ (self newStartingAt: aSymbol) parse: anObject onError: aBlock
 ! !
 
+
 !PPCompositeParser methodsFor:'accessing'!
 
 start
--- a/PPDelegateParser.st	Thu May 21 14:12:22 2015 +0100
+++ b/PPDelegateParser.st	Fri Jul 24 15:06:54 2015 +0100
@@ -1,5 +1,7 @@
 "{ Package: 'stx:goodies/petitparser' }"
 
+"{ NameSpace: Smalltalk }"
+
 PPParser subclass:#PPDelegateParser
 	instanceVariableNames:'parser'
 	classVariableNames:''
@@ -15,6 +17,8 @@
 ! !
 
 
+
+
 !PPDelegateParser methodsFor:'accessing'!
 
 children
--- a/PPFlattenParser.st	Thu May 21 14:12:22 2015 +0100
+++ b/PPFlattenParser.st	Fri Jul 24 15:06:54 2015 +0100
@@ -1,5 +1,7 @@
 "{ Package: 'stx:goodies/petitparser' }"
 
+"{ NameSpace: Smalltalk }"
+
 PPDelegateParser subclass:#PPFlattenParser
 	instanceVariableNames:''
 	classVariableNames:''
@@ -40,6 +42,11 @@
     ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPFlattenParser.st,v 1.4 2014-03-04 14:32:30 cg Exp $'
 !
 
+version_HG
+
+    ^ '$Changeset: <not expanded> $'
+!
+
 version_SVN
     ^ '$Id: PPFlattenParser.st,v 1.4 2014-03-04 14:32:30 cg Exp $'
 ! !
--- a/PPSequenceParser.st	Thu May 21 14:12:22 2015 +0100
+++ b/PPSequenceParser.st	Fri Jul 24 15:06:54 2015 +0100
@@ -1,5 +1,7 @@
 "{ Package: 'stx:goodies/petitparser' }"
 
+"{ NameSpace: Smalltalk }"
+
 PPListParser subclass:#PPSequenceParser
 	instanceVariableNames:''
 	classVariableNames:''
@@ -9,6 +11,13 @@
 
 
 
+!PPSequenceParser methodsFor:'*petitcompiler'!
+
+map: aBlock
+	^ aBlock numArgs = self children size
+		ifTrue: [ self ==> [ :nodes | aBlock valueWithArguments: nodes ] ]
+		ifFalse: [ self error: aBlock numArgs asString , ' arguments expected.' ]
+! !
 
 
 !PPSequenceParser methodsFor:'operations'!
@@ -26,14 +35,6 @@
 	^ self ==> [ :nodes | anArrayOfIntegers collect: [ :index | nodes at: index ] ]
 ! !
 
-!PPSequenceParser methodsFor:'operators-mapping'!
-
-map: aBlock
-	^ aBlock numArgs = self children size
-		ifTrue: [ self ==> [ :nodes | aBlock valueWithArguments: nodes ] ]
-		ifFalse: [ self error: aBlock numArgs asString , ' arguments expected.' ]
-! !
-
 !PPSequenceParser methodsFor:'parsing'!
 
 parseOn: aPPContext
--- a/analyzer/bmake.bat	Thu May 21 14:12:22 2015 +0100
+++ b/analyzer/bmake.bat	Fri Jul 24 15:06:54 2015 +0100
@@ -4,9 +4,7 @@
 @REM do not edit - automatically generated from ProjectDefinition
 @REM -------
 @SET DEFINES=
-@REM Kludge got Mercurial, cannot be implemented in Borland make
-@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
-@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
 make.exe -N -f bc.mak  %DEFINES% %*
 
 
--- a/analyzer/mingwmake.bat	Thu May 21 14:12:22 2015 +0100
+++ b/analyzer/mingwmake.bat	Fri Jul 24 15:06:54 2015 +0100
@@ -4,9 +4,6 @@
 @REM do not edit - automatically generated from ProjectDefinition
 @REM -------
 @SET DEFINES=
-@REM Kludge got Mercurial, cannot be implemented in Borland make
-@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
-@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
 
 @pushd ..\..\..\rules
 @call find_mingw.bat
--- a/analyzer/tests/Make.proto	Thu May 21 14:12:22 2015 +0100
+++ b/analyzer/tests/Make.proto	Fri Jul 24 15:06:54 2015 +0100
@@ -103,7 +103,6 @@
 prereq:
 	cd ../../../../libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
 	cd ../../../../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
-	cd ../../../../libbasic3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
 	cd ../../../../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
 	cd ../../ && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
 	cd ../../../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
--- a/analyzer/tests/bc.mak	Thu May 21 14:12:22 2015 +0100
+++ b/analyzer/tests/bc.mak	Fri Jul 24 15:06:54 2015 +0100
@@ -53,7 +53,6 @@
 prereq:
 	pushd ..\..\..\..\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
 	pushd ..\..\..\..\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
-	pushd ..\..\..\..\libbasic3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
 	pushd ..\..\..\..\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
 	pushd ..\.. & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
 	pushd ..\..\..\..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
--- a/analyzer/tests/bmake.bat	Thu May 21 14:12:22 2015 +0100
+++ b/analyzer/tests/bmake.bat	Fri Jul 24 15:06:54 2015 +0100
@@ -4,9 +4,7 @@
 @REM do not edit - automatically generated from ProjectDefinition
 @REM -------
 @SET DEFINES=
-@REM Kludge got Mercurial, cannot be implemented in Borland make
-@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
-@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
 make.exe -N -f bc.mak  %DEFINES% %*
 
 
--- a/analyzer/tests/mingwmake.bat	Thu May 21 14:12:22 2015 +0100
+++ b/analyzer/tests/mingwmake.bat	Fri Jul 24 15:06:54 2015 +0100
@@ -4,9 +4,6 @@
 @REM do not edit - automatically generated from ProjectDefinition
 @REM -------
 @SET DEFINES=
-@REM Kludge got Mercurial, cannot be implemented in Borland make
-@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
-@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
 
 @pushd ..\..\..\..\rules
 @call find_mingw.bat
--- a/analyzer/tests/vcmake.bat	Thu May 21 14:12:22 2015 +0100
+++ b/analyzer/tests/vcmake.bat	Fri Jul 24 15:06:54 2015 +0100
@@ -10,11 +10,8 @@
     popd
 )
 @SET DEFINES=
-@REM Kludge got Mercurial, cannot be implemented in Borland make
-@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
-@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
 make.exe -N -f bc.mak -DUSEVC=1 %DEFINES% %*
 
 
 
-
--- a/analyzer/vcmake.bat	Thu May 21 14:12:22 2015 +0100
+++ b/analyzer/vcmake.bat	Fri Jul 24 15:06:54 2015 +0100
@@ -10,11 +10,8 @@
     popd
 )
 @SET DEFINES=
-@REM Kludge got Mercurial, cannot be implemented in Borland make
-@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
-@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
 make.exe -N -f bc.mak -DUSEVC=1 %DEFINES% %*
 
 
 
-
--- a/bmake.bat	Thu May 21 14:12:22 2015 +0100
+++ b/bmake.bat	Fri Jul 24 15:06:54 2015 +0100
@@ -4,9 +4,7 @@
 @REM do not edit - automatically generated from ProjectDefinition
 @REM -------
 @SET DEFINES=
-@REM Kludge got Mercurial, cannot be implemented in Borland make
-@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
-@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
 make.exe -N -f bc.mak  %DEFINES% %*
 
 @echo "***********************************"
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/FooScanner.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,210 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCScanner subclass:#FooScanner
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Scanner'
+!
+
+!FooScanner methodsFor:'as yet unclassified'!
+
+nextTokenA
+    "a"
+    self step.
+    self peek == $a ifFalse: [ ^ self return ].
+
+    self recordMatch: #a.
+
+    ^ self return
+!
+
+nextTokenAAorA
+    "aa / a"
+    self step.
+    (self peek == $a) ifFalse: [ ^ self return ].
+    self recordMatch: #a priority: -1.	
+
+    self step.
+    (self peek == $a) ifFalse: [ ^ self return ].
+    self recordMatch: #aa priority: 0.	
+
+    ^ self return.
+!
+
+nextTokenAAplusA
+    "(aa)+a"
+    self step.
+    self peek == $a ifFalse: [ ^ self return ].
+
+    self step.
+    self peek == $a ifFalse: [ ^ self return. ].
+
+    [ 
+        self step.
+        self peek == $a ifFalse: [ ^ self returnPriority: 0 ].
+        self recordMatch: #AAplusA priority: -1.
+
+        self step.
+        self peek == $a.
+    ] whileTrue.
+
+    ^ self returnPriority: -1
+!
+
+nextTokenAAstarA
+    "(aa)*a"
+    self step.
+    self peek == $a ifFalse: [ ^ self return ].
+
+    [ 
+        self recordMatch: #AAstarA priority: -1.
+
+        self step.
+        self peek == $a ifFalse: [ ^ self returnPriority: -1 ].
+        self step.
+        
+        self peek == $a	
+    ] whileTrue.
+    
+    ^ self returnPriority: 0
+!
+
+nextTokenAB
+    "ab"
+    self step.
+    self peek == $a ifFalse: [ ^ self return ].
+    
+    self step.
+    self peek == $b ifFalse: [ ^ self return ].
+    self recordMatch: #b.
+    
+    ^ self return.
+!
+
+nextTokenABorBC
+    "a"
+    self step.
+    (self peek == $a) ifTrue: [ 
+
+        self step.
+        self peek == $b ifFalse: [ ^ self return ].
+        self recordMatch: #ab.
+
+        ^ self return	
+    ].
+
+    (self peek == $b) ifTrue: [ 
+        self step.
+        self peek == $c ifFalse: [ ^ self return ].
+        self recordMatch: #bc.	
+
+        ^ self return
+    ].
+
+    ^ self return
+!
+
+nextTokenABstarA
+    "(ab)*a"
+    self step.
+    self peek == $a ifFalse: [ ^ self return ].
+
+    [ 
+        self recordMatch: #ABstarA priority: -1.
+        
+        self step.
+        self peek == $b ifFalse: [ ^ self returnPriority: -1 ].
+    
+        self step.
+        self peek == $a.
+    ] whileTrue.
+
+    ^ self returnPriority: 0
+!
+
+nextTokenA_Bstar_A
+    "ab"
+    self step.
+    self peek == $a ifFalse: [ ^ self return ].
+
+    [
+        self step.
+        self peek == $b.
+    ] whileTrue.
+
+
+    self peek == $a ifFalse: [ ^ self return ].
+    self recordMatch: #A_Bstar_A.
+
+    ^ self return.
+!
+
+nextTokenAorAA
+    "aa / a"
+    self step.
+    (self peek == $a) ifTrue: [ 
+        self recordMatch: #a priority: 0.	
+        ^ self return
+    ].
+
+    self step.
+    (self peek == $a) ifTrue: [ 
+        self recordMatch: #aa priority: -1.	
+        ^ self return
+    ].
+!
+
+nextTokenAorB
+    "a"
+    self step.
+    (self peek == $a) ifTrue: [ 
+        self recordMatch: #a.	
+        ^ self return
+    ].
+    (self peek == $b) ifTrue: [ 
+        self recordMatch: #b.	
+        ^ self return
+    ].
+
+    ^ self return
+!
+
+nextTokenAstarA
+    "a*a"
+    [
+        self step.
+        self peek == $a.
+    ] whileTrue.
+
+    self peek == $a ifFalse: [ ^ self return ].
+    self recordMatch: #AstarA.
+    ^ self return
+!
+
+nextTokenAstarB
+    "a*b"
+    [ 
+        self step.
+        self peek == $a.
+    ] whileTrue.
+
+    self peek == $b ifFalse: [ ^ self return ].
+    self recordMatch: #AstarB.
+    ^ self return
+!
+
+nextTokenAuorA
+    "a | a"
+    self step.
+    (self peek == $a) ifTrue: [ 
+        self recordMatch: #a1.	
+        self recordMatch: #a2.
+        ^ self return	
+    ].
+
+    ^ self return	
+! !
+
--- a/compiler/Make.proto	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/Make.proto	Fri Jul 24 15:06:54 2015 +0100
@@ -34,7 +34,7 @@
 # add the path(es) here:,
 # ********** OPTIONAL: MODIFY the next lines ***
 # LOCALINCLUDES=-Ifoo -Ibar
-LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/analyzer -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/java -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2
+LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/analyzer -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/java -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk -I$(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2 -I$(INCLUDE_TOP)/stx/libview
 
 
 # if you need any additional defines for embedded C code,
@@ -104,7 +104,6 @@
 	cd ../../../libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
 	cd ../../refactoryBrowser/parser && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
 	cd ../../../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
-	cd ../../../libbasic3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
 	cd ../../../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
 	cd ../ && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
 	cd ../../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
@@ -131,8 +130,17 @@
 
 
 # BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)PEGFsa.$(O) PEGFsa.$(H): PEGFsa.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaFailure.$(O) PEGFsaFailure.$(H): PEGFsaFailure.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaInterpret.$(O) PEGFsaInterpret.$(H): PEGFsaInterpret.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaPair.$(O) PEGFsaPair.$(H): PEGFsaPair.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaState.$(O) PEGFsaState.$(H): PEGFsaState.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaTransition.$(O) PEGFsaTransition.$(H): PEGFsaTransition.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCArguments.$(O) PPCArguments.$(H): PPCArguments.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCBridge.$(O) PPCBridge.$(H): PPCBridge.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCClassBuilder.$(O) PPCClassBuilder.$(H): PPCClassBuilder.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCCodeBlock.$(O) PPCCodeBlock.$(H): PPCCodeBlock.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCCodeGen.$(O) PPCCodeGen.$(H): PPCCodeGen.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCCompiledMethod.$(O) PPCCompiledMethod.$(H): PPCCompiledMethod.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCCompiler.$(O) PPCCompiler.$(H): PPCCompiler.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCCompilerTokenErrorStrategy.$(O) PPCCompilerTokenErrorStrategy.$(H): PPCCompilerTokenErrorStrategy.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
@@ -147,9 +155,14 @@
 $(OUTDIR)PPCNode.$(O) PPCNode.$(H): PPCNode.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCNodeVisitor.$(O) PPCNodeVisitor.$(H): PPCNodeVisitor.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCPluggableConfiguration.$(O) PPCPluggableConfiguration.$(H): PPCPluggableConfiguration.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCScanner.$(O) PPCScanner.$(H): PPCScanner.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCScannerCodeGenerator.$(O) PPCScannerCodeGenerator.$(H): PPCScannerCodeGenerator.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCTokenGuard.$(O) PPCTokenGuard.$(H): PPCTokenGuard.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCompiledParser.$(O) PPCompiledParser.$(H): PPCompiledParser.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPMappedActionParser.$(O) PPMappedActionParser.$(H): PPMappedActionParser.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPActionParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)stx_goodies_petitparser_compiler.$(O) stx_goodies_petitparser_compiler.$(H): stx_goodies_petitparser_compiler.st $(INCLUDE_TOP)/stx/libbasic/LibraryDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProjectDefinition.$(H) $(STCHDR)
+$(OUTDIR)FooScanner.$(O) FooScanner.$(H): FooScanner.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCScanner.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaGenerator.$(O) PEGFsaGenerator.$(H): PEGFsaGenerator.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNodeVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCAbstractLiteralNode.$(O) PPCAbstractLiteralNode.$(H): PPCAbstractLiteralNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCAbstractPredicateNode.$(O) PPCAbstractPredicateNode.$(H): PPCAbstractPredicateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCAnyNode.$(O) PPCAnyNode.$(H): PPCAnyNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
@@ -157,6 +170,7 @@
 $(OUTDIR)PPCCodeGenerator.$(O) PPCCodeGenerator.$(H): PPCCodeGenerator.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNodeVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCDelegateNode.$(O) PPCDelegateNode.$(H): PPCDelegateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCEndOfFileNode.$(O) PPCEndOfFileNode.$(H): PPCEndOfFileNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCFSACodeGen.$(O) PPCFSACodeGen.$(H): PPCFSACodeGen.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCCodeGen.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCInlinedMethod.$(O) PPCInlinedMethod.$(H): PPCInlinedMethod.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCMethod.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCInliningVisitor.$(O) PPCInliningVisitor.$(H): PPCInliningVisitor.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNodeVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCListNode.$(O) PPCListNode.$(H): PPCListNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
@@ -216,6 +230,7 @@
 $(OUTDIR)PPCTokenChoiceNode.$(O) PPCTokenChoiceNode.$(H): PPCTokenChoiceNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCChoiceNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCListNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCTrimNode.$(O) PPCTrimNode.$(H): PPCTrimNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCListNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCSequenceNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCTrimmingCharacterTokenNode.$(O) PPCTrimmingCharacterTokenNode.$(H): PPCTrimmingCharacterTokenNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCListNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCTrimmingTokenNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCMappedActionNode.$(O) PPCMappedActionNode.$(H): PPCMappedActionNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractActionNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCActionNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCDelegateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCTokenStarMessagePredicateNode.$(O) PPCTokenStarMessagePredicateNode.$(H): PPCTokenStarMessagePredicateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCDelegateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCStarMessagePredicateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCStarNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCTokenStarSeparatorNode.$(O) PPCTokenStarSeparatorNode.$(H): PPCTokenStarSeparatorNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCDelegateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCStarMessagePredicateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCStarNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCTokenStarMessagePredicateNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPActionParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPAndParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPCharSetPredicate.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPChoiceParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPCompositeParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPContext.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPEndOfInputParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPEpsilonParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPFailure.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPFlattenParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPListParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPLiteralObjectParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPLiteralParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPLiteralSequenceParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPNotParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPOptionalParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPPluggableParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPPossessiveRepeatingParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPPredicateObjectParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPPredicateParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPRepeatingParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPSequenceParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPStream.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPToken.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPTokenParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPTrimmingParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/parsers/java/PPJavaWhitespaceParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk/PPSmalltalkGrammar.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk/PPSmalltalkTokenParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk/PPSmalltalkWhitespaceParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Character.$(H) $(INCLUDE_TOP)/stx/libbasic/Magnitude.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/PeekableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/PositionableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/ReadStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(INCLUDE_TOP)/stx/libbasic/UndefinedObject.$(H) $(STCHDR)
--- a/compiler/Make.spec	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/Make.spec	Fri Jul 24 15:06:54 2015 +0100
@@ -51,8 +51,17 @@
 STCWARNINGS=-warnNonStandard
 
 COMMON_CLASSES= \
+	PEGFsa \
+	PEGFsaFailure \
+	PEGFsaInterpret \
+	PEGFsaPair \
+	PEGFsaState \
+	PEGFsaTransition \
 	PPCArguments \
 	PPCBridge \
+	PPCClassBuilder \
+	PPCCodeBlock \
+	PPCCodeGen \
 	PPCCompiledMethod \
 	PPCCompiler \
 	PPCCompilerTokenErrorStrategy \
@@ -67,9 +76,14 @@
 	PPCNode \
 	PPCNodeVisitor \
 	PPCPluggableConfiguration \
+	PPCScanner \
+	PPCScannerCodeGenerator \
 	PPCTokenGuard \
 	PPCompiledParser \
+	PPMappedActionParser \
 	stx_goodies_petitparser_compiler \
+	FooScanner \
+	PEGFsaGenerator \
 	PPCAbstractLiteralNode \
 	PPCAbstractPredicateNode \
 	PPCAnyNode \
@@ -77,6 +91,7 @@
 	PPCCodeGenerator \
 	PPCDelegateNode \
 	PPCEndOfFileNode \
+	PPCFSACodeGen \
 	PPCInlinedMethod \
 	PPCInliningVisitor \
 	PPCListNode \
@@ -136,6 +151,7 @@
 	PPCTokenChoiceNode \
 	PPCTrimNode \
 	PPCTrimmingCharacterTokenNode \
+	PPCMappedActionNode \
 	PPCTokenStarMessagePredicateNode \
 	PPCTokenStarSeparatorNode \
 
@@ -143,8 +159,17 @@
 
 
 COMMON_OBJS= \
+    $(OUTDIR_SLASH)PEGFsa.$(O) \
+    $(OUTDIR_SLASH)PEGFsaFailure.$(O) \
+    $(OUTDIR_SLASH)PEGFsaInterpret.$(O) \
+    $(OUTDIR_SLASH)PEGFsaPair.$(O) \
+    $(OUTDIR_SLASH)PEGFsaState.$(O) \
+    $(OUTDIR_SLASH)PEGFsaTransition.$(O) \
     $(OUTDIR_SLASH)PPCArguments.$(O) \
     $(OUTDIR_SLASH)PPCBridge.$(O) \
+    $(OUTDIR_SLASH)PPCClassBuilder.$(O) \
+    $(OUTDIR_SLASH)PPCCodeBlock.$(O) \
+    $(OUTDIR_SLASH)PPCCodeGen.$(O) \
     $(OUTDIR_SLASH)PPCCompiledMethod.$(O) \
     $(OUTDIR_SLASH)PPCCompiler.$(O) \
     $(OUTDIR_SLASH)PPCCompilerTokenErrorStrategy.$(O) \
@@ -159,9 +184,14 @@
     $(OUTDIR_SLASH)PPCNode.$(O) \
     $(OUTDIR_SLASH)PPCNodeVisitor.$(O) \
     $(OUTDIR_SLASH)PPCPluggableConfiguration.$(O) \
+    $(OUTDIR_SLASH)PPCScanner.$(O) \
+    $(OUTDIR_SLASH)PPCScannerCodeGenerator.$(O) \
     $(OUTDIR_SLASH)PPCTokenGuard.$(O) \
     $(OUTDIR_SLASH)PPCompiledParser.$(O) \
+    $(OUTDIR_SLASH)PPMappedActionParser.$(O) \
     $(OUTDIR_SLASH)stx_goodies_petitparser_compiler.$(O) \
+    $(OUTDIR_SLASH)FooScanner.$(O) \
+    $(OUTDIR_SLASH)PEGFsaGenerator.$(O) \
     $(OUTDIR_SLASH)PPCAbstractLiteralNode.$(O) \
     $(OUTDIR_SLASH)PPCAbstractPredicateNode.$(O) \
     $(OUTDIR_SLASH)PPCAnyNode.$(O) \
@@ -169,6 +199,7 @@
     $(OUTDIR_SLASH)PPCCodeGenerator.$(O) \
     $(OUTDIR_SLASH)PPCDelegateNode.$(O) \
     $(OUTDIR_SLASH)PPCEndOfFileNode.$(O) \
+    $(OUTDIR_SLASH)PPCFSACodeGen.$(O) \
     $(OUTDIR_SLASH)PPCInlinedMethod.$(O) \
     $(OUTDIR_SLASH)PPCInliningVisitor.$(O) \
     $(OUTDIR_SLASH)PPCListNode.$(O) \
@@ -228,6 +259,7 @@
     $(OUTDIR_SLASH)PPCTokenChoiceNode.$(O) \
     $(OUTDIR_SLASH)PPCTrimNode.$(O) \
     $(OUTDIR_SLASH)PPCTrimmingCharacterTokenNode.$(O) \
+    $(OUTDIR_SLASH)PPCMappedActionNode.$(O) \
     $(OUTDIR_SLASH)PPCTokenStarMessagePredicateNode.$(O) \
     $(OUTDIR_SLASH)PPCTokenStarSeparatorNode.$(O) \
     $(OUTDIR_SLASH)extensions.$(O) \
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsa.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,714 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PEGFsa
+	instanceVariableNames:'states startState name distances priorities'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-FSA'
+!
+
+!PEGFsa methodsFor:'accessing'!
+
+allTransitions
+    ^ self allTransitions: IdentitySet new
+!
+
+allTransitions: collection
+    self states do: [ :s | collection addAll: s transitions  ].
+    ^ collection
+!
+
+forwardTransitions
+    | backTransitions |
+    backTransitions := self backTransitions.
+    ^ self allTransitions reject: [ :t | backTransitions includes: t ]
+!
+
+minPriority
+    "this is the worst estimate"
+    ^ (self states size) negated
+!
+
+name
+    ^ name 
+!
+
+name: anObject
+    
+    name := anObject
+!
+
+prefix
+    ^ 'fsa_'
+!
+
+startState
+    ^ startState
+!
+
+stateNamed: name
+    ^ states detect: [ :e | e name = name ]
+!
+
+states
+    ^ states
+!
+
+suffix
+    ^ ''
+!
+
+transitionFrom: from to: to
+    ^ from transitions detect: [ :t | t destination = to ]
+!
+
+transitionsFor: state
+    self assert: (states includes: state).
+    ^ state transitions
+! !
+
+!PEGFsa methodsFor:'analysis'!
+
+backTransitions
+    |  transitionSet |
+    transitionSet := IdentitySet new.
+    self computeDistances.
+    
+    self backTransitionsFrom: startState openSet: IdentitySet new transitionSet: transitionSet.
+    ^ transitionSet
+!
+
+backTransitionsFrom: state openSet: openSet transitionSet: transitionSet
+    (openSet includes: state) ifTrue: [  
+        ^ self
+    ].
+    openSet add: state.
+    
+    state transitions do: [ :t | 
+        ((openSet includes: t destination) and: [self is: state furtherThan: t destination]) ifTrue: [  
+            transitionSet add: t		
+        ].
+        self backTransitionsFrom: t destination openSet: openSet copy transitionSet: transitionSet
+    ]
+!
+
+computeDistances
+    | queue openSet |
+    distances := IdentityDictionary new.
+    queue := OrderedCollection with: startState.
+    openSet := IdentitySet new.
+
+    distances at: startState put: 0.
+    
+    [ queue isEmpty not ] whileTrue: [ 
+        | state |
+        state := queue removeFirst.
+        openSet add: state.
+        
+        state transitions do: [ :t |
+            (openSet includes: (t destination)) ifFalse: [ 
+                distances at: (t destination ) put: ((distances at: state) + 1).
+                queue addLast: (t destination)
+            ]
+        ]
+    ].
+
+    ^ distances
+!
+
+computePriorities
+    | queue openSet |
+    self flag: 'not working...'.
+    priorities := IdentityDictionary new.
+    queue := OrderedCollection with: startState.
+    openSet := IdentitySet new.
+
+    priorities at: startState put: (startState priorityIfNone: 0).
+    
+    [ queue isEmpty not ] whileTrue: [ 
+        | state |
+        state := queue removeFirst.
+        openSet add: state.
+        
+        state transitions do: [ :t |
+            (openSet includes: (t destination)) ifFalse: [ 
+                priorities at: (t destination ) put: ((priorities at: state) + t priority).
+                queue addLast: (t destination)
+            ]
+        ]
+    ].
+
+    ^ priorities
+!
+
+epsilonDestinationsFrom: state
+    | openSet |
+    openSet := IdentitySet new.
+    self epsilonDestinationsFrom: state openSet: openSet.
+    ^ openSet
+!
+
+epsilonDestinationsFrom: state openSet: openSet.
+    (openSet includes: state) ifTrue: [ 
+        ^ self 
+    ].
+
+    openSet add: state.
+    
+    ((self transitionsFor: state) select: [ :t | t isEpsilon ]) do: [ :t |
+        self epsilonDestinationsFrom: t destination openSet: openSet
+    ]
+    
+!
+
+finalStates
+    ^ self reachableStates select: [ :s | s isFinal ]
+!
+
+is: state furtherThan: anotherState
+
+    ^ (distances at: state) >= (distances at: anotherState)
+!
+
+isBackTransition: t
+    ^ self backTransitions includes: t
+!
+
+joinPoints
+    ^ self joinTransitions collect: [ :t | t destination ]
+!
+
+joinTransitions
+    | joinTransitions transitions  size |
+    joinTransitions := IdentitySet new.
+
+    transitions := self allTransitions asOrderedCollection.
+    size := transitions size.
+
+    
+    (1 to: size - 1) do: [ :index1 |
+        (index1 + 1 to: size)  do: [ :index2 | 
+            ((transitions at: index1) destination == (transitions at: index2) destination) ifTrue: [ 
+                joinTransitions add: (transitions at: index1).
+                joinTransitions add: (transitions at: index2).
+            ]
+        ]
+    ].
+
+    ^ joinTransitions
+!
+
+minimumPriority
+!
+
+nonFinalStates
+    ^ self states reject: [ :s | s isFinal ]
+!
+
+reachableStates
+    ^ self statesReachableFrom: startState
+!
+
+statePairs
+    |  pairs ordered |
+    pairs := OrderedCollection new.
+    ordered := self topologicalOrder.
+    1 to: (ordered size - 1) do: [ :index1 |
+        (index1 + 1) to: ordered size do: [ :index2 |
+            pairs add: (PEGFsaPair with: (ordered at: index1) with: (ordered at: index2))
+ 		]
+    ].
+
+    self assert: (pairs allSatisfy: [ :e | e class == PEGFsaPair ]).
+    ^ pairs
+!
+
+statesReachableFrom: state
+    | openSet |
+    self assert: state isNil not.
+    
+    openSet := IdentitySet new.
+    self statesReachableFrom: state openSet: openSet.
+    ^ openSet
+!
+
+statesReachableFrom: state openSet: openSet
+    (openSet contains: [:e | e == state]) ifTrue: [ 
+        ^ self 
+    ].
+
+    openSet add: state.
+    
+    (self transitionsFor: state) do: [ :t |
+        self statesReachableFrom: t destination openSet: openSet
+    ]
+    
+!
+
+topologicalOrder
+    | collection |
+    collection := OrderedCollection new.
+    self statesReachableFrom: startState openSet: collection.
+    ^ collection
+! !
+
+!PEGFsa methodsFor:'comparing'!
+
+= anotherFsa
+    "
+        Please note what the compare does. IMO nothing useful for no.
+        
+        For comparing if two FSA's are equivalent, use isIsomorphicTo:
+    "
+
+    (self == anotherFsa)  ifTrue: [ ^ true ].
+    (self class == anotherFsa class) ifFalse: [ ^ false ].
+    
+    (startState = anotherFsa startState) ifFalse: [ ^ false ].
+    (name = anotherFsa name) ifFalse: [ ^ false ].
+    
+    (states size = anotherFsa states size) ifFalse: [ ^ false ].
+    states do: [:s |
+        (anotherFsa states contains: [ :e | e = s ]) ifFalse: [ ^ false ].
+    ].
+    ^ true
+!
+
+hash
+    ^ states hash bitXor: (startState bitXor: name)
+!
+
+isIsomorphicTo: anotherFsa
+    | topologicalOrder anotherTopologicalOrder  |
+    
+    "
+        Please not that this version of comparison is sensitive to the order
+        in which the transitions in state are ordered.
+    "
+    
+    topologicalOrder := self topologicalOrder.
+    anotherTopologicalOrder := anotherFsa topologicalOrder.
+    
+    topologicalOrder size == anotherTopologicalOrder size ifFalse: [ ^ false ].
+    
+    topologicalOrder with: anotherTopologicalOrder do: [ :s1 :s2 |
+        (s1 canBeIsomorphicTo: s2) ifFalse: [ ^ false ]
+    ].
+    
+    ^ true
+"	
+    transitions := topologicalOrder flatCollect: [ :s | s transitions ].
+    anotherTransitions := anotherTopologicalOrder flatCollect: [ :s | s transitions ].
+"	
+! !
+
+!PEGFsa methodsFor:'copying'!
+
+postCopy
+    | map |
+    super postCopy.
+    
+    map := IdentityDictionary new.
+    states do: [ :s |
+        map at: s put: s copy.
+    ].
+    
+    states := map values asIdentitySet.
+    startState := map at: startState.
+    
+    states do: [ :s |
+        s transitions do: [:t |
+            t destination: (map at: t destination)
+        ]
+    ]
+! !
+
+!PEGFsa methodsFor:'gt'!
+
+gtGraphViewIn: composite
+    <gtInspectorPresentationOrder: 41>
+    composite roassal2
+        title: 'Graph'; 
+        initializeView: [ RTMondrian new ];
+        painting: [ :view |
+            self viewGraphOn: view.	
+        ].
+!
+
+gtStringViewIn: composite
+    <gtInspectorPresentationOrder: 40>
+
+    composite text
+            title: 'Textual Representation';
+            display: [ :fsa | fsa asString  ]
+!
+
+viewGraphOn: b
+    b shape circle size: 50.
+    b shape color: Color gray muchLighter muchLighter.
+    b shape withText: #gtName.
+    b nodes: (self nonFinalStates).
+
+    b shape circle size: 50.
+    b shape color: Color gray muchLighter.
+    b shape withText: #gtName.
+    b nodes: (self finalStates).
+
+    b shape arrowedLine.
+    b edges 
+        connectToAll: [ :state | 
+            state transitions 	select: [:t | (self isBackTransition:t)  not] 
+                                    thenCollect: #destination ]
+        labelled: [ :t | (self transitionFrom: t key to: t value) gtName  ].		
+
+    b shape arrowedLine.
+    b shape color: Color red.
+    b edges 
+        connectToAll: [ :state | 
+            state transitions 	select: [:t | (self isBackTransition: t) ] 
+                                thenCollect: #destination ]
+        labelled: [ :t | (self transitionFrom: t key to: t value) gtName  ].
+
+
+    b layout horizontalTree  .
+    b layout layout horizontalGap: 30.
+
+    ^ b
+! !
+
+!PEGFsa methodsFor:'initialization'!
+
+initialize
+    states := IdentitySet new.
+! !
+
+!PEGFsa methodsFor:'modifications'!
+
+addState: state
+    self assert: (states includes: state) not.
+    states add: state
+!
+
+addTransitionFrom: fromState to: toState 
+    ^ self addTransitionFrom: fromState to: toState priority: 0 
+!
+
+addTransitionFrom: fromState to: toState on: character
+    self addTransitionFrom: fromState to: toState on: character priority: 0
+!
+
+addTransitionFrom: fromState to: toState on: character priority: priority
+    | transition |
+    transition := PEGFsaTransition new 
+        addCharacter: character;
+        destination: toState;
+        priority: priority;
+        yourself.
+        
+    fromState addTransition: transition
+!
+
+addTransitionFrom: fromState to: toState onCharacterSet: characterSet
+    self addTransitionFrom: fromState to: toState onCharacterSet: characterSet priority: 0
+!
+
+addTransitionFrom: fromState to: toState onCharacterSet: characterSet priority: priority
+    | transition |
+    transition := PEGFsaTransition new 
+        characterSet: characterSet;
+        destination: toState;
+        priority: priority;
+        yourself.
+
+    fromState addTransition: transition
+!
+
+addTransitionFrom: fromState to: toState priority: priority
+    | transition |
+    self assert: (states includes: fromState).
+    self assert: (states includes: toState).
+    
+    transition := PEGFsaTransition new 
+        destination: toState;
+        priority: priority;
+        yourself.
+        
+    fromState addTransition: transition.
+!
+
+adopt: fsa
+    states addAll: fsa reachableStates.
+!
+
+finalState: state
+    self assert: state isFinal not.
+    state final: true.
+!
+
+fixFinalStatePriorities
+    self finalStates do: [ :s |
+        s hasPriority ifFalse: [ s priority: 0 ]
+    ]
+!
+
+removeState: state
+    self assert: (states includes: state).
+    states remove: state.
+!
+
+replace: state with: anotherState
+    | transitions  |
+    self assert: (state class == PEGFsaState).
+    self assert: (anotherState class == PEGFsaState).
+    
+    transitions := self allTransitions.
+
+    transitions do: [ :t |
+        (t destination == state) ifTrue: [ 
+            t destination: anotherState.
+        ]
+    ].
+    states := startState reachableStates.	
+!
+
+startState: state
+    self assert: (states includes: state).
+    
+    startState := state
+! !
+
+!PEGFsa methodsFor:'printing'!
+
+asString
+    | stream  |
+    stream := WriteStream on: ''.
+    
+    self topologicalOrder do: [ :state |
+        state printOn: stream.
+        stream nextPutAll: '> '.
+        
+        (self transitionsFor: state) do: [ :transition |
+            stream nextPut: (Character codePoint: 13).
+            stream nextPut: (Character codePoint: 9).
+            transition printOn: stream.
+        ].
+        stream nextPut: (Character codePoint: 13).
+    ].
+    
+"	stream nextPutAll: 'finals: '.
+    (states select: [:s | s isFinal ]) do: [:e | e printOn: stream ].
+    stream nextPut: (Character codePoint: 13).
+"
+    ^ stream contents.
+! !
+
+!PEGFsa methodsFor:'testing'!
+
+canHavePPCId
+    ^ true
+!
+
+checkConsistency
+    self assert: (states includes: startState).
+    states do: [ :s | s transitions do: [ :t |
+        self assert: (states includes: t destination).
+    ] ].
+    ^ true
+!
+
+checkFinalStatesPriorities
+    self assert: (self finalStates allSatisfy: #hasPriority)
+!
+
+checkSanity
+    self checkConsistency.
+    self checkTransitionsIdentity.
+    self checkFinalStatesPriorities.
+!
+
+checkTransitionsIdentity
+    | bag set |
+    bag := IdentityBag new.
+    set := IdentitySet new.
+    bag := self allTransitions: bag.
+    set := self allTransitions: set.	
+    
+    self assert: bag size == set size.
+!
+
+isDeterministic
+    self reachableStates do: [ :state |
+        state transitionPairs do: [ :pair | 
+            ((pair first intersection: pair second) includes: true) ifTrue: [ 					
+                ^ false
+            ] 
+        ]
+    ].
+    ^ true
+!
+
+isReachableState: state
+    ^ self reachableStates includes: state
+!
+
+isStartState: state
+    ^ startState == state
+!
+
+isWithoutEpsilons
+    self reachableStates do: [ :state | 
+        state transitions do: [ :t | 
+            t isEpsilon ifTrue: [ ^ false ]
+        ]
+    ].
+    ^ true
+! !
+
+!PEGFsa methodsFor:'transformations'!
+
+compact
+    self fixFinalStatePriorities.
+    self determinize.
+    self minimize.
+    
+    self checkSanity.
+!
+
+determinize
+    | joinDictionary |
+    self removeEpsilons.
+
+    self removeUnreachableStates.
+    self removeLowPriorityTransitions.
+    self mergeTransitions.
+    
+    joinDictionary := Dictionary new.
+    self topologicalOrder do: [:state | state determinize: joinDictionary ].
+    
+    states	 := startState reachableStates.
+
+    self removeUnreachableStates.
+    self removeLowPriorityTransitions.
+    self mergeTransitions.
+    
+!
+
+mergeTransitions
+    | toRemove |
+    self reachableStates do: [ :state |
+        toRemove := OrderedCollection new.
+        state transitionPairs do:[ :pair | 
+            (pair first destination = pair second destination) ifTrue: [ 
+                pair first mergeWith: pair second.
+                toRemove add: pair second.
+            ]
+        ].
+        toRemove do: [ :t |
+            state removeTransition: t
+        ]
+    ]
+!
+
+minimize
+    | pair |
+    pair := self statePairs detect:  [ :p | p first equals: p second ] ifNone: [ nil ].
+    [ pair isNil not ] whileTrue: [ 
+        "Join priorities, because equivalency of priorities does not imply from the equeality of states"
+        pair first joinPriority: pair second newState: pair first.
+        pair first joinName: pair second newState: pair first.
+        self replace: pair second with: pair first.
+        self mergeTransitions.
+        pair := self statePairs detect:  [ :p | p first equals: p second ] ifNone: [ nil ].
+ 	].
+!
+
+removeEpsilonTransition: transition source: state
+    ^ self removeEpsilonTransition: transition source: state openSet: IdentitySet new
+!
+
+removeEpsilonTransition: transition source: source openSet: openSet
+    | destination |
+    (openSet includes: transition) ifTrue: [ self error: 'loop in epsilons?!!' ].
+    openSet add: transition.
+    
+    destination := transition destination.
+    
+    "First Remove Recursively"
+    ((self transitionsFor: destination ) select: [ :t | t isEpsilon  ]) do: [ :t |
+        self removeEpsilonTransition: t source: destination openSet: openSet
+    ].
+    
+    (transition priority abs) timesRepeat: [ 
+        (self statesReachableFrom: destination) do: [ :s |
+            s decreasePriority.
+            s transitions do: [ :t | t decreasePriority  ]
+        ]
+    ].
+
+    (destination transitions) do: [ :t |
+        source addTransition: (t copy)
+    ].
+
+    destination hasPriority ifTrue: [ 
+        source hasPriority ifTrue: [ 
+            "self assert: source priority == destination priority"
+            self flag: 'I am not 100% sure about this case'
+        ].
+        source priority: destination priority
+    ].
+
+    destination isFinal ifTrue: [ 
+        source final: true.
+        source retval: destination retval.
+    ].
+
+    source removeTransition: transition.
+!
+
+removeEpsilons
+    states do: [ :state |
+        self removeEpsilonsFor: state
+    ]
+!
+
+removeEpsilonsFor: state
+    (self transitionsFor: state) copy do: [ :t |
+        t isEpsilon ifTrue: [ 
+            self removeEpsilonTransition: t source: state
+        ]
+    ]
+!
+
+removeLowPriorityTransitions
+    states do: [ :state |
+        self removeLowPriorityTransitionsFor: state
+    ]
+!
+
+removeLowPriorityTransitionsFor: state
+    state hasPriority ifFalse: [ ^ self ].
+    state isFinal ifFalse: [ ^ self ].
+    
+    state transitions do: [ :t |
+        (t priority < state priority) ifTrue: [ 
+            state removeTransition: t
+        ]
+    ]
+!
+
+removeUnreachableStates
+    | reachable toRemove |
+    reachable := self reachableStates.
+    toRemove := OrderedCollection new.
+
+    states do: [ :s |
+        (reachable includes: s) ifFalse: [ 
+            toRemove add: s		
+        ]
+    ].
+
+    toRemove do: [ :s | states remove: s ]
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaFailure.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,11 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PEGFsaFailure
+	instanceVariableNames:'message'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-FSA'
+!
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaGenerator.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,229 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCNodeVisitor subclass:#PEGFsaGenerator
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-FSA'
+!
+
+!PEGFsaGenerator methodsFor:'as yet unclassified'!
+
+visitCharSetPredicateNode: node
+    | stop start fsa |
+    start := PEGFsaState new.
+    stop := PEGFsaState new.
+    
+    fsa := PEGFsa new
+        addState: start;
+        addState: stop;
+        
+        startState: start;
+        finalState: stop;
+        yourself.
+    
+    fsa addTransitionFrom: start to: stop onCharacterSet: (node predicate classification).
+        
+    ^ fsa
+!
+
+visitCharacterNode: node
+    | stop start |
+    start := PEGFsaState new.
+    stop := PEGFsaState new.
+    stop name: node character storeString.
+    
+    ^ PEGFsa new
+        addState: start;
+        addState: stop;
+        
+        startState: start;
+        finalState: stop;
+
+        addTransitionFrom: start to: stop on: node character;
+        yourself
+!
+
+visitChoiceNode: node
+    | priority childrenFsa fsa start |
+    
+    childrenFsa := node children collect: [ :child | child accept: self ].
+    fsa := PEGFsa new.
+    start := PEGFsaState new.
+    
+    fsa addState: start.
+    fsa startState: start.
+
+    priority := 0.
+    childrenFsa do: [ :childFsa |
+        fsa adopt: childFsa.
+        fsa addTransitionFrom: start to: childFsa startState priority: priority.
+        priority := priority + childFsa minPriority.
+    ].
+
+    ^ fsa
+!
+
+visitLiteralNode: node
+    | states fsa |
+
+    states := OrderedCollection new.
+    (node literal size + 1) timesRepeat: [
+        states add: PEGFsaState new
+    ].
+
+    fsa := PEGFsa new.
+    states do: [ :state | fsa addState: state ].	
+    fsa	 startState: states first;
+         finalState: states last;
+         yourself.
+        
+    (1 to: (states size - 1)) do: [ :index |
+        fsa addTransitionFrom: (states at: index)
+         	 to: (states at: index + 1)
+             on: (node literal at: index).
+        "set the name"
+        (states at: (index + 1)) name: (node literal at: index). 
+    ].
+
+    fsa name: node literal.
+    ^ fsa
+!
+
+visitNode: node
+    self error: 'node not supported'
+!
+
+visitNotNode: node
+    | fsa finalState |
+    fsa := node child accept: self.
+    finalState := PEGFsaState new
+        name: '!!', fsa name asString;
+        yourself.
+    
+    fsa finalStates do: [ :fs |
+        fs retval: PEGFsaFailure new.
+    ].
+    
+    fsa addState: finalState.
+    fsa finalState: finalState.
+
+    fsa addTransitionFrom: fsa startState to: finalState priority: -1.
+    ^ fsa
+!
+
+visitOptionalNode: node
+    | fsa startState finalState |
+
+    fsa := node child accept: self.
+    startState := PEGFsaState new
+        yourself.
+
+    finalState := PEGFsaState new
+        final: true;
+        yourself.
+
+    fsa addState: startState.
+    fsa addState: finalState.
+    
+    fsa addTransitionFrom: startState to: fsa startState priority: 0.
+    fsa addTransitionFrom: startState to: finalState priority: fsa minPriority.
+
+    fsa startState: startState.
+
+    ^ fsa
+!
+
+visitPlusNode: node
+    | fsa finalState |
+
+    finalState := PEGFsaState new.
+    fsa := node child accept: self.
+    fsa addState: finalState.
+    
+    fsa finalStates do: [ :state |
+        fsa addTransitionFrom: state to: (fsa startState).
+        fsa addTransitionFrom: state to: finalState priority: -1.
+        self assert: (state hasPriority not).
+        state priority: 0.
+        state final: false.
+    ].
+
+    fsa finalState: finalState.	
+    
+    ^ fsa
+!
+
+visitPredicateNode: node
+    | stop start fsa  |
+    start := PEGFsaState new.
+    stop := PEGFsaState new.
+    
+    fsa := PEGFsa new
+        addState: start;
+        addState: stop;
+        
+        startState: start;
+        finalState: stop;
+        yourself.
+    
+    fsa addTransitionFrom: start to: stop onCharacterSet: (node predicate classification).
+        
+    ^ fsa
+!
+
+visitSequenceNode: node
+    | childrenFsa fsa start previousFinalStates  |
+
+    childrenFsa := node children collect: [ :child | child accept: self ].
+
+    fsa := PEGFsa new.
+    start := PEGFsaState new name: 'start'; yourself.
+    fsa addState: start.
+    fsa startState: start.
+
+    fsa adopt: childrenFsa first.	
+    fsa addTransitionFrom: start to: childrenFsa first startState.
+
+    previousFinalStates := childrenFsa first finalStates.
+    childrenFsa allButFirst do: [ :childFsa | 
+        | newFinalStates |
+        newFinalStates := IdentitySet new.
+        previousFinalStates do: [ :state |
+            | copy |
+            copy := childFsa copy.
+            fsa adopt: copy.
+            
+            state isFailure ifFalse: [ 
+                state final: false.
+                fsa addTransitionFrom: state to: copy startState.
+            ].
+            newFinalStates addAll: copy finalStates.
+        ].
+        previousFinalStates := newFinalStates.
+    ].
+    ^ fsa
+!
+
+visitStarNode: node
+    | fsa finalState |
+
+    finalState := PEGFsaState new.
+    fsa := node child accept: self.
+    fsa addState: finalState.
+    
+    fsa finalStates do: [ :state |
+        fsa addTransitionFrom: state to: (fsa startState).
+        self assert: (state hasPriority not).
+        state priority: 0.
+        state final: false.
+    ].
+
+    fsa addTransitionFrom: fsa startState to: finalState priority: -1.
+    fsa finalState: finalState.
+
+    ^ fsa
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaInterpret.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,180 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PEGFsaInterpret
+	instanceVariableNames:'fsa debug retvals stream maxPriority'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-FSA'
+!
+
+!PEGFsaInterpret methodsFor:'accessing'!
+
+debug
+    ^ debug
+!
+
+debug: anObject
+    debug := anObject
+!
+
+fsa
+    ^ fsa
+! !
+
+!PEGFsaInterpret methodsFor:'debugging'!
+
+reportFsa: anFsa
+    debug ifTrue: [ 
+        Transcript show: anFsa asString; cr.
+    ]
+!
+
+reportStart
+    debug ifTrue: [ 
+        Transcript show: '============================'; cr.
+    ]
+!
+
+reportStates: states
+    debug ifTrue: [ 
+        Transcript show: 'states: '; show: states asString; cr
+    ]
+! !
+
+!PEGFsaInterpret methodsFor:'initialization'!
+
+initialize
+    super initialize.
+    debug := true
+! !
+
+!PEGFsaInterpret methodsFor:'running'!
+
+interpret
+    | states newStates character run  |
+    maxPriority := SmallInteger minVal.
+    newStates := IdentitySet with: fsa startState.
+    retvals := IdentityDictionary new.
+    
+    self recordNewState: fsa startState position: 0.
+    
+    self reportStart.
+    self reportFsa: fsa.
+    
+    run := stream atEnd not.
+    
+    [run] whileTrue: [  
+        states := newStates.
+        newStates := IdentitySet new.
+        character := stream peek.
+
+        self reportStates: states.
+
+        states do: [ :state |
+            self expand: state on: character into: newStates.
+        ].
+        
+        newStates isEmpty ifFalse: [ stream next ].
+        run := stream atEnd not and: [ newStates isEmpty not ].
+    ].
+
+    ^ self return: newStates
+!
+
+interpret: anFsa on: aStream
+    fsa := anFsa.
+    stream := aStream.
+    
+    ^ self interpret
+! !
+
+!PEGFsaInterpret methodsFor:'running support'!
+
+allowsTransition: t from: state transitionsTaken: transitionsTaken
+"	(state hasPriority) ifTrue: [ 
+        ^ state priority <= t priority
+    ].
+"	
+    "state hasPriority ifTrue: [ "
+"		transitionsTaken isEmpty ifTrue: [ ^ true ].
+        ^ transitionsTaken anyOne priority <= t priority.
+"	"]."
+    ^ true
+!
+
+expand: state on: character into: newStates "transitionsTaken: transitionsTaken"
+    | transitions transitionsTaken |
+
+    transitionsTaken := OrderedCollection new.
+    transitions := self sortedTransitionsFor: state.
+    transitions do: [ :t | 
+        (self allowsTransition: t from: state transitionsTaken: transitionsTaken) ifTrue: [ 
+            t isEpsilon ifTrue: [  
+                (t destination isFinal) ifTrue: [ 
+                    newStates add: t destination.
+                    self recordNewState: t destination position: stream position.
+                ].
+
+                "Descent into the next state"
+                self 	expand: t destination 
+                        on: character 
+                        into: newStates.
+
+                newStates isEmpty ifFalse: [ 
+                    transitionsTaken add: t.
+                ].
+
+            ] ifFalse: [  
+                (t accepts: character) ifTrue: [ 
+                    transitionsTaken add: t.
+                    newStates add: t destination.
+                    self recordNewState: t destination.
+                ]
+            ] 
+        ]
+    ]
+!
+
+recordNewState: state
+    ^ self recordNewState: state position: stream position + 1
+!
+
+recordNewState: state position: position
+    (state isFinal) ifFalse: [ ^ self ].
+    (maxPriority > state priority) ifTrue: [ ^ true ].
+        
+    self assert: state hasPriority description: 'final state must have priority'.
+    (maxPriority < state priority) ifTrue: [ 
+        retvals := IdentityDictionary new.
+        maxPriority := state priority.
+    ].
+
+
+    state retvalAsCollection do: [ :r |
+        retvals at: r put: position
+    ].
+!
+
+return: states
+    | priority priorities |
+    priorities := (states select: #hasPriority thenCollect: #priority).
+    priorities isEmpty ifTrue: [  
+        ^ retvals keysAndValuesRemove: [ :key :value | key class == PEGFsaFailure ] 
+    ].
+    
+    priority := priorities max.
+    
+    (maxPriority < priority) ifTrue: [ ^ IdentityDictionary new ].
+    ^ retvals keysAndValuesRemove: [ :key :value | key class == PEGFsaFailure ]
+!
+
+sortedTransitionsFor: state
+    ^ (fsa transitionsFor: state) asOrderedCollection
+        "Dear future me, enjoy this:"
+"		sort: [ :e1 :e2 | (e1 isEpsilon not and: [e2 isEpsilon]) not ])"
+        sort: [ :e1 :e2 | e1 priority > e2 priority ]
+            
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaPair.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,54 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PEGFsaPair
+	instanceVariableNames:'first second'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-FSA'
+!
+
+!PEGFsaPair class methodsFor:'instance creation'!
+
+with: a with: b
+    ^ PEGFsaPair new
+        first: a;
+        second: b;
+        yourself
+! !
+
+!PEGFsaPair methodsFor:'accessing'!
+
+first
+    ^ first
+!
+
+first: anObject
+    first := anObject
+!
+
+second
+    ^ second
+!
+
+second: anObject
+    second := anObject
+! !
+
+!PEGFsaPair methodsFor:'comparing'!
+
+= anObject
+    (anObject == self) ifTrue: [ ^ true ].
+    (anObject class == self class) ifFalse: [ ^ false ].
+    
+    ((anObject first == first) and: [anObject second == second]) ifTrue: [ ^ true ].
+    ((anObject first == second) and: [anObject second == first]) ifTrue: [ ^ true ].
+    
+    ^ false	
+!
+
+hash
+    ^ first hash bitXor: second hash
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaState.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,455 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PEGFsaState
+	instanceVariableNames:'name retval priority transitions final multivalue'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-FSA'
+!
+
+!PEGFsaState methodsFor:'accessing'!
+
+destination
+    self assert: transitions size = 1.
+    ^ transitions anyOne destination
+!
+
+destinations
+    ^ (transitions collect: #destination) asIdentitySet
+!
+
+final
+    ^ final
+!
+
+final: anObject
+    final := anObject
+!
+
+multivalue
+    ^ multivalue
+!
+
+multivalue: anObject
+    multivalue := anObject
+!
+
+name
+    ^ name
+!
+
+name: anObject
+    name := anObject asString
+!
+
+prefix
+    ^ 'state'
+!
+
+priority
+    ^ priority
+!
+
+priority: anObject
+    priority := anObject
+!
+
+priorityIfNone: value
+    ^ self hasPriority ifTrue: [ self priority ] ifFalse: [ value ]
+!
+
+retval
+    ^ retval
+!
+
+retval: anObject
+    retval := anObject
+!
+
+retvalAsCollection
+    ^ self isMultivalue ifTrue: [ 
+        self retval
+    ] ifFalse: [ 
+        Array with: self retval
+    ]
+!
+
+suffix
+    ^ ''
+!
+
+transitions
+    ^ transitions
+! !
+
+!PEGFsaState methodsFor:'analysis'!
+
+reachableStates
+    | openSet |
+    openSet := IdentitySet new.
+    self reachableStatesOpenSet: openSet.
+    ^ openSet
+!
+
+reachableStatesOpenSet: openSet
+    (openSet includes: self) ifTrue: [ 
+        ^ self 
+    ].
+
+    openSet add: self.
+    
+    (self transitions) do: [ :t |
+        t destination reachableStatesOpenSet: openSet
+    ].
+    
+!
+
+transitionPairs
+    | size pairs collection |
+    size := transitions size.
+    pairs := OrderedCollection new: (size - 1) * size / 2.
+    
+    collection := transitions asOrderedCollection.
+
+    1 to: (size - 1) do: [ :index1 |
+        (index1 + 1 to: size) do: [ :index2 | 
+            pairs add: (PEGFsaPair new 
+                first: (collection at: index1);
+                second: (collection at: index2);
+                yourself).
+        ]
+    ].
+    ^ pairs
+! !
+
+!PEGFsaState methodsFor:'comparing'!
+
+= anotherState
+    (self == anotherState) ifTrue: [ ^ true ].
+    (self class == anotherState class) ifFalse: [ ^ true ].
+    
+    (name == anotherState name) ifFalse: [ ^ false ].
+    (priority == anotherState priority) ifFalse: [ ^ false ].
+    (multivalue == anotherState multivalue) ifFalse: [ ^ false ].
+    (retval = anotherState retval) ifFalse: [ ^ false ].
+    (final = anotherState final) ifFalse: [ ^ false ].
+
+    (transitions size = anotherState transitions size) ifFalse: [ ^ false ].
+    transitions do: [:t |
+        (anotherState transitions contains: [:at | at = t]) ifFalse: [ ^ false ].
+    ].
+    
+    ^ true
+!
+
+canBeIsomorphicTo: anotherState
+    (name == anotherState name) ifFalse: [ ^ false ].
+    (priority == anotherState priority) ifFalse: [ ^ false ].
+    (multivalue == anotherState multivalue) ifFalse: [ ^ false ].
+    (final == anotherState final) ifFalse: [ ^ false ].
+    (transitions size == anotherState transitions size) ifFalse: [ ^ false ].
+    (retval = anotherState retval) ifFalse: [ ^ false ].
+    
+    ^ true
+!
+
+equals: anotherState
+    (self == anotherState) ifTrue: [ ^ true ].
+    (anotherState class == PEGFsaState) ifFalse: [ ^ false ].
+    
+    (retval = anotherState retval) ifFalse: [ ^ false ].
+    (multivalue = anotherState multivalue) ifFalse: [ ^ false ].
+    (self isFinal = anotherState isFinal) ifFalse: [ ^ false ].
+
+    (self hasPriority and: [anotherState hasPriority]) ifTrue: [ 	
+        (priority == anotherState priority) ifFalse: [ ^ false ].
+    ].
+
+    (transitions size == anotherState transitions size) ifFalse: [ ^ false ].
+    anotherState transitions do: [ :t | 
+        (transitions contains: [ :e | e equals: t]) ifFalse: [ ^ false ]
+    ].
+    
+    ^ true
+!
+
+hash
+    ^ retval hash bitXor: (
+        priority hash bitXor: (
+        multivalue hash bitXor:
+        "JK: Size is not the best option here, but it one gets infinite loops otherwise"
+        transitions size hash)).
+!
+
+isIsomorphicTo: anotherState resolvedSet: set
+    (self == anotherState) ifTrue: [ ^ true ].
+    
+    (name == anotherState name) ifFalse: [ ^ false ].
+    (priority == anotherState priority) ifFalse: [ ^ false ].
+    (multivalue == anotherState multivalue) ifFalse: [ ^ false ].
+    (retval = anotherState retval) ifFalse: [ ^ false ].
+    (final = anotherState final) ifFalse: [ ^ false ].
+
+    (transitions size = anotherState transitions size) ifFalse: [ ^ false ].
+    transitions do: [:t |
+        (anotherState transitions contains: [:at | t isIsomorphicto: at]) ifFalse: [ ^ false ].
+    ].
+    
+    ^ true
+! !
+
+!PEGFsaState methodsFor:'copying'!
+
+postCopy
+    super postCopy.
+    transitions := (transitions collect: [ :t | t copy ]).
+    retval := retval copy.
+! !
+
+!PEGFsaState methodsFor:'gt'!
+
+gtName
+    | gtName |
+    gtName := name.
+
+    self hasPriority ifTrue: [ 
+        gtName := gtName asString, ',', self priority asString.
+    ].
+
+    ^ gtName
+! !
+
+!PEGFsaState methodsFor:'initialization'!
+
+initialize
+    super initialize.
+    
+    transitions := OrderedCollection new.
+    multivalue := false.
+! !
+
+!PEGFsaState methodsFor:'modifications'!
+
+addTransition: t
+    self assert: (transitions identityIncludes: t) not.
+    transitions add: t
+!
+
+decreasePriority
+    (self isFinal and: [ self hasPriority not ]) ifTrue: [ 
+        priority := 0.
+    ].
+    priority isNil ifFalse: [ 
+        priority := priority - 1
+    ]
+!
+
+removeTransition: t
+    self assert: (transitions includes: t).
+    transitions remove: t
+! !
+
+!PEGFsaState methodsFor:'printing'!
+
+printNameOn: aStream
+    self name isNil
+        ifTrue: [ aStream print: self hash ]
+        ifFalse: [ aStream nextPutAll: self name ]
+!
+
+printOn: aStream
+    super printOn: aStream.
+    aStream nextPut: $(.
+    self printNameOn: aStream.
+    aStream nextPut: Character space.
+    aStream nextPutAll: self identityHash asString.
+    self isFinal ifTrue: [ 
+        aStream nextPutAll: ' FINAL'.
+    ].
+    aStream nextPut: (Character codePoint: 32).
+    aStream nextPutAll: priority asString.
+    aStream nextPut: $)
+! !
+
+!PEGFsaState methodsFor:'testing'!
+
+canHavePPCId
+    ^ true
+!
+
+hasEqualPriorityTo: state
+    "nil - nil"
+    (self hasPriority not and: [state hasPriority not]) ifTrue: [ ^ true ].
+    
+    "nil - priority"
+    (self hasPriority) ifFalse: [ ^ false ].
+    
+    "priority - nil"
+    state hasPriority ifFalse: [ ^ false ].
+    
+    "priority - priority"
+    ^ self priority = state priority 
+!
+
+hasHigherPriorityThan: state
+    "nil - nil"
+    (self hasPriority not and: [state hasPriority not]) ifTrue: [ ^ true ].
+    
+    "nil - priority"
+    (self hasPriority) ifFalse: [ ^ false ].
+    
+    "priority - nil"
+    state hasPriority ifFalse: [ ^ true ].
+    
+    "priority - priority"
+    ^ self priority > state priority 
+!
+
+hasPriority
+    ^ priority isNil not
+!
+
+isFailure
+    ^ self isFinal and: [ retval class == PEGFsaFailure ]
+!
+
+isFinal
+    final isNil ifTrue: [ ^ false ].
+    
+    final ifTrue: [
+"		self assert: self hasPriority. "
+        ^ true
+    ].
+
+    ^ false
+!
+
+isMultivalue
+    ^ multivalue
+! !
+
+!PEGFsaState methodsFor:'transformation'!
+
+determinize
+    ^ self determinize: Dictionary new.
+!
+
+determinize: dictionary
+    self transitionPairs do: [ :pair |
+        self assert: (pair first destination = pair second destination) not.
+        (pair first overlapsWith: pair second) ifTrue: [ 
+            self determinizeOverlap: pair first second: pair second joinDictionary: dictionary
+        ]
+    ].
+!
+
+determinizeOverlap: t1 second: t2 joinDictionary: dictionary
+    | pair t1Prime t2Prime tIntersection |
+    pair := PEGFsaPair with: t1 with: t2.
+
+    (dictionary includes: pair) ifTrue: [ self error: 'should not happen'.].
+    dictionary at: pair put: nil.
+    
+    tIntersection := t1 join: t2 joinDictionary: dictionary.
+    t1Prime := PEGFsaTransition new
+                    destination: t1 destination;
+                    characterSet: (t1 complement: t2);
+                    yourself.
+    t2Prime := PEGFsaTransition new
+                    destination: t2 destination;
+                    characterSet: (t2 complement: t1);
+                    yourself.					
+                                    
+                                
+    self removeTransition: t1.
+    self removeTransition: t2.
+    
+    tIntersection isEpsilon ifFalse: [ self addTransition: tIntersection  ].
+    t1Prime isEpsilon ifFalse: [ self addTransition: t1Prime ].
+    t2Prime isEpsilon ifFalse: [ self addTransition: t2Prime ].
+    
+    dictionary at: pair put: (Array 
+                                        with: tIntersection 
+                                        with: t1Prime
+                                        with: t2Prime
+                                    )
+!
+
+join: state
+    ^ self join: state joinDictionary: Dictionary new
+!
+
+join: state joinDictionary: dictionary
+    | pair newState |
+    pair := PEGFsaPair with: self with: state.
+    (dictionary includesKey: pair) ifTrue: [ ^ dictionary at: pair ].
+    
+    newState := PEGFsaState new.
+    
+    dictionary at: pair put: newState.
+    
+    self joinFinal: state newState: newState.
+    self joinPriority: state newState: newState.
+    self joinRetval: state newState: newState.
+    self joinName: state newState: newState.
+    
+    newState transitions addAll: (self transitions collect: #copy).
+    newState transitions addAll: (state transitions collect: #copy).
+    newState determinize: dictionary.
+    
+    ^ dictionary at: pair put: newState
+!
+
+joinFinal: state newState: newState
+    (self hasEqualPriorityTo: state) ifTrue: [ 
+        ^ newState final: (self isFinal or: [ state isFinal ]).
+    ].
+
+    (self hasHigherPriorityThan: state) ifTrue: [  
+        ^ newState final: self isFinal.
+    ].
+    
+    newState final: state isFinal.
+    
+!
+
+joinName: state newState: newState
+    newState name: self name asString, '-', state name asString.
+!
+
+joinPriority: state newState: newState
+    (self hasHigherPriorityThan: state) ifTrue: [ 
+ 		newState priority: self priority.	
+        ^ self
+    ].
+
+    newState priority: state priority.
+!
+
+joinRetval: state newState: newState
+    self isFinal ifFalse: [ ^ newState retval: state retval ].
+    state isFinal ifFalse: [ ^ newState retval: self retval ].
+
+    (self priority = state priority) ifTrue: [ 
+        newState multivalue: true.
+        ^ newState retval: { self retval . state retval }.
+    ].
+
+    "Both are final"
+    self priority isNil ifTrue: [ 
+        ^ newState retval: state retval.
+    ].
+
+    state priority isNil ifTrue: [ 
+        ^ newState retval: self retval.
+    ].
+
+    (self priority > state priority) ifTrue: [ 
+        ^ newState retval: self retval.
+    ].
+
+    ^ newState retval: state retval.
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaTransition.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,265 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PEGFsaTransition
+	instanceVariableNames:'characterSet destination priority'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-FSA'
+!
+
+!PEGFsaTransition methodsFor:'accessing'!
+
+characterSet
+    ^ characterSet
+!
+
+characterSet: anObject
+    characterSet := anObject
+!
+
+destination
+    ^ destination
+!
+
+destination: anObject
+    destination := anObject
+!
+
+priority
+    ^ priority
+!
+
+priority: anObject
+    priority := anObject
+! !
+
+!PEGFsaTransition methodsFor:'comparing'!
+
+= anotherTransition
+    "
+    Please note the identity comparison on destination
+    If you use equality instead of identy, you will get infinite loop.
+
+    So much for comparison by now :)	
+    "
+    (self == anotherTransition) ifTrue: [ ^ true ].
+    (self class == anotherTransition class) ifFalse: [ ^ false ].
+
+    (destination == anotherTransition destination) ifFalse: [ ^ false ].
+    (priority == anotherTransition priority) ifFalse: [ ^ false ].
+    (characterSet = anotherTransition characterSet) ifFalse: [ ^ false ].
+    
+    ^ true
+!
+
+canBeIsomorphicTo: anotherTransition
+    (priority == anotherTransition priority) ifFalse: [ ^ false ].
+    (characterSet = anotherTransition characterSet) ifFalse: [ ^ false ].
+    
+    ^ true
+!
+
+equals: anotherTransition
+    "this method is used for minimization of the FSA"
+    
+    (self == anotherTransition) ifTrue: [ ^ true ].
+
+    (destination == anotherTransition destination) ifFalse: [ ^ false ].
+    (characterSet = anotherTransition characterSet) ifFalse: [ ^ false ].
+
+    "JK: If character set and destination are the same, priority does not really matter"
+    ^ true
+!
+
+hash
+    ^ destination hash bitXor: (priority hash bitXor: characterSet hash)
+!
+
+isIsomorphicTo: object resolvedSet: set
+    (set includes: (PEGFsaPair with: self with: object)) ifTrue: [ 
+        ^ true
+    ].
+    set add: (PEGFsaPair with: self with: object).
+
+    (self == object) ifTrue: [ ^ true ].
+    (self class == object class) ifFalse: [ ^ false ].
+
+    (priority == object priority) ifFalse: [ ^ false ].
+    (characterSet = object characterSet) ifFalse: [ ^ false ].
+    (destination isIsomorphicTo: object destination resolvedSet: set) ifFalse: [ ^ false ].
+    
+    ^ true
+! !
+
+!PEGFsaTransition methodsFor:'copying'!
+
+postCopy
+    super postCopy.
+    characterSet := characterSet copy.
+! !
+
+!PEGFsaTransition methodsFor:'gt'!
+
+gtName
+    | gtName |
+    gtName := self characterSetAsString.
+    priority < 0 ifTrue: [ gtName := gtName, ',', priority asString ].
+    ^ gtName
+! !
+
+!PEGFsaTransition methodsFor:'initialization'!
+
+initialize
+    super initialize.
+    characterSet := Array new: 255 withAll: false.
+    priority := 0.
+! !
+
+!PEGFsaTransition methodsFor:'modifications'!
+
+addCharacter: character
+    characterSet at: character codePoint put: true
+!
+
+decreasePriority
+    priority := priority - 1
+! !
+
+!PEGFsaTransition methodsFor:'printing'!
+
+characterSetAsString
+    | stream |
+    stream := WriteStream on: ''.
+    self printCharacterSetOn: stream.
+    ^ stream contents
+!
+
+printCharacterSetOn: stream
+    self isEpsilon ifTrue: [ 
+        stream nextPutAll: '<epsilon>'.
+        ^ self
+    ].
+
+    stream nextPut: $[.
+    32 to: 127 do: [ :index |
+        (characterSet at: index) ifTrue: [ 
+            stream nextPut: (Character codePoint: index)
+        ]
+    ].
+    stream nextPut: $].
+!
+
+printOn: stream
+    self printCharacterSetOn: stream.
+    stream nextPutAll: ' ('.
+    priority printOn: stream.
+    stream nextPutAll: ')'.		
+    stream nextPutAll: '-->'.
+    destination printOn: stream.
+    stream nextPutAll: '(ID: '.
+    stream nextPutAll: self identityHash asString.
+    stream nextPutAll: ')'.
+! !
+
+!PEGFsaTransition methodsFor:'set operations'!
+
+complement: transition
+    | complement |
+    complement := Array new: 255.
+    
+    1 to: 255 do: [ :index |
+        complement
+            at: index 
+            put: ((self characterSet at: index) and: [(transition characterSet at: index) not])
+    ].
+
+    ^ complement
+!
+
+disjunction: transition
+    | disjunction |
+    disjunction := Array new: 255.
+    
+    1 to: 255 do: [ :index |
+        disjunction
+            at: index 
+            put: ((self characterSet at: index) xor: [transition characterSet at: index])
+    ].
+
+    ^ disjunction
+!
+
+intersection: transition
+    | intersection |
+    intersection := Array new: 255.
+    
+    1 to: 255 do: [ :index |
+        intersection
+            at: index 
+            put: ((self characterSet at: index) and: [transition characterSet at: index])
+    ].
+
+    ^ intersection
+!
+
+union: transition
+    | union |
+    union := Array new: 255.
+    
+    1 to: 255 do: [ :index |
+        union
+            at: index 
+            put: ((self characterSet at: index) or: [transition characterSet at: index])
+    ].
+
+    ^ union
+! !
+
+!PEGFsaTransition methodsFor:'testing'!
+
+accepts: character
+    ^ characterSet at: character codePoint
+!
+
+isEpsilon
+    ^ characterSet allSatisfy: [ :e | e not ]
+!
+
+overlapsWith: transition
+    ^ (self intersection: transition) anySatisfy: [ :bool | bool ]
+! !
+
+!PEGFsaTransition methodsFor:'transformation'!
+
+join: transition
+    ^ self join: transition joinDictionary: Dictionary new.
+!
+
+join: transition joinDictionary: dictionary
+    | newDestination newTransition |
+"	pair := PEGFsaPair with: self with: transition.
+    (dictionary includesKey: pair) ifTrue: [ ^ dictionary at: pair ].
+    dictionary at: pair put: nil.
+"	
+    newDestination := self destination join: transition destination joinDictionary: dictionary.
+    newDestination isNil ifTrue: [ self error: 'What a cycle!! I wonder, how does this happened!!' ].
+    
+    newTransition := PEGFsaTransition new.
+    newTransition destination: newDestination.
+    newTransition characterSet: (self intersection: transition).
+    newTransition priority: (self priority min: transition priority).
+    
+"	^ dictionary at: pair put: newTransition"
+    ^ newTransition 
+!
+
+mergeWith: transition
+    | union |
+    self assert: destination = transition destination.
+    
+    union := self union: transition.
+    self characterSet: union
+! !
+
--- a/compiler/PPCArguments.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCArguments.st	Fri Jul 24 15:06:54 2015 +0100
@@ -87,12 +87,12 @@
     self set: #merge to: value.
 !
 
-name
-    ^ self at: #name ifAbsent: #PPGeneratedParser 
+parserName
+    ^ self at: #parserName ifAbsent: #PPGeneratedParser 
 !
 
-name: value
-    self set: #name to: value.
+parserName: value
+    self set: #parserName to: value.
 !
 
 profile
@@ -111,6 +111,14 @@
     self set: #recognizingComponents to: value.
 !
 
+scannerName
+    ^ self at: #scannerName ifAbsent: #PPGeneratedScanner
+!
+
+scannerName: value
+    self set: #scannerName to: value.
+!
+
 specialize
     ^ self at: #specialize ifAbsent: true
 !
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCClassBuilder.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,154 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCClassBuilder
+	instanceVariableNames:'compiledClass compiledClassName constants instvars
+		methodDictionary compiledSuperclass'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Core'
+!
+
+!PPCClassBuilder methodsFor:'accessing'!
+
+compiledClass
+    ^ compiledClass
+!
+
+compiledClassName
+    ^ compiledClassName
+!
+
+compiledClassName: anObject
+    compiledClassName := anObject asSymbol
+!
+
+compiledSuperclass
+    ^ compiledSuperclass
+!
+
+compiledSuperclass: anObject
+    compiledSuperclass := anObject
+!
+
+constants
+    ^ constants
+!
+
+constants: anObject
+    constants := anObject
+!
+
+instvars
+    ^ instvars
+!
+
+instvars: anObject
+    instvars := anObject
+!
+
+methodDictionary
+    ^ methodDictionary
+!
+
+methodDictionary: anObject
+    methodDictionary := anObject
+! !
+
+!PPCClassBuilder methodsFor:'cleaning'!
+
+clean
+    Smalltalk at: compiledClassName ifPresent: [  :e |
+        compiledClass := e.
+        self cleanGeneratedMethods.
+    ]
+!
+
+cleanGeneratedMethods
+    ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
+        compiledClass methodsDo: [ :mthd |
+            (mthd category beginsWith: 'generated') ifTrue:[
+                compiledClass removeSelector: mthd selector.
+            ]
+        ]
+    ] ifFalse: [ 
+        (compiledClass allProtocolsUpTo: compiledClass) do: [ :protocol |
+            (protocol beginsWith: 'generated') ifTrue: [ 
+                compiledClass removeProtocol: protocol.
+            ]
+        ]
+    ]
+! !
+
+!PPCClassBuilder methodsFor:'compiling'!
+
+compileClass
+    self clean.
+
+    self installVariables.
+    self installMethods.
+    self setConstants.
+
+    ^ compiledClass
+!
+
+installMethods
+    methodDictionary values do: [ :method |
+        (compiledClass methodDictionary includesKey: method methodName) ifFalse: [ 
+            compiledClass compileSilently: method code classified: method category.
+        ]
+    ]
+!
+
+installVariables
+    | instvarString classvarString |
+    instvarString := instvars inject: '' into: [:r :e | r, ' ', e  ].
+    classvarString := constants keys inject: '' into: [:r :e | r, ' ', e  ].
+
+    compiledSuperclass 
+        subclass: compiledClassName  
+        instanceVariableNames: instvarString 
+        classVariableNames: classvarString 
+        poolDictionaries: '' 
+        category: 'PetitCompiler-Generated'.
+
+    compiledClass := Smalltalk at: compiledClassName.
+!
+
+registerPackages
+    ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
+        | rPackageOrganizer |
+        rPackageOrganizer := Smalltalk at: #RPackageOrganizer.
+        rPackageOrganizer notNil ifTrue:[
+            rPackageOrganizer default registerPackageNamed: 'PetitCompiler-Generated'.
+        ].
+    ] ifFalse: [ 
+        RPackageOrganizer default registerPackageNamed: 'PetitCompiler-Generated'.
+    ].
+!
+
+setClassVars
+    constants keysAndValuesDo: [ :key :value |
+        compiledClass classVarNamed: key put: value
+    ]
+!
+
+setConstants
+    constants keysAndValuesDo: [ :key :value |
+        compiledClass classVarNamed: key put: value
+    ]
+! !
+
+!PPCClassBuilder methodsFor:'initialization'!
+
+initialize
+    super initialize.
+    
+    methodDictionary := IdentityDictionary new.
+    constants := IdentityDictionary new.
+    instvars := IdentitySet new.
+    
+    self registerPackages.
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCCodeBlock.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,182 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCCodeBlock
+	instanceVariableNames:'buffer indentation temporaries'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Compiler-Codegen'
+!
+
+!PPCCodeBlock class methodsFor:'instance creation'!
+
+new
+    "return an initialized instance"
+
+    ^ self basicNew initialize.
+! !
+
+!PPCCodeBlock methodsFor:'as yet unclassified'!
+
+add: string
+    self nl.
+    self codeIndent.
+    self addOnLine: string.
+
+    "Modified: / 01-06-2015 / 22:58:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+addOnLine: string
+    buffer nextPutAll: string.
+!
+
+nl
+    ^ buffer nextPut: Character cr
+! !
+
+!PPCCodeBlock methodsFor:'code generation'!
+
+code: aStringOrBlockOrRBParseNode
+    aStringOrBlockOrRBParseNode isString ifTrue:[ 
+        self emitCodeAsString: aStringOrBlockOrRBParseNode
+    ] ifFalse:[
+        (aStringOrBlockOrRBParseNode isKindOf: RBProgramNode) ifTrue:[ 
+            self emitCodeAsRBNode: aStringOrBlockOrRBParseNode.
+        ] ifFalse:[  
+            self emitCodeAsBlock: aStringOrBlockOrRBParseNode
+        ].
+    ].
+
+    "Created: / 01-06-2015 / 21:07:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 03-06-2015 / 05:52:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeIndent
+    self codeIndent:indentation
+
+    "Created: / 01-06-2015 / 22:58:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeIndent: level
+    ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ 
+        level * 4 timesRepeat: [ buffer nextPut: Character space  ].
+    ] ifFalse:[ 
+        level timesRepeat: [ buffer nextPut: Character tab  ].
+    ].
+
+    "Created: / 01-06-2015 / 22:58:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCodeBlock methodsFor:'code generation - variables'!
+
+allocateTemporaryVariableNamed:preferredName 
+    "Allocate a new variable with (preferably) given name.
+     Returns a real variable name that should be used."
+    
+    (temporaries includes:preferredName) ifFalse:[
+        temporaries add:preferredName.
+        ^ preferredName
+    ] ifTrue:[
+        | name |
+
+        name := preferredName , '_' , (temporaries size + 1) printString.
+        temporaries add:name.
+        ^ name
+    ].
+
+    "Created: / 23-04-2015 / 17:37:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-06-2015 / 21:03:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCodeBlock methodsFor:'indentation'!
+
+dedent
+    indentation := indentation - 1
+!
+
+indent 
+    indentation := indentation + 1
+!
+
+indentationLevel
+    ^ indentation
+!
+
+indentationLevel: value
+    indentation := value
+! !
+
+!PPCCodeBlock methodsFor:'initialization'!
+
+initialize
+    "Invoked when a new instance is created."
+
+    buffer := String new writeStream.
+    indentation := 1.
+    temporaries := OrderedCollection new.
+
+    "Modified: / 01-06-2015 / 20:57:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified (comment): / 18-06-2015 / 06:04:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCodeBlock methodsFor:'printing and storing'!
+
+codeOn: aStream
+    "Dumps generated code on given stream"
+
+    temporaries notEmpty ifTrue:[
+        ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ 
+            indentation * 4 timesRepeat: [ aStream nextPut: Character space  ].
+        ] ifFalse:[ 
+            indentation timesRepeat: [ aStream nextPut: Character tab  ].
+        ].
+        aStream nextPut: $|.
+        temporaries do:[:e | aStream space; nextPutAll: e  ].
+        aStream space.
+        aStream nextPut: $|. 
+        self nl.
+        "In Smalltalk/X, there should be a blank line after temporaries"
+        ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ 
+            self nl.
+        ].
+    ].
+    aStream nextPutAll: buffer contents
+
+    "Created: / 01-06-2015 / 21:26:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCodeBlock methodsFor:'private'!
+
+emitCodeAsBlock: aBlock
+    aBlock value
+!
+
+emitCodeAsRBNode: anRBNode
+    anRBNode isSequence ifTrue:[
+        anRBNode temporaries do:[:e |  
+            (temporaries includes: e name) ifFalse:[ 
+                temporaries add: e name
+            ].
+        ].
+        anRBNode statements do:[:e|
+            self 	add: (self formatRBNode: e); 
+                    addOnLine: '.'.
+        ].
+    ] ifFalse:[  
+        buffer nextPutAll: anRBNode formattedCode.  
+    ].
+
+!
+
+emitCodeAsString: aString
+    buffer nextPutAll: aString
+!
+
+formatRBNode: anRBNode
+    | formatter |
+    formatter := anRBNode formatterClass new.
+    formatter indent: indentation.
+    ^ formatter format: anRBNode 
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCCodeGen.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,574 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCCodeGen
+	instanceVariableNames:'compilerStack compiledParser methodCache currentMethod constants
+		returnVariable arguments idCache'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Compiler-Codegen'
+!
+
+!PPCCodeGen class methodsFor:'instance creation'!
+
+new
+    "return an initialized instance"
+
+    ^ self on: PPCArguments default
+!
+
+on: aPPCArguments
+    "return an initialized instance"
+
+    ^ self basicNew
+        initialize;
+        arguments: aPPCArguments
+! !
+
+!PPCCodeGen methodsFor:'accessing'!
+
+arguments: args
+    arguments := args
+!
+
+constants
+    ^ constants
+!
+
+currentMethod
+    ^ currentMethod 
+!
+
+currentNonInlineMethod
+    ^ compilerStack 
+        detect:[:m | m isInline not ] 
+        ifNone:[ self error: 'No non-inlined method']
+
+    "Created: / 23-04-2015 / 17:33:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+currentReturnVariable
+    ^ currentMethod returnVariable 
+!
+
+ids
+    ^ idCache keys
+!
+
+methodCategory
+    ^ 'generated'
+!
+
+methodDictionary
+    ^ methodCache
+!
+
+methodFor: object
+    | id |
+    id := self idFor: object.
+    ^ methodCache at: id ifAbsent: [ nil ]
+! !
+
+!PPCCodeGen methodsFor:'code generation'!
+
+add: string
+    currentMethod add: string.
+!
+
+addConstant: value as: name    
+    (constants includesKey: name) ifTrue:[ 
+        (constants at: name) ~= value ifTrue:[ 
+            self error:'Duplicate constant!!'.
+        ].
+        ^ self.
+    ].
+    constants at: name put: value
+
+    "Modified: / 29-05-2015 / 07:22:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+addOnLine: string
+    currentMethod addOnLine: string.
+!
+
+addVariable: name
+    ^ self currentNonInlineMethod addVariable: name
+
+    "Modified: / 23-04-2015 / 17:34:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+call: anotherMethod
+    currentMethod add: anotherMethod call.
+!
+
+callOnLine: anotherMethod
+    currentMethod addOnLine: anotherMethod call.
+!
+
+dedent
+    currentMethod dedent
+!
+
+indent
+    currentMethod indent
+!
+
+nl
+    currentMethod nl
+!
+
+smartRemember: parser to: variableName 
+    parser isContextFree ifTrue: [ 
+        self 	codeAssign: 'context lwRemember.' 
+                to: variableName.
+    ] ifFalse: [ 
+        self  codeAssign: 'context remember.'
+                to: variableName.
+    ]
+!
+
+smartRestore: parser from: mementoName
+    parser isContextFree ifTrue: [ 
+        self add: 'context lwRestore: ', mementoName, '.'.
+    ] ifFalse: [ 
+        self add: 'context restore: ', mementoName, '.'.
+    ]
+! !
+
+!PPCCodeGen methodsFor:'coding'!
+
+code:aStringOrBlockOrRBParseNode
+    currentMethod code: aStringOrBlockOrRBParseNode
+
+    "Created: / 01-06-2015 / 23:49:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeAssign: code to: variable
+    self assert: variable isNil not.
+    
+    "TODO JK: Hack alert, whatever is magic constant!!"
+    (variable == #whatever) ifFalse: [ 
+        "Do not assign, if somebody does not care!!"
+        self add: variable ,' := ', code.
+    ]
+!
+
+codeAssignParsedValueOf:aBlock to:aString 
+    | tmpVarirable  method |
+
+    self assert:aBlock isBlock.
+    self assert:aString isNil not.
+    tmpVarirable := returnVariable.
+    returnVariable := aString.
+    method := [
+            aBlock value
+        ] ensure:[ returnVariable := tmpVarirable ].
+    method isInline ifTrue:[
+        self callOnLine:method
+    ] ifFalse:[
+        self codeEvaluateAndAssign:(method call) to:aString.
+    ]
+
+    "Created: / 23-04-2015 / 18:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeBlock: contents
+    currentMethod codeBlock: contents
+
+    "Created: / 01-06-2015 / 22:35:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeClearError
+    self add: 'self clearError.'.
+!
+
+codeComment: string
+    currentMethod add: '"', string, '"'.
+!
+
+codeDot
+    self addOnLine:'.'.
+
+    "Created: / 16-06-2015 / 06:09:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeError
+    self add: 'self error: ''message notspecified''.'.
+!
+
+codeError: errorMessage
+    self add: 'self error: ''', errorMessage, '''.'
+!
+
+codeError: errorMessage at: position
+    self add: 'self error: ''', errorMessage, ''' at: ', position asString, '.'
+!
+
+codeEvaluate: selector argument: argument on: variable
+    self assert: variable isNil not.
+    
+    "TODO JK: Hack alert, whatever is magic constant!!"
+    (variable == #whatever) ifFalse: [ 
+        "Do not assign, if somebody does not care!!"
+        self add: variable, ' ', selector,' ', argument.
+ 		] ifTrue: [ 
+        "In case argument has a side effect"
+ 				self add: argument	
+    ]
+!
+
+codeEvaluateAndAssign: argument to: variable
+    self assert: variable isNil not.
+    
+    "TODO JK: Hack alert, whatever is magic constant!!"
+    (variable == #whatever) ifFalse: [ 
+        "Do not assign, if somebody does not care!!"
+        self add: variable ,' := ', argument.
+    ] ifTrue: [ 
+        "In case an argument has a side effect"
+ 		self add: argument.	
+    ]
+!
+
+codeHalt
+    self add: 'self halt. '
+!
+
+codeHaltIfShiftPressed
+    arguments debug ifTrue: [
+        ((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifFalse:[  
+            self add: 'Halt ifShiftPressed.'
+        ]
+    ]
+
+    "Modified: / 10-05-2015 / 07:39:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeIf: condition then: then 
+    self codeIf: condition then: then else: nil
+
+    "Created: / 16-06-2015 / 06:07:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeIf: condition then: then else: else
+    currentMethod 
+        add: '(';
+        code: condition;
+        addOnLine: ')'.
+    then notNil ifTrue:[ 
+        currentMethod 
+            addOnLine:' ifTrue:';
+            codeBlock: then.
+    ].
+    else notNil ifTrue:[ 
+        currentMethod 
+            addOnLine:' ifFalse:';
+            codeBlock: else.
+    ].
+    self codeDot.
+
+    "Created: / 01-06-2015 / 22:43:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 16-06-2015 / 06:09:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeIfErrorThen: then
+    ^ self codeIf: 'error' then: then else: nil
+
+    "Created: / 16-06-2015 / 06:06:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeIfErrorThen: then else: else
+    ^ self codeIf: 'error' then: then else: else
+
+    "Created: / 16-06-2015 / 06:05:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeNextToken
+    self add: 'self nextToken.'
+
+    "Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 23-04-2015 / 20:51:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeProfileStart
+    self add: 'context methodInvoked: #', currentMethod methodName, '.'
+
+    "Created: / 01-06-2015 / 21:17:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeProfileStop
+    self add: 'context methodFinished: #', currentMethod methodName, '.'
+
+    "Created: / 01-06-2015 / 21:19:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeReturn
+   currentMethod isInline ifTrue: [
+		"If inlined, the return variable already holds the value"
+	] ifFalse: [
+		arguments profile ifTrue:[ 
+			self codeProfileStop.
+		]. 
+		self add: '^ ', currentMethod returnVariable  
+	].
+
+	"Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified: / 01-06-2015 / 21:49:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeReturn: code
+    " - returns whatever is in code OR
+      - assigns whatever is in code into the returnVariable"
+    currentMethod isInline ifTrue:[
+        self codeEvaluateAndAssign: code to: currentMethod returnVariable. 
+    ] ifFalse: [ 
+        arguments profile ifTrue:[ 
+            self codeProfileStop.
+        ].   
+        self add: '^ ', code            
+    ]
+
+    "Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-06-2015 / 21:48:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeStoreValueOf: aBlock intoVariable: aString
+    | tmpVarirable method |
+    self assert: aBlock isBlock.
+    self assert: aString isNil not.
+    
+    tmpVarirable := returnVariable.
+    returnVariable := aString.
+    method := [  
+        aBlock value 
+    ] ensure: [ 
+        returnVariable := tmpVarirable 
+    ].
+    
+    method isInline ifTrue: [ 
+        self callOnLine: method 
+    ] ifFalse: [ 
+        self codeEvaluateAndAssign: (method call) to: aString.
+    ]	
+    
+    "Created: / 23-04-2015 / 18:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeTokenGuard: node ifFalse: codeBlock
+    | guard id |
+    guard := PPCTokenGuard on: node.
+    (guard makesSense) ifTrue: [ 
+        id := self idFor: guard firstToken.
+
+        self add: 'self ', id asString, ' ifFalse: ['.
+            self indent.
+            codeBlock value.
+            self dedent.
+        self add: '].'.
+    ]
+!
+
+codeTranscriptShow: text
+    (arguments profile) ifTrue: [ 
+        self add: 'Transcript show: ', text storeString, '; cr.'.
+    ]
+! !
+
+!PPCCodeGen methodsFor:'ids'!
+
+asSelector: string
+    "e.g. '234znak 43 ) 2' asLegalSelector = #v234znak432"
+    
+    | toUse |
+
+    toUse := string select: [:char | char isAlphaNumeric or: [ char = $_ ] ].
+    (toUse isEmpty or: [ toUse first isLetter not ])
+        ifTrue: [ toUse := 'v', toUse ].
+    toUse first isUppercase ifFalse:[
+        toUse := toUse copy.
+        toUse at: 1 put: toUse first asLowercase
+    ].
+    ^toUse
+
+    "Modified: / 10-05-2015 / 07:29:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+idFor: object
+    self assert: (object canHavePPCId).
+    ^ self idFor: object prefixed: object prefix suffixed: object suffix
+!
+
+idFor: object prefixed: prefix
+    ^ self idFor: object prefixed: prefix suffixed: ''
+!
+
+idFor: object prefixed: prefix suffixed: suffix
+    | name id |
+    ^ idCache at: object ifAbsentPut: [ 
+        ((object canHavePPCId) and: [object name isNotNil]) ifTrue: [ 
+            "Do not use prefix, if there is a name"
+            name := self asSelector: (object name asString).
+            id := (name, suffix) asSymbol.
+            
+            "Make sure, that the generated ID is uniqe!!"
+            (idCache includes: id) ifTrue: [ 
+                (id, '_', idCache size asString) asSymbol 
+            ] ifFalse: [ 
+                id
+            ]
+        ] ifFalse: [ 
+            (prefix, '_', (idCache size asString), suffix) asSymbol
+        ]
+    ]
+!
+
+idFor: object suffixed: suffix
+    self assert: (object isKindOf: PPCNode) description: 'Shold use PPCNode for ids'.
+    ^ self idFor: object prefixed: object prefix suffixed: suffix effect: #none
+! !
+
+!PPCCodeGen methodsFor:'initialization'!
+
+copy: parser
+    self halt: 'deprecated?'.
+    ^ parser transform: [ :p | p copy ].
+!
+
+initialize
+    super initialize.
+
+    compilerStack := Stack new.
+    methodCache := IdentityDictionary new.
+    constants := Dictionary new.
+    idCache := IdentityDictionary new.
+! !
+
+!PPCCodeGen methodsFor:'profiling'!
+
+profileTokenRead: tokenName
+    arguments profile ifTrue: [ 
+        self add: 'context tokenRead: ', tokenName storeString, '.'
+    ]
+! !
+
+!PPCCodeGen methodsFor:'support'!
+
+cache: id as: value
+    methodCache at: id put: value.
+!
+
+cachedValue: id
+    ^ methodCache at: id ifAbsent: [ nil ]
+!
+
+cachedValue: id ifPresent: block
+    ^ methodCache at: id ifPresent: block
+!
+
+checkCache: id
+    | method  |
+    
+    "self halt: 'deprecated?'."
+    
+    "Check if method is hand written"
+    method := compiledParser ifNotNil: [ compiledParser compiledMethodAt: id ifAbsent: [ nil ] ].
+    method ifNotNil: [ ^ PPCCompiledMethod new id: id; yourself ].
+    
+    ^ self cachedValue: id
+!
+
+pop
+    | retval |
+    retval := compilerStack pop.
+    currentMethod := compilerStack isEmpty 
+        ifTrue: [ nil ]
+        ifFalse: [ compilerStack top ].
+    ^ retval
+
+    "Modified: / 21-11-2014 / 12:27:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+push
+    compilerStack push: currentMethod.
+    (compilerStack size > 500 )ifTrue: [ self error: 'unless it is very complex grammar, there is an error somewhere' ]
+
+    "Modified: / 21-11-2014 / 12:27:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+startInline: id
+    | indentationLevel |
+    (methodCache includesKey: id) ifTrue: [ self error: 'OOOUPS!!' ].
+    indentationLevel := currentMethod indentationLevel.
+    
+    currentMethod := PPCInlinedMethod new.
+    currentMethod id: id.   
+    currentMethod returnVariable: returnVariable.
+    currentMethod indentationLevel: indentationLevel.
+    self push.
+
+    "Modified: / 01-06-2015 / 21:48:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+startMethod: id
+    (methodCache includesKey: id) ifTrue: [ self error: 'OOOUPS!!' ].
+
+    currentMethod := PPCMethod new.
+    currentMethod id: id.
+    currentMethod category: self methodCategory.
+    
+    arguments profile ifTrue:[ 
+        self codeProfileStart.
+    ].
+    self push.      
+                
+    self cache: id as: currentMethod.
+
+    "Modified: / 01-06-2015 / 21:19:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+stopInline
+    ^ self pop.
+
+    "Modified: / 01-06-2015 / 21:37:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+stopMethod
+   self cache: currentMethod methodName as: currentMethod.
+	
+	"arguments profile ifTrue: [ Transcript show: currentMethod code; cr. ]."
+	^ self pop.
+
+	"Modified: / 01-06-2015 / 21:38:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+top
+    ^ compilerStack top
+! !
+
+!PPCCodeGen methodsFor:'variables'!
+
+allocateReturnVariable    
+    ^ self allocateReturnVariableNamed: 'retval'
+
+    "Created: / 23-04-2015 / 18:03:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 15-06-2015 / 17:52:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+allocateReturnVariableNamed: name
+    "Allocate (or return previously allocated one) temporary variable used for
+     storing a parser's return value (the parsed object)"                 
+    ^ currentMethod allocateReturnVariableNamed: name
+
+    "Created: / 15-06-2015 / 18:04:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+allocateTemporaryVariableNamed: preferredName 
+    "Allocate a new variable with (preferably) given name.
+     Returns a real variable name that should be used."
+    
+    ^ self currentNonInlineMethod allocateTemporaryVariableNamed: preferredName
+
+    "Created: / 23-04-2015 / 17:33:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- a/compiler/PPCCodeGenerator.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCCodeGenerator.st	Fri Jul 24 15:06:54 2015 +0100
@@ -33,6 +33,88 @@
     ^ arguments guards
 ! !
 
+!PPCCodeGenerator methodsFor:'code generation'!
+
+generateChoiceChildOf: choiceNode atIndex: choiceChildNodeIndex useGuards: useGuards storeResultInto: resultVar
+
+    | children |
+
+    children := choiceNode children.
+    useGuards ifTrue:[
+        self addGuard: (children at: choiceChildNodeIndex) ifTrue: [ 
+                    compiler add: 'self clearError.'.
+                    compiler 
+                          codeAssignParsedValueOf:[ self visit:(children at: choiceChildNodeIndex) ]
+                          to: resultVar.
+                    compiler add: 'error ifFalse: [ '.
+                    compiler codeReturn: resultVar.  
+                    compiler add: ' ].'.
+                ] ifFalse:[ 
+                    compiler add: 'error := true.'.
+                ].
+                compiler add: 'error ifTrue:[ '.
+                choiceChildNodeIndex < children size ifTrue:[ 
+                    self generateChoiceChildOf: choiceNode atIndex: choiceChildNodeIndex + 1 useGuards: useGuards storeResultInto: resultVar.
+                ] ifFalse:[ 
+                    compiler codeError: 'no choice suitable'.
+                ].
+                compiler addOnLine: '].'.
+    
+    ] ifFalse:[ 
+                choiceChildNodeIndex <= children size ifTrue:[ 
+                    compiler add: 'self clearError.'.
+                    compiler 
+                          codeAssignParsedValueOf:[ self visit:(children at: choiceChildNodeIndex) ]
+                          to: resultVar.
+                    compiler add: 'error ifFalse: [ '.
+                    compiler codeReturn: resultVar.  
+                    compiler add: ' ].'.
+                    self generateChoiceChildOf: choiceNode atIndex: choiceChildNodeIndex + 1 useGuards: useGuards storeResultInto: resultVar.
+                ] ifFalse:[ 
+                    compiler codeError: 'no choice suitable'.
+                ].
+    ].
+
+    
+!
+
+generateSequenceChildOf: sequenceNode atIndex: sequenceNodeChildIndex useMememntoVar: mementoVar storeResultInto: elementVars
+        | child childValueVar |
+
+        child := sequenceNode children at: sequenceNodeChildIndex.
+        childValueVar := elementVars at: sequenceNodeChildIndex.
+        compiler codeAssignParsedValueOf: [ self visit:child ] 
+                                      to: childValueVar.
+        child acceptsEpsilon ifFalse: [   
+            compiler codeIfErrorThen: [
+                "Handle error in the first element in a special way,
+                 because one does not need to do backtracking  if the first element fails."
+                (sequenceNodeChildIndex == 1) ifTrue: [                         
+                    compiler codeReturn: 'failure'
+                ] ifFalse: [
+                    compiler smartRestore: sequenceNode from: mementoVar.
+                    compiler codeReturn: 'failure.'.
+                ]
+            ] else:[ 
+                sequenceNode returnParsedObjectsAsCollection ifTrue:[
+                    compiler add: self retvalVar , ' at: ', sequenceNodeChildIndex asString, ' put: ', childValueVar, '.'.
+                ].
+                (sequenceNodeChildIndex < sequenceNode children size) ifTrue:[ 
+                    self generateSequenceChildOf: sequenceNode atIndex: sequenceNodeChildIndex + 1 useMememntoVar: mementoVar storeResultInto: elementVars.
+                ].
+            ]
+
+        ] ifTrue:[
+            sequenceNode returnParsedObjectsAsCollection ifTrue:[
+                compiler add: self retvalVar , ' at: ', sequenceNodeChildIndex asString, ' put: ', childValueVar, '.'.
+            ].
+            (sequenceNodeChildIndex < sequenceNode children size) ifTrue:[ 
+                    self generateSequenceChildOf: sequenceNode atIndex: sequenceNodeChildIndex + 1 useMememntoVar: mementoVar storeResultInto: elementVars.
+
+            ].
+        ]
+! !
+
 !PPCCodeGenerator methodsFor:'guards'!
 
 addGuard: node ifTrue: trueBlock ifFalse: falseBlock
@@ -107,12 +189,33 @@
     ^ compiler checkCache: (compiler idFor: node)
 ! !
 
+!PPCCodeGenerator methodsFor:'private'!
+
+withAllVariableNodesOf: anRBProgramNode do: aBlock
+    "Enumerate all chilren of `anRBProgramNode` (including itself)
+     and evaluate `aBlock` for each variable node.
+     This is a replacement for Smalltalk/X's RBProgramNode>>variableNodesDo:
+     which is not present in Pharo"
+
+    anRBProgramNode isVariable ifTrue:[ 
+        aBlock value: anRBProgramNode.
+        ^ self.
+    ].
+    anRBProgramNode children do:[:each | 
+        self withAllVariableNodesOf: each do: aBlock
+    ].
+
+    "Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !PPCCodeGenerator methodsFor:'support'!
 
 compileTokenWhitespace: node
     compiler add: 'context atWs ifFalse: ['.
     compiler indent.
-        compiler codeStoreValueOf: [ self visit: node whitespace ] intoVariable: #whatever.
+        compiler 
+              codeAssignParsedValueOf:[ self visit:node whitespace ]
+              to:#whatever.
         compiler add: 'context setWs.'.
     compiler dedent.
     compiler add: '].'.
@@ -155,23 +258,25 @@
 !
 
 retvalVar
-    ^ compiler currentReturnVariable 
+    ^ compiler currentReturnVariable
+
+    "Modified: / 15-06-2015 / 18:20:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 startMethodForNode:node
     node isMarkedForInline ifTrue:[ 
-		compiler startInline: (compiler idFor: node).
-		compiler addComment: 'BEGIN inlined code of ' , node printString.
-		compiler indent.
+        compiler startInline: (compiler idFor: node).
+        compiler addComment: 'BEGIN inlined code of ' , node printString.
+        compiler indent.
     ] ifFalse:[ 
-		compiler startMethod: (compiler idFor: node).
-		compiler addComment: 'GENERATED by ' , node printString.
-		compiler allocateReturnVariable.
+        compiler startMethod: (compiler idFor: node).
+        compiler addComment: 'GENERATED by ' , node printString.
+        compiler allocateReturnVariable.
     ].
 
     "Created: / 23-04-2015 / 15:51:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 23-04-2015 / 19:13:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified (comment): / 23-04-2015 / 21:31:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified (format): / 15-06-2015 / 18:03:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 stopMethodForNode:aPPCNode
@@ -204,19 +309,102 @@
 !PPCCodeGenerator methodsFor:'visiting'!
 
 visitActionNode: node
-    | blockId |
+    | blockNode blockBody blockNodesVar blockNeedsCollection blockMatches childValueVars |
+
+    blockNode := node block sourceNode copy.
+    self assert: blockNode arguments size == 1.
+    blockNodesVar := blockNode arguments first .
+    blockBody := blockNode body.
+
+    "Now, analyze block body, search for all references to
+     block arg <barg> and check if in all cases it's used 
+     in one of the following patterns:
+
+        * <barg> first , <barg> second, ... , <barg> sixth
+        * <barg> at: <integer constant>
+
+     If so, then the block code can be inlined and the intermediate
+     result collection need not to be created. Keep this information
+     in temporary `blockNeedsCollection`. 
+     During the analysis, remember all nodes that matches the pattern
+     in a dictionary `blockMatches` mapping the node to actual temporary
+     variable where the node is used. This will be later used for block's node
+     rewriting"
+    blockNeedsCollection := true.
+    node child isSequenceNode ifTrue:[
+        blockNeedsCollection := false.
+        blockMatches := IdentityDictionary new."Must use IDENTITY dict as nodes have overwritten their #=!!!!!!"
+        childValueVars := node child preferredChildrenVariableNames.
+        self withAllVariableNodesOf: blockBody do:[:variableNode| 
+            variableNode name = blockNodesVar name ifTrue:[ 
+                "Check if variable node matches..."
+                variableNode parent isMessage ifTrue:[ 
+                    | parent |
+
+                    parent := variableNode parent.
+                    "Check for <barg> at: <number>"
+                    ((parent selector == #at:) and:[ parent arguments first isLiteralNumber ]) ifTrue:[ 
+                        blockMatches at: parent put: (childValueVars at: parent arguments first value).
+                    ] ifFalse:[ 
+                        "Check for <barg> first / second / ..."
+                        | i |
 
-    blockId := 'block_', (compiler idFor: node).
-    compiler addConstant: node block as: blockId.
-        
-    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
-    compiler add: 'error ifFalse: ['.
-    compiler codeReturn: blockId, ' value: ', self retvalVar.
-    compiler add: '] ifTrue: ['.
-    compiler codeReturn: 'failure'.
-    compiler add: '].'.
+                        i := #(first second third fourth fifth sixth) indexOf: parent selector.
+                        i ~~ 0 ifTrue:[ 
+                            blockMatches at: parent put: (childValueVars at: i).
+                        ] ifFalse:[ 
+                            blockNeedsCollection := true.
+                        ].
+                    ].
+                ] ifFalse:[ 
+                    blockNeedsCollection := true.
+                ].
+            ].
+        ].
+    ].
 
-    "Modified: / 23-04-2015 / 15:59:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    blockNeedsCollection ifTrue:[
+        "Bad, we have to use the collection.
+         Replace all references to blockNodeVar to retvalVar..."
+        self withAllVariableNodesOf: blockBody do:[:variableNode| 
+            variableNode name = blockNodesVar name ifTrue:[ 
+                variableNode name: self retvalVar.
+            ].
+        ].
+    ] ifFalse:[ 
+        "Good, can avoid intermediate collection.
+         Replace references to collection with corresponding temporary variable"
+        blockMatches keysAndValuesDo:[:matchingNode :childValueVar |
+            matchingNode parent replaceNode: matchingNode withNode: (RBVariableNode named: childValueVar).
+        ].
+        node child returnParsedObjectsAsCollection: false. 
+    ].
+
+    "Block return value is return value of last statement.
+     So if the method is not inline, make last statement a return.
+        if the method is inline, make it assignment to retvalVar."
+    blockBody statements notEmpty ifTrue:["Care for empty blocks - [:t | ] !!"
+        compiler currentMethod isInline ifTrue:[ 
+            |  assignment |
+
+            assignment := RBAssignmentNode variable: (RBVariableNode named: self retvalVar) value:  blockBody statements last.
+            blockBody replaceNode: blockBody statements last withNode: assignment.
+        ] ifFalse:[  
+            | return |
+
+            return := RBReturnNode value: blockBody statements last.
+            blockBody replaceNode: blockBody statements last withNode: return.
+        ].
+    ].
+
+    compiler codeAssignParsedValueOf:[ self visit:node child ] to:self retvalVar.
+    compiler codeIfErrorThen: [ 
+        compiler codeReturn: 'failure'. 
+    ] else: [
+        compiler code: blockBody.    
+    ]
+
+    "Modified: / 19-06-2015 / 07:05:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 visitAndNode: node
@@ -225,7 +413,9 @@
     mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
     compiler smartRemember: node child to: mementoVar.
 
-    compiler codeStoreValueOf: [ self visit: node child  ] intoVariable: self retvalVar.
+    compiler 
+          codeAssignParsedValueOf:[ self visit:node child ]
+          to:self retvalVar.
     compiler smartRestore: node child from: mementoVar.
 
     compiler codeReturn.
@@ -292,33 +482,15 @@
 !
 
 visitChoiceNode: node
-    |  whitespaceConsumed elementVar |
-    "The code is not ready for inlining"
-    self assert: node isMarkedForInline not.
+    |  whitespaceConsumed useGuards resultVar  |
+
+    resultVar := compiler allocateTemporaryVariableNamed: 'element'.
+    whitespaceConsumed := self addGuardTrimming: node.
+    useGuards := whitespaceConsumed.
+    self generateChoiceChildOf: node atIndex: 1 useGuards: useGuards storeResultInto: resultVar
     
 
-    elementVar := compiler allocateTemporaryVariableNamed: 'element'.
-    whitespaceConsumed :=	 self addGuardTrimming: node.
-
-    1 to: node children size do: [ :idx  | |child allowGuard |
-        child := node children at: idx.
-        allowGuard := whitespaceConsumed.
-
-        allowGuard ifTrue: [ 
-            self addGuard: child ifTrue: [ 
-                compiler add: 'self clearError.'.
-                compiler codeStoreValueOf:  [self visit: child] intoVariable: elementVar.
-                compiler add: 'error ifFalse: [ ^ ', elementVar, ' ].'.
-            ] ifFalse: nil.
-        ] ifFalse: [ 
-                compiler add: 'self clearError.'.
-                compiler codeStoreValueOf:  [self visit: child] intoVariable: elementVar.
-                compiler add: 'error ifFalse: [ ^ ', elementVar, ' ].'.
-        ]
-    ].
-    compiler codeError: 'no choice suitable'.
-
-    "Modified: / 23-04-2015 / 21:40:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 29-05-2015 / 07:17:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 visitEndOfFileNode: node
@@ -327,17 +499,21 @@
 
 visitEndOfInputNode: node
 
-    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
-    compiler add: 'context atEnd ifTrue: ['.
-    compiler codeReturn.	
-    compiler add: '] ifFalse: ['.
-    compiler codeError: 'End of input expected'.
-    compiler add: ']'.
+    compiler 
+          codeAssignParsedValueOf:[ self visit:node child ]
+          to:self retvalVar.
+    compiler codeIf: 'context atEnd' 
+                then: [ compiler codeReturn ]
+                else: [ compiler codeError: 'End of input expected' ].
+        
+    "Modified: / 26-05-2015 / 19:03:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 visitForwardNode: node
 
-    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
+    compiler 
+          codeAssignParsedValueOf:[ self visit:node child ]
+          to:self retvalVar.
     compiler codeReturn.
 !
 
@@ -357,6 +533,71 @@
     compiler add: '].'.
 !
 
+visitMappedActionNode: node
+    | child blockNode blockBody |
+
+    child := node child.
+    blockNode := node block sourceNode copy.
+    blockBody := blockNode body.
+
+    "Block return value is return value of last statement.
+     So if the method is not inline, make last statement a return.
+        if the method is inline, make it assignment to retvalVar."
+    compiler currentMethod isInline ifTrue:[ 
+        |  assignment |
+
+        assignment := RBAssignmentNode variable: (RBVariableNode named: self retvalVar) value:  blockBody statements last.
+        blockBody replaceNode: blockBody statements last withNode: assignment.
+    ] ifFalse:[  
+        | return |
+
+        return := RBReturnNode value: blockBody statements last.
+        blockBody replaceNode: blockBody statements last withNode: return.
+    ].
+
+    child isSequenceNode ifTrue:[  
+        child isMarkedForInline ifTrue:[ 
+            child preferredChildrenVariableNames: blockNode argumentNames.
+            child returnParsedObjectsAsCollection: false.
+        ].
+    ] ifFalse:[ 
+        "Child is not a sequence so it 'returns' only one object.
+         Therefore the block takes only one argument and it's value
+         is value of child's retval.
+         In the block, replace all references to block argument to
+         my retvalVar. "
+        | blockArg |
+
+        blockArg := blockNode arguments first.
+        self withAllVariableNodesOf: blockBody do:[:variableNode| 
+            variableNode name = blockArg name ifTrue:[ 
+                variableNode name: self retvalVar.
+            ].
+        ]. 
+    ].
+
+    compiler codeAssignParsedValueOf: [ self visit: child ] to: self retvalVar.
+    compiler codeIf: 'error' then: [ 
+        compiler codeReturn: 'failure'. 
+    ] else: [
+        "If the child is sequence and not inlined, extract
+         nodes from returned collection into used-to-be block variables"
+        (child isSequenceNode and:[ child returnParsedObjectsAsCollection ]) ifTrue:[
+            blockNode arguments withIndexDo:[ :arg :idx |
+                node child isMarkedForInline ifFalse:[ 
+                    compiler allocateTemporaryVariableNamed: arg name.
+                    compiler codeAssign: (self retvalVar , ' at: ', idx printString) to: arg name.
+                ].
+                compiler addOnLine: '.'; nl.
+            ].
+        ].
+        compiler code: blockBody.    
+    ]
+
+    "Created: / 02-06-2015 / 17:28:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 19-06-2015 / 07:06:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 visitMessagePredicateNode: node
     compiler add: '(context peek ', node message, ') ifFalse: ['.
     compiler codeError: 'predicate not found'.
@@ -443,7 +684,7 @@
     mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
     compiler smartRemember: node child to: mementoVar.
     
-    compiler codeStoreValueOf: [ self visit: node child  ] intoVariable: #whatever.
+    compiler codeAssignParsedValueOf:[ self visit:node child ] to:#whatever.
     compiler smartRestore: node child from: mementoVar.
 
     compiler add: '^ error ifFalse: [ self error ] ifTrue: [ self clearError. nil ]'.
@@ -452,7 +693,9 @@
 !
 
 visitOptionalNode: node
-    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
+    compiler 
+          codeAssignParsedValueOf:[ self visit:node child ]
+          to:self retvalVar.
     compiler add: 'error ifTrue: [ '.
     compiler indent.
     compiler add: 'self clearError. '.
@@ -475,32 +718,37 @@
                 
     elementVar := compiler allocateTemporaryVariableNamed:  'element'.
      
-"	self tokenGuards ifTrue: [ 
+"       self tokenGuards ifTrue: [ 
         compiler codeTokenGuard: node ifFalse: [ compiler codeError: 'at least one occurence expected' ].   
     ].
 "        
     compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
-    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
+    compiler codeAssignParsedValueOf:[ self visit:node child ] to:elementVar.
 
     compiler add: 'error ifTrue: ['.
     compiler codeError: 'at least one occurence expected'.
     compiler add: '] ifFalse: ['.
     compiler indent.
-        compiler add: self retvalVar , ' add: ',elementVar , '.'.
-            
-        compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
+        (self retvalVar ~~ #whatever) ifTrue:[
+            compiler add: self retvalVar , ' add: ',elementVar , '.'.
+        ].            
+        compiler codeAssignParsedValueOf:[ self visit:node child ] to:elementVar.
         compiler add: '[ error ] whileFalse: ['.
         compiler indent.
-        compiler add: self retvalVar , ' add: ',elementVar , '.'.
-        compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
+        (self retvalVar ~~ #whatever) ifTrue:[
+            compiler add: self retvalVar , ' add: ',elementVar , '.'.
+        ].
+        compiler codeAssignParsedValueOf:[ self visit:node child ] to:elementVar.
         compiler dedent.
         compiler add: '].'.
         compiler add: 'self clearError.'.
-        compiler codeReturn: self retvalVar , ' asArray.'.         
+        (self retvalVar ~~ #whatever) ifTrue:[ 
+            compiler codeReturn: self retvalVar , ' asArray.'.         
+        ].
     compiler dedent.
     compiler add: '].'.
 
-    "Modified (comment): / 23-04-2015 / 21:30:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 26-05-2015 / 19:04:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 visitPredicateNode: node
@@ -530,12 +778,14 @@
         compiler smartRemember: node to: mementoVar.
     ].
 
-    compiler codeStoreValueOf: [ self visit: (node children at: 1) ] intoVariable: #whatever.
+    compiler 
+          codeAssignParsedValueOf:[ self visit:(node children at:1) ]
+          to:#whatever.
     compiler add: 'error ifTrue: [ ^ failure ].'.
 
     2 to: (node children size) do: [ :idx  | |child|
         child := node children at: idx.
-        compiler codeStoreValueOf: [ self visit: child ] intoVariable: #whatever.
+        compiler codeAssignParsedValueOf:[ self visit:child ] to:#whatever.
         
         child acceptsEpsilon ifFalse: [   
             compiler add: 'error ifTrue: [ '.
@@ -550,55 +800,43 @@
 
 visitSequenceNode: node
 
-    | elementVar mementoVar canBacktrack |
+    | elementVars mementoVar canBacktrack  |
 
-    elementVar := compiler allocateTemporaryVariableNamed: 'element'.
+    elementVars := node preferredChildrenVariableNames.
+    elementVars do:[:e | 
+        compiler allocateTemporaryVariableNamed: e.  
+    ].
+
     canBacktrack := (node children allButFirst allSatisfy: [:e | e acceptsEpsilon ]) not.
 
-"	self addGuardTrimming: node.
+"       self addGuardTrimming: node.
     self addGuard: node ifTrue: nil ifFalse: [ compiler addOnLine: ' ^ self error' ].
 "
     canBacktrack ifTrue: [ 
         mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
         compiler smartRemember: node to: mementoVar.
     ].
-    
-    compiler codeAssign: 'Array new: ', node children size asString, '.' to: self retvalVar.
 
-    compiler codeStoreValueOf: [ self visit: (node children at: 1)]  intoVariable: elementVar.
-    compiler add: 'error ifTrue: [ ^ failure ].'.
-    compiler add: self retvalVar , ' at: 1 put: ', elementVar, '.'.
-    
-    2 to: (node children size) do: [ :idx  | |child|
-        child := node children at: idx.
-        compiler codeStoreValueOf: [ self visit: child ]  intoVariable: elementVar.
-      
-        child acceptsEpsilon ifFalse: [   
-            compiler add: 'error ifTrue: [ '.
-            compiler indent.
-            compiler smartRestore: node from: mementoVar.
-            compiler add: '^ failure.'.
-            compiler dedent.
-            compiler add: '].'.
-        ].
-        compiler add: self retvalVar , ' at: ', idx asString, ' put: ',elementVar,'.'.
+    node returnParsedObjectsAsCollection ifTrue:[
+        compiler codeAssign: 'Array new: ', node children size asString, '.' to: self retvalVar.
     ].
+    self generateSequenceChildOf: node atIndex: 1 useMememntoVar: mementoVar storeResultInto: elementVars.
     compiler codeReturn
 
-    "Modified: / 23-04-2015 / 22:03:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified (comment): / 16-06-2015 / 06:38:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 visitStarAnyNode: node
     | retvalVar sizeVar |
 
-    retvalVar := compiler allocateReturnVariable.
+    retvalVar := self retvalVar.
     sizeVar := compiler allocateTemporaryVariableNamed: 'size'.  
     compiler add: sizeVar , ' := context size - context position.'.
     compiler add: retvalVar,' := Array new: ',sizeVar,'.'.
     compiler add: '(1 to: ',sizeVar,') do: [ :e | ',retvalVar,' at: e put: context next ].'.
     compiler codeReturn.
-    
-    "Modified: / 05-05-2015 / 14:13:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+
+    "Modified: / 15-06-2015 / 18:53:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 visitStarCharSetPredicateNode: node
@@ -639,11 +877,11 @@
     self addGuard: node child ifTrue: nil ifFalse: [ compiler codeReturn: '#()' ].
 
     compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
-    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
+    compiler codeAssignParsedValueOf:[ self visit:node child ] to:elementVar.
     compiler add: '[ error ] whileFalse: ['.
     compiler indent.
     compiler add: self retvalVar, ' add: ', elementVar, '.'.
-    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
+    compiler codeAssignParsedValueOf:[ self visit:node child ] to:elementVar.
     compiler dedent.
     compiler add: '].'.
     compiler codeClearError.
@@ -654,7 +892,7 @@
     | elementVar |
     
     elementVar := compiler allocateTemporaryVariableNamed: 'element'.	
-    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
+    compiler codeAssignParsedValueOf:[ self visit:node child ] to:elementVar.
     compiler add: 'error ifFalse: [ '.
     compiler codeReturn: elementVar, ' ', node block asString, '.'.
     compiler add: '] ifTrue: ['.
@@ -681,7 +919,7 @@
     compiler profileTokenRead: (compiler idFor: node).
     
     compiler codeAssign: 'context position + 1.' to: startVar.
-    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
+    compiler codeAssignParsedValueOf:[ self visit:node child ] to:#whatever.
     compiler add: 'error ifFalse: [ '.
     compiler indent.	
     compiler codeAssign: 'context position.' to: endVar.
@@ -710,7 +948,7 @@
 !
 
 visitTokenWhitespaceNode: node
-    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
+    compiler codeAssignParsedValueOf:[ self visit:node child ] to:#whatever.
     compiler codeReturn.
 !
 
@@ -723,7 +961,9 @@
     compiler smartRemember: node child to: mementoVar.
     compiler add: 'context skipSeparators.'.
 
-    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
+    compiler 
+          codeAssignParsedValueOf:[ self visit:node child ]
+          to:self retvalVar.
     
     compiler add: 'error ifTrue: [ '.
     compiler indent.
@@ -763,7 +1003,7 @@
     ].
 
     compiler codeAssign: 'context position + 1.' to: startVar.
-    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
+    compiler codeAssignParsedValueOf:[ self visit:node child ] to:#whatever.
 
     (arguments guards and: [(guard := PPCGuard on: node) makesSense]) ifTrue: [ 
         compiler dedent.
@@ -802,9 +1042,11 @@
     compiler codeClearError.
     compiler add: '(', self retvalVar, ' := ', id, ' parseOn: context) isPetitFailure'.
     compiler indent.
-    compiler add: ' ifTrue: [self error: retval message at: ', self retvalVar, ' position ].'.
+    compiler add: ' ifTrue: [self error: ', self retvalVar, ' message at: ', self retvalVar, ' position ].'.
     compiler dedent.
     compiler add: 'error := ', self retvalVar, ' isPetitFailure.'.
     compiler codeReturn.
+
+    "Modified: / 15-06-2015 / 17:59:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
--- a/compiler/PPCCompiler.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCCompiler.st	Fri Jul 24 15:06:54 2015 +0100
@@ -17,21 +17,15 @@
 new
     "return an initialized instance"
 
-    ^ self basicNew initializeForCompiledClassName: 'PPGeneratedParser'
-!
-
-newForCompiledClassName: aString
-    "return an initialized instance"
-	self halt: 'deprecated'.
-    ^ self basicNew initializeForCompiledClassName: aString
+    ^ self on: PPCArguments default
 !
 
 on: aPPCArguments
     "return an initialized instance"
 
     ^ self basicNew
-		arguments: aPPCArguments;
-		initializeForCompiledClassName: aPPCArguments name
+                arguments: aPPCArguments;
+                initializeForCompiledClassName: aPPCArguments parserName
 ! !
 
 !PPCCompiler methodsFor:'accessing'!
@@ -71,12 +65,12 @@
 !PPCCompiler methodsFor:'cleaning'!
 
 clean: class
-"	Transcript crShow: 'Cleaning time: ',
+"	Transcript show: ('Cleaning time: ',
     [	
 "		self cleanGeneratedMethods: class.
         self cleanInstVars: class.
         self cleanConstants: class.
-"	] timeToRun asMilliSeconds asString, 'ms'."
+"	] timeToRun asMilliSeconds asString, 'ms'); cr. "
 !
 
 cleanConstants: class
@@ -117,8 +111,16 @@
     currentMethod add: '"', string, '"'.
 !
 
-addConstant: value as: name
+addConstant: value as: name    
+    (constants includesKey: name) ifTrue:[ 
+        (constants at: name) ~= value ifTrue:[ 
+            self error:'Duplicate constant!!'.
+        ].
+        ^ self.
+    ].
     constants at: name put: value
+
+    "Modified: / 29-05-2015 / 07:22:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 addOnLine: string
@@ -171,6 +173,12 @@
 
 !PPCCompiler methodsFor:'code generation - coding'!
 
+code:aStringOrBlockOrRBParseNode
+    currentMethod code: aStringOrBlockOrRBParseNode
+
+    "Created: / 01-06-2015 / 23:49:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 codeAssign: code to: variable
     self assert: variable isNil not.
     
@@ -181,10 +189,42 @@
     ]
 !
 
+codeAssignParsedValueOf:aBlock to:aString 
+    | tmpVarirable  method |
+
+    self assert:aBlock isBlock.
+    self assert:aString isNil not.
+    tmpVarirable := returnVariable.
+    returnVariable := aString.
+    method := [
+            aBlock value
+        ] ensure:[ returnVariable := tmpVarirable ].
+    self assert: (method isKindOf: PPCMethod).
+    method isInline ifTrue:[
+        self callOnLine:method
+    ] ifFalse:[
+        self codeEvaluateAndAssign:(method call) to:aString.
+    ]
+
+    "Created: / 23-04-2015 / 18:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeBlock: contents
+    currentMethod codeBlock: contents
+
+    "Created: / 01-06-2015 / 22:35:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 codeClearError
     self add: 'self clearError.'.
 !
 
+codeDot
+    self addOnLine:'.'.
+
+    "Created: / 16-06-2015 / 06:09:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 codeError
     self add: 'self error: ''message notspecified''.'.
 !
@@ -204,9 +244,9 @@
     (variable == #whatever) ifFalse: [ 
         "Do not assign, if somebody does not care!!"
         self add: variable, ' ', selector,' ', argument.
- 	] ifTrue: [ 
+ 		] ifTrue: [ 
         "In case argument has a side effect"
- 		self add: argument	
+ 				self add: argument	
     ]
 !
 
@@ -237,6 +277,45 @@
     "Modified: / 10-05-2015 / 07:39:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
+codeIf: condition then: then 
+    self codeIf: condition then: then else: nil
+
+    "Created: / 16-06-2015 / 06:07:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeIf: condition then: then else: else
+    currentMethod 
+        add: '(';
+        code: condition;
+        addOnLine: ')'.
+    then notNil ifTrue:[ 
+        currentMethod 
+            addOnLine:' ifTrue:';
+            codeBlock: then.
+    ].
+    else notNil ifTrue:[ 
+        currentMethod 
+            addOnLine:' ifFalse:';
+            codeBlock: else.
+    ].
+    self codeDot.
+
+    "Created: / 01-06-2015 / 22:43:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 16-06-2015 / 06:09:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeIfErrorThen: then
+    ^ self codeIf: 'error' then: then else: nil
+
+    "Created: / 16-06-2015 / 06:06:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeIfErrorThen: then else: else
+    ^ self codeIf: 'error' then: then else: else
+
+    "Created: / 16-06-2015 / 06:05:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 codeNextToken
     self add: 'self nextToken.'
 
@@ -244,28 +323,65 @@
     "Modified: / 23-04-2015 / 20:51:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
+codeProfileStart
+    self add: 'context methodInvoked: #', currentMethod methodName, '.'
+
+    "Created: / 01-06-2015 / 21:17:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeProfileStop
+    self add: 'context methodFinished: #', currentMethod methodName, '.'
+
+    "Created: / 01-06-2015 / 21:19:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 codeReturn
    currentMethod isInline ifTrue: [
-				"If inlined, the return variable already holds the value"
-		] ifFalse: [
-				self add: '^ ', currentMethod returnVariable  
-   ].
+		"If inlined, the return variable already holds the value"
+	] ifFalse: [
+		arguments profile ifTrue:[ 
+			self codeProfileStop.
+		]. 
+		self add: '^ ', currentMethod returnVariable  
+	].
 
 	"Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-	"Modified: / 23-04-2015 / 20:51:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified: / 01-06-2015 / 21:49:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 codeReturn: code
     " - returns whatever is in code OR
       - assigns whatever is in code into the returnVariable"
-   currentMethod isInline ifTrue:[ 
+    currentMethod isInline ifTrue:[
         self codeEvaluateAndAssign: code to: currentMethod returnVariable. 
-   ] ifFalse: [ 
-        self add: '^ ', code 		
+    ] ifFalse: [ 
+        arguments profile ifTrue:[ 
+            self codeProfileStop.
+        ].   
+        self add: '^ ', code            
     ]
 
     "Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 23-04-2015 / 20:51:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-06-2015 / 21:48:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeReturnParsedValueOf:aBlock 
+    | tmpVarirable  method |
+
+    self assert:aBlock isBlock.	
+    tmpVarirable := returnVariable.
+    method := aBlock value. 
+    self assert: returnVariable == tmpVarirable.
+    self assert: (method isKindOf: PPCMethod).
+    method isInline ifTrue:[
+        self callOnLine:method.
+        self codeReturn: returnVariable.
+    ] ifFalse:[
+        self codeReturn: method call.
+        
+    ]
+
+    "Created: / 23-04-2015 / 18:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 codeStoreValueOf: aBlock intoVariable: aString
@@ -419,12 +535,11 @@
     
     currentMethod := PPCInlinedMethod new.
     currentMethod id: id.   
-    currentMethod profile: arguments profile.
     currentMethod returnVariable: returnVariable.
     currentMethod indentationLevel: indentationLevel.
     self push.
 
-    "Modified: / 23-04-2015 / 18:28:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-06-2015 / 21:48:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 startMethod: id
@@ -432,28 +547,29 @@
 
     currentMethod := PPCMethod new.
     currentMethod id: id.
-    currentMethod profile: arguments profile.    
+    arguments profile ifTrue:[ 
+        self codeProfileStart.
+    ].
     self push.      
                 
     self cache: id as: currentMethod.
 
-    "Modified: / 23-04-2015 / 18:36:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-06-2015 / 21:19:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 stopInline
-
     ^ self pop.
 
-    "Modified: / 23-04-2015 / 18:28:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-06-2015 / 21:37:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 stopMethod
-    self cache: currentMethod methodName as: currentMethod.
-    
-    "arguments profile ifTrue: [ Transcript show: currentMethod code; cr. ]."
-    ^ self pop.
+   self cache: currentMethod methodName as: currentMethod.
+	
+	"arguments profile ifTrue: [ Transcript show: currentMethod code; cr. ]."
+	^ self pop.
 
-    "Modified: / 01-05-2015 / 14:18:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified: / 01-06-2015 / 21:38:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 top
@@ -462,13 +578,19 @@
 
 !PPCCompiler methodsFor:'code generation - variables'!
 
-allocateReturnVariable
-    "Return a new variable to store parsed value"
+allocateReturnVariable    
+    ^ self allocateReturnVariableNamed: 'retval'
+
+    "Created: / 23-04-2015 / 18:03:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 15-06-2015 / 17:52:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
 
-   ^ currentMethod allocateReturnVariable 
+allocateReturnVariableNamed: name
+    "Allocate (or return previously allocated one) temporary variable used for
+     storing a parser's return value (the parsed object)"                 
+    ^ currentMethod allocateReturnVariableNamed: name
 
-    "Created: / 23-04-2015 / 17:58:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified (comment): / 23-04-2015 / 21:12:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Created: / 15-06-2015 / 18:04:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 allocateTemporaryVariableNamed: preferredName 
@@ -527,7 +649,7 @@
     self initialize.
     compilerStack := Stack new.
     cache := IdentityDictionary new.
-    constants := IdentityDictionary new.
+    constants := Dictionary new.
     ids := IdentityDictionary new.
     
 
@@ -550,6 +672,8 @@
 
 
     Transcript cr; show: 'intialized for: ', aString; cr.
+
+    "Modified: / 26-05-2015 / 17:09:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !PPCCompiler class methodsFor:'documentation'!
--- a/compiler/PPCConfiguration.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCConfiguration.st	Fri Jul 24 15:06:54 2015 +0100
@@ -32,8 +32,8 @@
 !PPCConfiguration methodsFor:'accessing'!
 
 arguments
- 	arguments isNil ifTrue: [ arguments := self defaultArguments ].
-	^ arguments
+ 		arguments isNil ifTrue: [ arguments := self defaultArguments ].
+		^ arguments
 !
 
 arguments: args
@@ -41,7 +41,7 @@
 !
 
 defaultArguments
- 	^ PPCArguments default
+ 		^ PPCArguments default
 !
 
 input: whatever
--- a/compiler/PPCContextMemento.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCContextMemento.st	Fri Jul 24 15:06:54 2015 +0100
@@ -99,7 +99,7 @@
     self keysAndValuesDo: [ :key :value |
         (anObject hasProperty: key) ifFalse: [ ^ false ].
         ((anObject propertyAt: key) = value) ifFalse: [ ^ false ]. 
- 	].
+ 		].
     
     ^ true.
 !
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCFSACodeGen.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,211 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCCodeGen subclass:#PPCFSACodeGen
+	instanceVariableNames:'fsa backlinkStates'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Scanner'
+!
+
+!PPCFSACodeGen methodsFor:'accessing'!
+
+methodCategory
+    ^ 'generated - scanning'
+! !
+
+!PPCFSACodeGen methodsFor:'analysis'!
+
+beginOfRange: characterSet
+    characterSet withIndexDo: [ :e :index | 
+        e ifTrue: [ ^ index ]
+    ].
+    self error: 'should not happend'
+!
+
+endOfRange: characterSet
+    | change |
+    change := false.
+    characterSet withIndexDo: [ :e :index | 
+        e ifTrue: [ change := true ].
+        (e not and: [ change ]) ifTrue: [ ^ index - 1]
+    ].
+    ^ characterSet size
+!
+
+isLetter: characterSet
+    | changes previous |
+    changes := 0.
+    previous := false.
+    characterSet withIndexDo: [ :e :index |
+        (e == (Character codePoint: index) isLetter) ifFalse: [ ^ false ].
+    ].
+    ^ true
+!
+
+isSingleCharacter: characterSet
+    ^ (characterSet select: [ :e | e ]) size = 1
+!
+
+isSingleRange: characterSet
+    | changes previous |
+    changes := 0.
+    previous := false.
+    characterSet do: [ :e | 
+        (e == previous) ifFalse: [ changes := changes + 1 ].
+        previous := e.
+    ].
+    ^ changes < 3
+! !
+
+!PPCFSACodeGen methodsFor:'coding'!
+
+codeAbsoluteReturn: code
+    self add: '^ ', code
+!
+
+codeAssertPeek: characterSet
+    | character id extendedCharacterSet |
+    
+    (self isSingleCharacter: characterSet) ifTrue: [ 
+        character := self character: characterSet.
+        self addOnLine: 'self peek == ', character storeString.
+        ^ self
+    ].
+
+    (self isLetter: characterSet) ifTrue: [ 
+        self addOnLine: 'self peek isLetter'.
+        ^ self
+    ].
+
+    (self isSingleRange: characterSet) ifTrue: [ 
+        | begin end |
+        begin := self beginOfRange: characterSet.
+        end := self endOfRange: characterSet.
+        self addOnLine: 'self peekBetween: ', begin asString, ' and: ', end asString.
+        ^ self
+    ].
+
+    extendedCharacterSet := (characterSet asOrderedCollection addLast: false; yourself) asArray.
+    id := self idFor: characterSet prefixed: 'characterSet'.
+    
+    self addConstant: extendedCharacterSet as: id.
+    self addOnLine: id, ' at: self peek asInteger'.
+!
+
+codeAssertPeek: characterSet ifTrue: block
+    self addOnLine: '('.
+    self codeAssertPeek: characterSet.
+    self addOnLine: ') ifTrue: ['.
+    self indent.
+    self code: block.
+    self dedent.
+    self add: ']'.
+!
+
+codeAssertPeek: characterSet orReturn: priority
+    self add: '('.
+    self codeAssertPeek: characterSet.
+    self addOnLine: ') ifFalse: [ '.
+    self codeReturnResult: priority.
+    self addOnLine: ']'.
+    self codeDot.
+!
+
+codeAssertPeek: characterSet whileTrue: block
+    self add: '['.
+    self codeAssertPeek: characterSet.
+    self addOnLine: '] whileTrue: ['.
+    self indent.
+    self code: block.
+    self dedent.
+    self add: '].'.
+    self nl.
+!
+
+codeEndBlock
+    self dedent.	
+    self add: ']'.
+!
+
+codeEndBlockWhileTrue
+    self dedent.	
+    self add: '] whileTrue.'.
+!
+
+codeIfFalse
+    self addOnLine: ' ifFalse: ['.
+!
+
+codeNextChar
+    self add: 'self step.'
+!
+
+codeNl
+    self add: ''.
+!
+
+codeNlAssertPeek: characterSet
+    self add: ''.
+    self codeAssertPeek: characterSet.
+!
+
+codeNlReturnResult
+    self add: '^ self return.'
+!
+
+codeNlReturnResult: priority
+    priority isNil ifTrue: [ 
+        ^ self codeNlReturnResult
+    ].
+    self add: '^ self returnPriority: ', priority asString, '.'
+!
+
+codeRecordMatch: state
+    self add: 'self recordMatch: ', state storeString, '.'
+!
+
+codeRecordMatch: state priority: priority
+    priority isNil ifTrue: [ 
+        ^ self codeRecordMatch: state
+    ].
+    
+    self add: 'self recordMatch: ', state storeString, ' priority: ', priority asString, '.'
+!
+
+codeReturnResult
+    self addOnLine: '^ self return.'
+!
+
+codeReturnResult: priority
+    priority isNil ifTrue: [ 
+        ^ self codeReturnResult
+    ].
+
+    self addOnLine: '^ self returnPriority: ', priority asString, '.'
+!
+
+codeStartBlock
+    self add: '['.
+    self indent.
+! !
+
+!PPCFSACodeGen methodsFor:'helpers'!
+
+character: characterSet
+    self assert: (self isSingleCharacter: characterSet).
+    characterSet withIndexDo: [ :e :index | e ifTrue: [ ^ Character codePoint: index ] ].
+    
+    self error: 'should not happen'
+! !
+
+!PPCFSACodeGen methodsFor:'intitialization'!
+
+initialize
+    super initialize.
+    backlinkStates := IdentityDictionary new.
+
+    "Modified: / 24-07-2015 / 15:03:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- a/compiler/PPCInlinedMethod.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCInlinedMethod.st	Fri Jul 24 15:06:54 2015 +0100
@@ -6,7 +6,7 @@
 	instanceVariableNames:''
 	classVariableNames:''
 	poolDictionaries:''
-	category:'PetitCompiler-Core'
+	category:'PetitCompiler-Compiler-Codegen'
 !
 
 !PPCInlinedMethod methodsFor:'as yet unclassified'!
@@ -16,7 +16,9 @@
 !
 
 code
-    ^ buffer contents trimRight
+    ^ (String streamContents:[:s | buffer codeOn:s ]) trimRight
+
+    "Modified (format): / 01-06-2015 / 21:44:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 isInline
@@ -31,6 +33,12 @@
    "Created: / 23-04-2015 / 21:06:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
+allocateReturnVariableNamed: name
+    self error: 'return variable must be assigned by the non-inlined method....'
+
+    "Created: / 15-06-2015 / 17:52:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 allocateTemporaryVariableNamed:aString
     self error: 'sorry, I can''t allocate variables....'
 
--- a/compiler/PPCInliningVisitor.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCInliningVisitor.st	Fri Jul 24 15:06:54 2015 +0100
@@ -37,6 +37,13 @@
     ^ node
 !
 
+visitActionNode: node
+    node child markForInline.
+    ^ super visitActionNode: node.
+
+    "Created: / 13-05-2015 / 16:25:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 visitCharSetPredicateNode: node
     ^ self markForInline: node
 !
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCMappedActionNode.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,19 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCActionNode subclass:#PPCMappedActionNode
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Nodes'
+!
+
+!PPCMappedActionNode methodsFor:'visiting'!
+
+accept: visitor
+    ^ visitor visitMappedActionNode: self
+
+    "Created: / 02-06-2015 / 17:27:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- a/compiler/PPCMethod.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCMethod.st	Fri Jul 24 15:06:54 2015 +0100
@@ -3,11 +3,10 @@
 "{ NameSpace: Smalltalk }"
 
 Object subclass:#PPCMethod
-	instanceVariableNames:'buffer variables indentation id profile variableForReturn
-		category'
+	instanceVariableNames:'buffer id variableForReturn category profile'
 	classVariableNames:''
 	poolDictionaries:''
-	category:'PetitCompiler-Core'
+	category:'PetitCompiler-Compiler-Codegen'
 !
 
 
@@ -41,19 +40,30 @@
 !
 
 code
-    ^ self methodName, Character cr asString,  
-        self variables, Character cr asString,
-        self profilingBegin, Character cr asString,
-        self body, Character cr asString
-"               self profilingEnd"
+    ^ String streamContents: [ :s |
+        s nextPutAll: self methodName; cr.
+        buffer codeOn: s.    
+    ]
 
-    "Modified: / 23-04-2015 / 19:26:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-06-2015 / 21:24:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 id: value
     id := value
 !
 
+indentationLevel
+    ^ buffer indentationLevel
+
+    "Created: / 01-06-2015 / 21:38:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+indentationLevel: anInteger
+    buffer indentationLevel: anInteger
+
+    "Created: / 01-06-2015 / 21:38:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 methodName
     ^ id
 !
@@ -69,48 +79,88 @@
 !PPCMethod methodsFor:'as yet unclassified'!
 
 add: string
-    self nl.
-    indentation timesRepeat: [ buffer nextPut: Character tab  ].
-    self addOnLine: string.
+    buffer add: string
+
+    "Modified: / 01-06-2015 / 21:09:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 addOnLine: string
-    buffer nextPutAll: string.
+    buffer addOnLine: string
+
+    "Modified: / 01-06-2015 / 21:09:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 call
     ^ 'self ', self methodName, '.'.
 !
 
-nl
-    ^ buffer nextPut: Character cr
-!
-
 profilingBegin
     self profile ifTrue: [ 
- 				^ '  context methodInvoked: #', id, '.'	
+ 								^ '  context methodInvoked: #', id, '.'	
     ].
     ^ ''
 !
 
 profilingEnd
     self profile ifTrue: [ 
- 				^ '  context methodFinished: #', id, '.'	
+ 								^ '  context methodFinished: #', id, '.'	
     ].
     ^ ''
 ! !
 
-!PPCMethod methodsFor:'code generation - variables'!
+!PPCMethod methodsFor:'code generation'!
+
+code: aStringOrBlockOrRBParseNode
+    buffer code: aStringOrBlockOrRBParseNode.
+
+    "Created: / 01-06-2015 / 22:31:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified (format): / 01-06-2015 / 23:50:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeBlock: contents
+    | outerBlock innerBlock |
+
+    outerBlock := buffer.
+    innerBlock := PPCCodeBlock new.
+    innerBlock indentationLevel: outerBlock indentationLevel + 1.  
+    [ 
+        outerBlock addOnLine:'['.
+        buffer := innerBlock.
+        self code: contents.
+    ] ensure:[
+        outerBlock 
+            code: (String streamContents:[:s | innerBlock codeOn: s]);
+            add:']'.
+        buffer := outerBlock.
+    ]
 
-addVariable: name
-    (variables includes: name) ifTrue:[ 
-        self error:'Duplicate variable name, must rename'.
-    ].
-    variables add: name.
+    "Created: / 01-06-2015 / 22:33:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 03-06-2015 / 06:11:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCMethod methodsFor:'code generation - indenting'!
+
+dedent
+    buffer dedent
+
+    "Created: / 01-06-2015 / 21:32:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
 
-    "Modified: / 23-04-2015 / 12:29:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+indent
+    buffer indent
+
+    "Created: / 01-06-2015 / 21:32:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
+nl
+
+    buffer nl
+
+    "Created: / 01-06-2015 / 21:52:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCMethod methodsFor:'code generation - variables'!
+
 allocateReturnVariable
     
 	^ variableForReturn isNil ifTrue:[ 
@@ -122,65 +172,52 @@
     "Created: / 23-04-2015 / 18:03:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
+allocateReturnVariableNamed: name    
+    "Allocate temporary variable used for storing a parser's return value (the parsed object)"
+
+    variableForReturn notNil ifTrue:[ 
+        self error: 'Return variable already allocated!!'.
+        ^ self.
+    ]. 
+    variableForReturn := self allocateTemporaryVariableNamed: name.
+    ^ variableForReturn
+
+    "Created: / 15-06-2015 / 17:52:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 allocateTemporaryVariableNamed:preferredName 
     "Allocate a new variable with (preferably) given name.
      Returns a real variable name that should be used."
-    
-    (variables includes:preferredName) ifFalse:[
-	variables add:preferredName.
-	^ preferredName
-    ] ifTrue:[
-	| name |
 
-	name := preferredName , '_' , (variables size + 1) printString.
-	variables add:name.
-	^ name
-    ].
+    ^ buffer allocateTemporaryVariableNamed: preferredName
 
     "Created: / 23-04-2015 / 17:37:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-06-2015 / 21:04:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
-returnVariable
-    ^  variableForReturn
+returnVariable    
+    ^ variableForReturn
 
     "Created: / 23-04-2015 / 20:50:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified (format): / 15-06-2015 / 18:12:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 returnVariable: aString
-    ^ variableForReturn := aString
+    (variableForReturn notNil and:[variableForReturn ~= aString]) ifTrue:[ 
+         self error: 'Return variable already allocated with different name (''', variableForReturn , ''' vs ''', aString,''')'.
+    ].
+    variableForReturn := aString
 
     "Created: / 23-04-2015 / 18:23:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 23-04-2015 / 21:08:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-variables
-    ^ '  | ', (variables inject: '' into: [ :s :e | s, ' ', e]), ' |'
-! !
-
-!PPCMethod methodsFor:'indentation'!
-
-dedent
-    indentation := indentation - 1
-!
-
-indent 
-    indentation := indentation + 1
-!
-
-indentationLevel
-    ^ indentation
-!
-
-indentationLevel: value
-    indentation := value
+    "Modified: / 15-06-2015 / 18:14:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !PPCMethod methodsFor:'initialization'!
 
 initialize
-    buffer := WriteStream on: ''.
-    indentation := 1.
-    variables := OrderedCollection new.
+    buffer := PPCCodeBlock new.
+
+    "Modified: / 01-06-2015 / 21:33:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !PPCMethod methodsFor:'printing'!
--- a/compiler/PPCNilNode.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCNilNode.st	Fri Jul 24 15:06:54 2015 +0100
@@ -9,6 +9,7 @@
 	category:'PetitCompiler-Nodes'
 !
 
+
 !PPCNilNode methodsFor:'accessing'!
 
 prefix
@@ -35,3 +36,10 @@
     ^ visitor visitNilNode: self
 ! !
 
+!PPCNilNode class methodsFor:'documentation'!
+
+version_HG
+
+    ^ '$Changeset: <not expanded> $'
+! !
+
--- a/compiler/PPCNode.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCNode.st	Fri Jul 24 15:06:54 2015 +0100
@@ -241,7 +241,7 @@
         finite := self.
         infinite := anotherNode.
     ] ifFalse: [ 
- 				finite := anotherNode.
+ 								finite := anotherNode.
         infinite := self.	
     ].
         
@@ -488,17 +488,32 @@
     super printOn: aStream.
     aStream nextPut: $(.
     self printNameOn: aStream.
+    self isMarkedForInline ifTrue:[ 
+        aStream nextPutAll: ' INL'
+    ].
     aStream nextPut: $)
+
+    "Modified: / 22-05-2015 / 15:34:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !PPCNode methodsFor:'testing'!
 
+canHavePPCId
+    ^ true
+!
+
 isMarkedForInline
     ^ self propertyAt: #inlined ifAbsent: [ false ].
 
     "Created: / 23-04-2015 / 15:40:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
+isSequenceNode
+    ^ false
+
+    "Created: / 15-06-2015 / 18:29:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 isTokenNode
     ^ false
 !
@@ -513,6 +528,12 @@
     ^ self
 !
 
+asFsa
+    | visitor |
+    visitor := PEGFsaGenerator new.
+    ^ visitor visit: self
+!
+
 replace: node with: anotherNode
 !
 
--- a/compiler/PPCNodeVisitor.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCNodeVisitor.st	Fri Jul 24 15:06:54 2015 +0100
@@ -167,6 +167,12 @@
     ^ self visitNode: node.
 !
 
+visitMappedActionNode: node
+    ^ self visitActionNode: node
+
+    "Created: / 02-06-2015 / 17:28:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 visitMessagePredicateNode: node
     ^ self visitNode: node
 !
--- a/compiler/PPCProfilingContext.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCProfilingContext.st	Fri Jul 24 15:06:54 2015 +0100
@@ -77,9 +77,9 @@
 
     sender := thisContext sender.
     selector := (sender receiver isKindOf: PPCompiledParser) ifTrue: [ 
- 				sender selector.
+ 								sender selector.
     ] ifFalse: [ 
- 				sender receiver class.	
+ 								sender receiver class.	
     ].
     remembers add: selector.
     ^ super remember
@@ -90,9 +90,9 @@
     
     sender := thisContext sender.
     selector := (sender receiver isKindOf: PPCompiledParser) ifTrue: [ 
- 				sender selector.
+ 								sender selector.
     ] ifFalse: [ 
- 				sender receiver class.	
+ 								sender receiver class.	
     ].
     
     
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCScanner.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,80 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCScanner
+	instanceVariableNames:'matches stream maxPriority currentChar'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Scanner'
+!
+
+!PPCScanner methodsFor:'accessing'!
+
+stream
+    ^ stream
+!
+
+stream: anObject
+    stream := anObject
+! !
+
+!PPCScanner methodsFor:'as yet unclassified'!
+
+recordMatch: match 
+ 	^ self recordMatch: match priority: 0
+!
+
+recordMatch: match priority: currentPriority
+    (maxPriority < currentPriority) ifTrue: [ 
+        matches := IdentityDictionary new.
+        maxPriority := currentPriority.
+    ].
+         
+    (maxPriority == currentPriority) ifTrue: [ 
+     	matches at: match put: stream position
+ 	].
+!
+
+return
+    ^ self returnPriority: SmallInteger minVal.
+!
+
+returnPriority: priority
+    (maxPriority < priority) ifTrue: [ 
+        ^ IdentityDictionary new
+    ].
+    ^ matches keysAndValuesRemove: [ :key :value | key class == PEGFsaFailure ]
+! !
+
+!PPCScanner methodsFor:'initialization'!
+
+initialize
+    super initialize.
+    matches := IdentityDictionary new.	
+    maxPriority := SmallInteger minVal.
+! !
+
+!PPCScanner methodsFor:'scanning'!
+
+consumeConditionally: character
+    ^ (stream peek == character) ifTrue: [ stream next. true ] ifFalse: [ false ]
+!
+
+next
+    stream next
+!
+
+peek
+    ^ currentChar
+!
+
+peekBetween: start and: stop
+    (currentChar == nil) ifTrue: [ ^ false ].
+    ^ start <= currentChar codePoint and: [ currentChar codePoint <= stop ]
+!
+
+step
+    currentChar := stream next
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCScannerCodeGenerator.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,306 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCScannerCodeGenerator
+	instanceVariableNames:'codeGen fsa backlinkStates backlinkTransitions arguments openSet
+		joinPoints incommingTransitions methodCache id'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Scanner'
+!
+
+!PPCScannerCodeGenerator methodsFor:'accessing'!
+
+arguments
+    ^ arguments 
+!
+
+arguments: anObject
+    arguments := anObject
+! !
+
+!PPCScannerCodeGenerator methodsFor:'analysis'!
+
+analyzeBacklinks
+    backlinkTransitions := fsa backTransitions.
+    backlinkStates := IdentityDictionary new.
+    
+    backlinkTransitions do: [ :t |
+        (self backlinksTo: (t destination)) add: t.
+    ].
+!
+
+analyzeJoinPoints
+    | joinTransitions |
+    joinTransitions := fsa joinTransitions.
+    joinTransitions := joinTransitions reject: [ :t | self isBacklinkDestination: t destination ].
+    joinPoints := IdentityDictionary new.
+    
+    joinTransitions do: [ :t |
+        (joinPoints at: t destination ifAbsentPut: [ IdentitySet new ]) add: t.
+    ]
+    
+!
+
+analyzeTransitions
+    | transitions |
+    transitions := fsa allTransitions.
+    incommingTransitions := IdentityDictionary new.
+    (self incommingTransitionsFor: fsa startState) add: #transitionStub.
+    
+    transitions do: [ :t |
+        (self incommingTransitionsFor: t destination) add: t.
+    ].
+!
+
+backlinksTo: state
+    ^ backlinkStates at: state ifAbsentPut: [ OrderedCollection new ] 
+!
+
+closedJoinPoints
+    | closed |
+    closed := IdentitySet new.
+    
+    joinPoints keysAndValuesDo: [ :key :value | 
+        value isEmpty ifTrue: [ closed add: key ].
+    ].
+
+    ^ closed
+!
+
+containsBacklink: state
+    state transitions do: [ :t |
+        (self isBacklink:  t) ifTrue: [ ^ true ]
+    ].
+
+    ^ false
+!
+
+hasMultipleIncommings: state
+    ^ (incommingTransitions at: state ifAbsent: [ self error: 'should not happen']) size > 1
+!
+
+incommingTransitionsFor: state
+    ^ incommingTransitions  at: state ifAbsentPut: [ IdentitySet new ]
+!
+
+isBacklink: transition
+    ^ backlinkTransitions includes: transition
+!
+
+isBacklinkDestination: state
+    ^ (self backlinksTo: state)  isEmpty not
+!
+
+isJoinPoint: state
+    "Please note that joinPoints are removed as the compilaction proceeds"
+    ^ joinPoints keys includes: state
+!
+
+joinTransitionsTo: joinPoint "state"
+    ^ joinPoints at: joinPoint ifAbsent: [ #() ]
+! !
+
+!PPCScannerCodeGenerator methodsFor:'code generation'!
+
+generate
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.
+    self assert: fsa checkConsistency.
+
+
+    self analyzeBacklinks.
+    self analyzeJoinPoints.
+    self analyzeTransitions.
+    
+    openSet := IdentitySet new.
+    
+    codeGen startMethod: (codeGen idFor: fsa).
+    codeGen codeComment: (Character codePoint: 13) asString, fsa asString.
+
+    self generateFor: fsa startState.
+
+    codeGen stopMethod.	
+        
+    ^ self compileScannerClass new
+
+
+!
+
+generate: aPEGFsa
+    fsa := aPEGFsa.
+
+    fsa compact.
+    fsa checkSanity.
+    
+    ^ self generate
+!
+
+generateFinalFor: state
+    state isFinal ifFalse: [  ^ self ].
+
+    codeGen codeRecordMatch: state retval priority: state priority.
+!
+
+generateFor: state
+"	(self isJoinPoint: state) ifTrue: [ 
+        ^ codeGen codeComment: 'join point generation postponed...'
+    ].
+"
+    codeGen cachedValue: (codeGen idFor: state) ifPresent: [ :method | 
+        "if state is already cached, it has multiple incomming links.
+     	 In such a case, it is compiled as a method, thus return immediatelly"
+        ^ codeGen codeAbsoluteReturn:  method call
+    ].
+
+    self generateStartMethod: state.
+"	(self isBacklinkDestination: state) ifTrue: [ 
+        codeGen codeStartBlock.
+    ].
+"
+    self generateFinalFor: state.
+    self generateNextFor: state.
+    self generateTransitionsFor: state.
+
+"	(self isBacklinkDestination: state) ifTrue: [ 
+        codeGen codeEndBlockWhileTrue.
+    ].
+"
+    self generateStopMethod: state.
+!
+
+generateForSingleTransition: t from: state.
+    
+    (self isJoinPoint: t destination) ifTrue: [ self removeJoinTransition: t ].
+    
+    codeGen codeAssertPeek: (t characterSet) orReturn: state priority.
+"	(self isBacklink: t) ifTrue: [ 
+        codeGen add: 'true'
+    ] ifFalse: [ 
+        self generateFor: t destination.
+    ]
+"
+    self generateFor: t destination
+!
+
+generateForTransition: t from: state	
+    (self isJoinPoint: t destination) ifTrue: [ self removeJoinTransition: t   ].
+    
+"	(self isBacklink: t) ifTrue: [ 
+        codeGen codeAssertPeek: (t characterSet) ifTrue: [ 
+            codeGen add: 'true'
+        ]
+    ] ifFalse: [ 
+        codeGen codeAssertPeek: (t characterSet) ifTrue: [.
+            self generateFor: t destination.
+        ].
+    ].
+"
+    codeGen codeAssertPeek: (t characterSet) ifTrue: [.
+        self generateFor: t destination.
+    ].
+    codeGen codeIfFalse.
+!
+
+generateNextFor: state
+    state transitions isEmpty ifTrue: [  ^ self ].
+    codeGen codeNextChar.
+!
+
+generateReturnFor: state
+    codeGen codeNlReturnResult: state priority.
+!
+
+generateStartMethod: state.
+    id := codeGen idFor: state.
+
+    codeGen codeComment: 'START - Generated from state: ', state asString.
+
+    (self hasMultipleIncommings: state) ifTrue: [ 
+        codeGen startMethod: id.
+    ] ifFalse: [ 
+        codeGen  startInline: id.
+    ]
+!
+
+generateStopMethod: state
+    |  |
+    (self hasMultipleIncommings: state) ifTrue: [ 
+        codeGen codeAbsoluteReturn: codeGen stopMethod call.
+    ] ifFalse: [ 
+        codeGen code: codeGen stopInline call.
+    ].
+    codeGen codeComment: 'STOP - Generated from state: ', state asString.
+!
+
+generateTransitionsFor: state
+    (state transitions size = 0) ifTrue: [  
+        self generateReturnFor: state.
+        ^ self	
+    ].
+
+    (state transitions size = 1) ifTrue: [  
+        self generateForSingleTransition: state transitions anyOne from: state.
+        ^ self
+    ].
+
+
+    codeGen codeNl.
+    state transitions do: [ :t |
+        self generateForTransition: t from: state
+    ].
+
+    codeGen indent.
+    self generateReturnFor: state.
+    codeGen dedent.
+    codeGen codeNl.
+    state transitions size timesRepeat: [ codeGen addOnLine: ']' ].
+    codeGen addOnLine: '.'.
+    
+
+"	self closedJoinPoints isEmpty ifFalse: [ 
+        | jp |
+        self assert: self closedJoinPoints size == 1.
+
+        jp := self closedJoinPoints anyOne.
+        self removeJoinPoint: jp.
+        self generateFor: jp.
+    ]
+"
+! !
+
+!PPCScannerCodeGenerator methodsFor:'compiling'!
+
+compileScannerClass
+    | builder |
+    builder := PPCClassBuilder new.
+    
+    builder compiledClassName: arguments scannerName.
+    builder compiledSuperclass: PPCScanner.
+    builder methodDictionary: codeGen methodDictionary.
+    builder constants: codeGen constants.
+
+    ^ builder compileClass.	
+! !
+
+!PPCScannerCodeGenerator methodsFor:'initialization'!
+
+initialize
+    super initialize.
+    
+    codeGen := PPCFSACodeGen new.
+    arguments := PPCArguments default.
+! !
+
+!PPCScannerCodeGenerator methodsFor:'support'!
+
+removeJoinPoint: state
+    self assert: (joinPoints at: state) size = 0.
+    joinPoints removeKey: state
+!
+
+removeJoinTransition: t
+    (self joinTransitionsTo: t destination) remove: t ifAbsent: [ self error: 'this should not happen' ].
+! !
+
--- a/compiler/PPCSequenceNode.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCSequenceNode.st	Fri Jul 24 15:06:54 2015 +0100
@@ -11,8 +11,58 @@
 
 !PPCSequenceNode methodsFor:'accessing'!
 
+preferredChildrenVariableNames
+    "Return an array of preferred variable names of variables where to store
+     particular child's result value."
+
+    | names |
+
+    names := self propertyAt: #preferredChildrenVariableNames ifAbsent:[ nil ].
+    names notNil ifTrue:[ ^ names ].
+    names := OrderedCollection new.
+    self children do:[:child |  
+        | id |
+
+        id := child name notNil ifTrue:[ child name ] ifFalse:[ 'c' ].
+        (names includes: id) ifTrue:[ 
+            | i |
+
+            i := 1.
+            [ names includes: (id , '_' , i printString) ] whileTrue:[ 
+                i := i + 1.
+            ].
+            id := (id , '_' , i printString).
+        ].
+        names add: id.
+    ].                
+    self propertyAt: #preferredChildrenVariableNames put: names.
+    ^ names
+
+    "Created: / 04-06-2015 / 23:08:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+preferredChildrenVariableNames: aSequenceableCollection
+    "Sets an array of preferred variable names"
+
+    self propertyAt: #preferredChildrenVariableNames put: aSequenceableCollection
+
+    "Created: / 04-06-2015 / 23:09:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 prefix
     ^ #seq
+!
+
+returnParsedObjectsAsCollection
+    ^ self propertyAt: #returnParsedObjectsAsCollection ifAbsent:[ true ]
+
+    "Created: / 04-06-2015 / 23:43:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+returnParsedObjectsAsCollection: aBoolean
+    self propertyAt: #returnParsedObjectsAsCollection put: aBoolean
+
+    "Created: / 04-06-2015 / 23:43:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !PPCSequenceNode methodsFor:'analysis'!
@@ -121,6 +171,14 @@
                     reject: [ :each | each isNullable ]) ] ]
 ! !
 
+!PPCSequenceNode methodsFor:'testing'!
+
+isSequenceNode
+    ^ true
+
+    "Created: / 15-06-2015 / 18:29:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !PPCSequenceNode methodsFor:'visiting'!
 
 accept: visitor
--- a/compiler/PPCSpecializingVisitor.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCSpecializingVisitor.st	Fri Jul 24 15:06:54 2015 +0100
@@ -188,13 +188,15 @@
     (node child isKindOf: PPCCharacterNode) ifTrue: [ 
         self change.
         ^ PPCTrimmingCharacterTokenNode new
-            name: node name;
+            child: node child;               
             whitespace: node whitespace;
             tokenClass: node tokenClass;
-            child: node child;
+            name: node name;
             yourself
     ].
 
     ^ node
+
+    "Modified: / 21-05-2015 / 14:41:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
--- a/compiler/PPCTokenCodeGenerator.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCTokenCodeGenerator.st	Fri Jul 24 15:06:54 2015 +0100
@@ -31,7 +31,9 @@
 !PPCTokenCodeGenerator methodsFor:'visiting'!
 
 visitOptionalNode: node
-    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
+    compiler 
+          codeAssignParsedValueOf:[ self visit:node child ]
+          to:self retvalVar.
     compiler codeAssign: 'false.' to: 'error'.
     compiler codeReturn.
 !
@@ -60,7 +62,7 @@
 
     
     compiler codeAssign: 'context position + 1.' to: startVar.
-    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
+    compiler codeAssignParsedValueOf:[ self visit:node child ] to:#whatever.
     compiler add: 'error ifTrue: [ ^ error := false ].'.
 
     compiler codeAssign: 'context position.' to: endVar.
@@ -109,7 +111,9 @@
                to: 'currentTokenValue := ', self retvalVar.
     
     compiler addComment: 'Consume Whitespace:'.
-    compiler codeStoreValueOf: [ self visit: node whitespace ] intoVariable: #whatever.
+    compiler 
+          codeAssignParsedValueOf:[ self visit:node whitespace ]
+          to:#whatever.
     compiler nl.
     
     compiler add: '^ true'.
@@ -141,14 +145,16 @@
     ].
 
     compiler codeAssign: 'context position + 1.' to: startVar.
-    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
+    compiler codeAssignParsedValueOf:[ self visit:node child ] to:#whatever.
 
     compiler add: 'error ifTrue: [ ^ error := false ].'.
 
         compiler codeAssign: 'context position.' to: endVar.
     
         compiler addComment: 'Consume Whitespace:'.
-        compiler codeStoreValueOf: [ self visit: node whitespace ] intoVariable: #whatever.
+        compiler 
+              codeAssignParsedValueOf:[ self visit:node whitespace ]
+              to:#whatever.
         compiler nl.
     
     
--- a/compiler/PPCTokenizingCodeGenerator.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCTokenizingCodeGenerator.st	Fri Jul 24 15:06:54 2015 +0100
@@ -17,11 +17,11 @@
 !
 
 tokenGenerator
-    ^ tokenGenerator isNil 
-        ifTrue: [ tokenGenerator := (PPCTokenCodeGenerator on: compiler)
-            arguments: arguments;
-            yourself ]
-        ifFalse: [ tokenGenerator ]
+    tokenGenerator isNil ifTrue: [ 
+        tokenGenerator := PPCTokenCodeGenerator on: compiler.
+        tokenGenerator arguments: arguments.
+    ].
+    ^ tokenGenerator
 !
 
 tokenGenerator: whatever
@@ -50,7 +50,7 @@
         trueBlock value.
         compiler dedent.
         falseBlock isNil 	ifTrue: [ compiler addOnLine: '].' ]
-                              	ifFalse: [ compiler add: ']'. ]
+                              		ifFalse: [ compiler add: ']'. ]
     ].
     falseBlock isNil ifFalse: [ 
         compiler addOnLine: ' ifFalse: ['.
@@ -73,7 +73,9 @@
     compiler smartRemember: node child to: mementoVar.
     compiler codeAssign: '{ currentTokenValue . currentTokenType }.' to: currentTokenVar.
 
-    compiler codeStoreValueOf: [ self visit: node child  ] intoVariable: self retvalVar.
+    compiler 
+          codeAssignParsedValueOf:[ self visit:node child ]
+          to:self retvalVar.
 
     compiler smartRestore: node child from: mementoVar.
     compiler codeAssign: '(', currentTokenVar, ' at: 1).' to: 'currentTokenValue'.
@@ -92,7 +94,7 @@
         
         child acceptsEpsilon ifTrue: [  
             possibleError := false.
-            compiler codeStoreValueOf: [ self visit: child ] intoVariable: self retvalVar.
+            compiler codeAssignParsedValueOf:[ self visit:child ] to:self retvalVar.
             compiler codeReturn
         ] ifFalse: [
             child firstSetWithTokens do: [ :first |
@@ -102,7 +104,7 @@
                 compiler add: '(self ', tokenMethodName asString, ')'.
                 compiler addOnLine: ' ifTrue: ['.
                 compiler indent.
-                    compiler codeStoreValueOf: [ self visit: child ] intoVariable: self retvalVar.
+                    compiler codeAssignParsedValueOf:[ self visit:child ] to:self retvalVar.
                     compiler add: 'error ifFalse: ['.
                     compiler indent.
                         compiler codeReturn: self retvalVar.
@@ -127,9 +129,11 @@
 !
 
 visitDeterministicChoiceNode: node
-    | dictionary |
+    | dictionary isInlined |
     dictionary := IdentityDictionary new.
     
+    isInlined := node isMarkedForInline.
+    
     node children do: [ :child |
         | firstSet |
         firstSet := child firstSetWithTokens.
@@ -145,13 +149,21 @@
         compiler add: '(self ', tokenMethodName asString, ')'.
         compiler addOnLine: ' ifTrue: ['.
         compiler indent.
-            compiler codeStoreValueOf: [ self visit: child ] intoVariable: self retvalVar.
-            compiler codeReturn: self retvalVar.
+        compiler codeReturnParsedValueOf:[ self visit:child ].
         compiler dedent.
-        compiler add: '].'
+        isInlined ifTrue:[
+            compiler add: '] ifFalse: ['
+        ] ifFalse:[
+            compiler add: '].'.
+        ]
     ].
+    compiler codeError: 'no choice found'.
+    isInlined ifTrue:[
+        node children size timesRepeat: [ compiler addOnLine: ']' ].
+        compiler addOnLine: '.'.
+    ]
 
-    compiler codeError: 'no choice found'.
+    "Modified: / 21-05-2015 / 15:31:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 visitTokenChoiceNode: node
@@ -198,7 +210,9 @@
     self visit: node whitespace.
     
     compiler codeHaltIfShiftPressed.
-    compiler codeStoreValueOf: [ self visit: node parser ] intoVariable: self retvalVar.
+    compiler 
+          codeAssignParsedValueOf:[ self visit:node parser ]
+          to:self retvalVar.
     compiler codeReturn.
 !
 
--- a/compiler/PPCTokenizingVisitor.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPCTokenizingVisitor.st	Fri Jul 24 15:06:54 2015 +0100
@@ -18,17 +18,17 @@
         tokens addLast: self eofToken.
         tokens do: [ :token | token unmarkForInline  ].
         
-        whitespaceNode := tokens detect: [ :e | e isTrimmingTokenNode ] ifFound: [:token | 
-                token whitespace copy
-                    unmarkForInline;
-                    name: 'consumeWhitespace';
-                    yourself 
-            ] ifNone: [
-         		PPCNilNode new
-                    name: 'consumeWhitespace';
-                    yourself
-            ].
-        
+        whitespaceNode := tokens detect: [ :e | e isTrimmingTokenNode ] ifNone:[nil]. 
+        whitespaceNode notNil ifTrue:[
+            whitespaceNode := whitespaceNode whitespace copy
+                                unmarkForInline;
+                                name: 'consumeWhitespace';
+                                yourself 
+        ] ifFalse:[
+            whitespaceNode := (PPCNilNode new)
+                                name: 'consumeWhitespace';
+                                yourself
+        ].        
         tokenizerNode := PPCTokenChoiceNode new
             children: tokens asArray;
             name: 'nextToken';
@@ -42,7 +42,8 @@
             yourself
     ].
     ^ parserNode
-    
+
+    "Modified: / 12-05-2015 / 01:37:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 eofToken
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPMappedActionParser.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,36 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPActionParser subclass:#PPMappedActionParser
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Parsers'
+!
+
+!PPMappedActionParser methodsFor:'converting'!
+
+asCompilerNode
+    ^ PPCMappedActionNode new
+        name: self name;
+        block: block;
+        child: parser;
+        properties: properties;
+        parser: self;
+        yourself
+
+    "Created: / 02-06-2015 / 17:27:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPMappedActionParser methodsFor:'parsing'!
+
+parseOn: aPPContext
+    | element |
+    ^ (element := parser parseOn: aPPContext) isPetitFailure
+            ifFalse: [ block valueWithArguments: element ]
+            ifTrue: [ element ]
+
+    "Created: / 02-06-2015 / 17:15:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- a/compiler/PPTokenizingCompiledParser.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/PPTokenizingCompiledParser.st	Fri Jul 24 15:06:54 2015 +0100
@@ -3,7 +3,7 @@
 "{ NameSpace: Smalltalk }"
 
 PPCompiledParser subclass:#PPTokenizingCompiledParser
-	instanceVariableNames:'currentTokenValue currentTokenType'
+	instanceVariableNames:'currentTokenValue currentTokenType scanner'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'PetitCompiler-Parsers'
@@ -12,6 +12,7 @@
 !PPTokenizingCompiledParser methodsFor:'tokenizing'!
 
 consume: tokenType
+    self halt: 'deprecated'.
     (self perform: tokenType) ifTrue: [ 
         currentTokenType := nil.
         ^ currentTokenValue.
@@ -56,6 +57,7 @@
     context noteFailure: failure.
     error := false.
     currentTokenType := nil.
+    scanner := PPCScanner new.
 
     self consumeWhitespace.
     retval := self perform: startSymbol.
--- a/compiler/abbrev.stc	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/abbrev.stc	Fri Jul 24 15:06:54 2015 +0100
@@ -1,8 +1,17 @@
 # automagically generated by the project definition
 # this file is needed for stc to be able to compile modules independently.
 # it provides information about a classes filename, category and especially namespace.
+PEGFsa PEGFsa stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
+PEGFsaFailure PEGFsaFailure stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
+PEGFsaInterpret PEGFsaInterpret stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
+PEGFsaPair PEGFsaPair stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
+PEGFsaState PEGFsaState stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
+PEGFsaTransition PEGFsaTransition stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
 PPCArguments PPCArguments stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
 PPCBridge PPCBridge stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
+PPCClassBuilder PPCClassBuilder stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
+PPCCodeBlock PPCCodeBlock stx:goodies/petitparser/compiler 'PetitCompiler-Compiler-Codegen' 0
+PPCCodeGen PPCCodeGen stx:goodies/petitparser/compiler 'PetitCompiler-Compiler-Codegen' 0
 PPCCompiledMethod PPCCompiledMethod stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
 PPCCompiler PPCCompiler stx:goodies/petitparser/compiler 'PetitCompiler-Compiler' 0
 PPCCompilerTokenErrorStrategy PPCCompilerTokenErrorStrategy stx:goodies/petitparser/compiler 'PetitCompiler-Compiler' 0
@@ -13,13 +22,18 @@
 PPCContext PPCContext stx:goodies/petitparser/compiler 'PetitCompiler-Context' 0
 PPCContextMemento PPCContextMemento stx:goodies/petitparser/compiler 'PetitCompiler-Context' 0
 PPCGuard PPCGuard stx:goodies/petitparser/compiler 'PetitCompiler-Guards' 0
-PPCMethod PPCMethod stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
+PPCMethod PPCMethod stx:goodies/petitparser/compiler 'PetitCompiler-Compiler-Codegen' 0
 PPCNode PPCNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
 PPCNodeVisitor PPCNodeVisitor stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
 PPCPluggableConfiguration PPCPluggableConfiguration stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
+PPCScanner PPCScanner stx:goodies/petitparser/compiler 'PetitCompiler-Scanner' 0
+PPCScannerCodeGenerator PPCScannerCodeGenerator stx:goodies/petitparser/compiler 'PetitCompiler-Scanner' 0
 PPCTokenGuard PPCTokenGuard stx:goodies/petitparser/compiler 'PetitCompiler-Guards' 0
 PPCompiledParser PPCompiledParser stx:goodies/petitparser/compiler 'PetitCompiler-Parsers' 4
+PPMappedActionParser PPMappedActionParser stx:goodies/petitparser/compiler 'PetitCompiler-Parsers' 0
 stx_goodies_petitparser_compiler stx_goodies_petitparser_compiler stx:goodies/petitparser/compiler '* Projects & Packages *' 3
+FooScanner FooScanner stx:goodies/petitparser/compiler 'PetitCompiler-Scanner' 0
+PEGFsaGenerator PEGFsaGenerator stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
 PPCAbstractLiteralNode PPCAbstractLiteralNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
 PPCAbstractPredicateNode PPCAbstractPredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
 PPCAnyNode PPCAnyNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
@@ -27,7 +41,8 @@
 PPCCodeGenerator PPCCodeGenerator stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
 PPCDelegateNode PPCDelegateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
 PPCEndOfFileNode PPCEndOfFileNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCInlinedMethod PPCInlinedMethod stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
+PPCFSACodeGen PPCFSACodeGen stx:goodies/petitparser/compiler 'PetitCompiler-Scanner' 0
+PPCInlinedMethod PPCInlinedMethod stx:goodies/petitparser/compiler 'PetitCompiler-Compiler-Codegen' 0
 PPCInliningVisitor PPCInliningVisitor stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
 PPCListNode PPCListNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
 PPCNilNode PPCNilNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
@@ -86,5 +101,6 @@
 PPCTokenChoiceNode PPCTokenChoiceNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
 PPCTrimNode PPCTrimNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
 PPCTrimmingCharacterTokenNode PPCTrimmingCharacterTokenNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
+PPCMappedActionNode PPCMappedActionNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
 PPCTokenStarMessagePredicateNode PPCTokenStarMessagePredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
 PPCTokenStarSeparatorNode PPCTokenStarSeparatorNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
--- a/compiler/bc.mak	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/bc.mak	Fri Jul 24 15:06:54 2015 +0100
@@ -35,7 +35,7 @@
 
 
 
-LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\analyzer -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\java -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\analyzer -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\java -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2 -I$(INCLUDE_TOP)\stx\libview
 LOCALDEFINES=
 
 STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES)  -varPrefix=$(LIBNAME)
@@ -54,7 +54,6 @@
 	pushd ..\..\..\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
 	pushd ..\..\refactoryBrowser\parser & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
 	pushd ..\..\..\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
-	pushd ..\..\..\libbasic3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
 	pushd ..\..\..\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
 	pushd .. & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
 	pushd ..\..\..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
@@ -78,8 +77,17 @@
 
 
 # BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)PEGFsa.$(O) PEGFsa.$(H): PEGFsa.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaFailure.$(O) PEGFsaFailure.$(H): PEGFsaFailure.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaInterpret.$(O) PEGFsaInterpret.$(H): PEGFsaInterpret.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaPair.$(O) PEGFsaPair.$(H): PEGFsaPair.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaState.$(O) PEGFsaState.$(H): PEGFsaState.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaTransition.$(O) PEGFsaTransition.$(H): PEGFsaTransition.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCArguments.$(O) PPCArguments.$(H): PPCArguments.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCBridge.$(O) PPCBridge.$(H): PPCBridge.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCClassBuilder.$(O) PPCClassBuilder.$(H): PPCClassBuilder.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCCodeBlock.$(O) PPCCodeBlock.$(H): PPCCodeBlock.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCCodeGen.$(O) PPCCodeGen.$(H): PPCCodeGen.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCCompiledMethod.$(O) PPCCompiledMethod.$(H): PPCCompiledMethod.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCCompiler.$(O) PPCCompiler.$(H): PPCCompiler.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCCompilerTokenErrorStrategy.$(O) PPCCompilerTokenErrorStrategy.$(H): PPCCompilerTokenErrorStrategy.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
@@ -94,9 +102,14 @@
 $(OUTDIR)PPCNode.$(O) PPCNode.$(H): PPCNode.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCNodeVisitor.$(O) PPCNodeVisitor.$(H): PPCNodeVisitor.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCPluggableConfiguration.$(O) PPCPluggableConfiguration.$(H): PPCPluggableConfiguration.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCScanner.$(O) PPCScanner.$(H): PPCScanner.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCScannerCodeGenerator.$(O) PPCScannerCodeGenerator.$(H): PPCScannerCodeGenerator.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCTokenGuard.$(O) PPCTokenGuard.$(H): PPCTokenGuard.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCompiledParser.$(O) PPCompiledParser.$(H): PPCompiledParser.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPMappedActionParser.$(O) PPMappedActionParser.$(H): PPMappedActionParser.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPActionParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)stx_goodies_petitparser_compiler.$(O) stx_goodies_petitparser_compiler.$(H): stx_goodies_petitparser_compiler.st $(INCLUDE_TOP)\stx\libbasic\LibraryDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProjectDefinition.$(H) $(STCHDR)
+$(OUTDIR)FooScanner.$(O) FooScanner.$(H): FooScanner.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCScanner.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaGenerator.$(O) PEGFsaGenerator.$(H): PEGFsaGenerator.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNodeVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCAbstractLiteralNode.$(O) PPCAbstractLiteralNode.$(H): PPCAbstractLiteralNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCAbstractPredicateNode.$(O) PPCAbstractPredicateNode.$(H): PPCAbstractPredicateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCAnyNode.$(O) PPCAnyNode.$(H): PPCAnyNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
@@ -104,6 +117,7 @@
 $(OUTDIR)PPCCodeGenerator.$(O) PPCCodeGenerator.$(H): PPCCodeGenerator.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNodeVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCDelegateNode.$(O) PPCDelegateNode.$(H): PPCDelegateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCEndOfFileNode.$(O) PPCEndOfFileNode.$(H): PPCEndOfFileNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCFSACodeGen.$(O) PPCFSACodeGen.$(H): PPCFSACodeGen.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCCodeGen.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCInlinedMethod.$(O) PPCInlinedMethod.$(H): PPCInlinedMethod.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCMethod.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCInliningVisitor.$(O) PPCInliningVisitor.$(H): PPCInliningVisitor.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNodeVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCListNode.$(O) PPCListNode.$(H): PPCListNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
@@ -163,6 +177,7 @@
 $(OUTDIR)PPCTokenChoiceNode.$(O) PPCTokenChoiceNode.$(H): PPCTokenChoiceNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCChoiceNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCListNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCTrimNode.$(O) PPCTrimNode.$(H): PPCTrimNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCListNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCSequenceNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCTrimmingCharacterTokenNode.$(O) PPCTrimmingCharacterTokenNode.$(H): PPCTrimmingCharacterTokenNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCListNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCTrimmingTokenNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCMappedActionNode.$(O) PPCMappedActionNode.$(H): PPCMappedActionNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractActionNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCActionNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCDelegateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCTokenStarMessagePredicateNode.$(O) PPCTokenStarMessagePredicateNode.$(H): PPCTokenStarMessagePredicateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCDelegateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCStarMessagePredicateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCStarNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)PPCTokenStarSeparatorNode.$(O) PPCTokenStarSeparatorNode.$(H): PPCTokenStarSeparatorNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCDelegateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCStarMessagePredicateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCStarNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCTokenStarMessagePredicateNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPActionParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPAndParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPCharSetPredicate.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPChoiceParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPCompositeParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPContext.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPEndOfInputParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPEpsilonParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPFailure.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPFlattenParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPListParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPLiteralObjectParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPLiteralParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPLiteralSequenceParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPNotParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPOptionalParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPPluggableParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPPossessiveRepeatingParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPPredicateObjectParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPPredicateParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPRepeatingParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPSequenceParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPStream.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPToken.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPTokenParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPTrimmingParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\parsers\java\PPJavaWhitespaceParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk\PPSmalltalkGrammar.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk\PPSmalltalkTokenParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk\PPSmalltalkWhitespaceParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Character.$(H) $(INCLUDE_TOP)\stx\libbasic\Magnitude.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\PeekableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PositionableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\ReadStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(INCLUDE_TOP)\stx\libbasic\UndefinedObject.$(H) $(STCHDR)
--- a/compiler/benchmarks/Make.proto	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/benchmarks/Make.proto	Fri Jul 24 15:06:54 2015 +0100
@@ -34,7 +34,7 @@
 # add the path(es) here:,
 # ********** OPTIONAL: MODIFY the next lines ***
 # LOCALINCLUDES=-Ifoo -Ibar
-LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/compiler -I$(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/java -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk -I$(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser -I$(INCLUDE_TOP)/stx/libbasic
+LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/compiler -I$(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/java -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk/tests -I$(INCLUDE_TOP)/stx/goodies/petitparser/tests -I$(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser -I$(INCLUDE_TOP)/stx/goodies/sunit -I$(INCLUDE_TOP)/stx/libbasic
 
 
 # if you need any additional defines for embedded C code,
@@ -102,6 +102,15 @@
 # build all mandatory prerequisite packages (containing superclasses) for this package
 prereq:
 	cd ../../../../libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+	cd ../../../refactoryBrowser/parser && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+	cd ../../../../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+	cd ../../../../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+	cd ../../ && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+	cd ../../../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+	cd ../../parsers/smalltalk && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+	cd ../../../sunit && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+	cd ../../tests && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+	cd ../../parsers/smalltalk/tests && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
 
 
 
@@ -122,6 +131,7 @@
 
 # BEGINMAKEDEPEND --- do not remove this line; make depend needs it
 $(OUTDIR)PPCBenchmark.$(O) PPCBenchmark.$(H): PPCBenchmark.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCSmalltalkNoopParser.$(O) PPCSmalltalkNoopParser.$(H): PPCSmalltalkNoopParser.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPCompositeParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk/PPSmalltalkGrammar.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)stx_goodies_petitparser_compiler_benchmarks.$(O) stx_goodies_petitparser_compiler_benchmarks.$(H): stx_goodies_petitparser_compiler_benchmarks.st $(INCLUDE_TOP)/stx/libbasic/LibraryDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProjectDefinition.$(H) $(STCHDR)
 
 # ENDMAKEDEPEND --- do not remove this line
--- a/compiler/benchmarks/Make.spec	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/benchmarks/Make.spec	Fri Jul 24 15:06:54 2015 +0100
@@ -52,6 +52,7 @@
 
 COMMON_CLASSES= \
 	PPCBenchmark \
+	PPCSmalltalkNoopParser \
 	stx_goodies_petitparser_compiler_benchmarks \
 
 
@@ -59,6 +60,7 @@
 
 COMMON_OBJS= \
     $(OUTDIR_SLASH)PPCBenchmark.$(O) \
+    $(OUTDIR_SLASH)PPCSmalltalkNoopParser.$(O) \
     $(OUTDIR_SLASH)stx_goodies_petitparser_compiler_benchmarks.$(O) \
 
 
--- a/compiler/benchmarks/PPCBenchmark.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/benchmarks/PPCBenchmark.st	Fri Jul 24 15:06:54 2015 +0100
@@ -30,7 +30,7 @@
     ].
     ^ (benchmarkSuiteClass  class:self) run
 
-  		"
+  				"
     PPCBenchmark run.
     "
 !
@@ -47,6 +47,20 @@
     "
     PPCBenchmark run: #benchmarkRBParserC
     "
+!
+
+spy: benchmark
+    | benchmarkInstanceClass |
+
+    benchmarkInstanceClass := Smalltalk at: #BenchmarkInstance.
+    benchmarkInstanceClass isNil ifTrue:[
+        self error: 'CalipeL is not loaded.'
+    ].   
+
+    ^ (benchmarkInstanceClass class:self selector:benchmark) spy
+
+    "Created: / 11-05-2015 / 16:31:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 16-05-2015 / 19:19:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !PPCBenchmark methodsFor:'benchmark support'!
@@ -370,6 +384,26 @@
     input do: [ :source | parser parse: source withContext: context ]
 !
 
+benchmarkSmalltalkNoopParserCompiledC
+    <setup: #setupSmalltalkNoopParserCompiled>
+    <teardown: #teardownSmalltalkNoopParserCompiled>
+    <benchmark: 'Petit Smalltalk Parser (noop)- Compiled'>
+    
+    input do: [ :source | parser parse: source withContext: context ]
+
+    "Created: / 16-05-2015 / 09:45:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+benchmarkSmalltalkNoopParserTokenizedC
+    <setup: #setupSmalltalkNoopParserTokenized>
+    <teardown: #teardownSmalltalkNoopParserTokenized>
+    <benchmark: 'Petit Smalltalk Parser (noop) - Tokenized'>
+    
+    input do: [ :source | parser parse: source withContext: context ]
+
+    "Created: / 16-05-2015 / 09:46:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 benchmarkSmalltalkParserC
     <setup: #setupSmalltalkParser>
     <benchmark: 'Petit Smalltalk Parser - Standard'>
@@ -384,6 +418,16 @@
     
     input do: [ :source | parser parse: source withContext: context ]
     
+!
+
+benchmarkSmalltalkParserTokenizedC
+    <setup: #setupSmalltalkParserTokenized>
+    <teardown: #teardownSmalltalkParserTokenized>
+    <benchmark: 'Petit Smalltalk Parser - Tokenized'>
+    
+    input do: [ :source | parser parse: source withContext: context ]
+
+    "Created: / 16-05-2015 / 09:45:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !PPCBenchmark methodsFor:'intitialization'!
@@ -565,6 +609,28 @@
     ]
 !
 
+setupSmalltalkNoopParserCompiled
+
+    configuration := PPCConfiguration universal.
+    parser := PPCSmalltalkNoopParser new compileWithConfiguration: configuration.
+    context := PPCContext new.
+    context initializeFor: parser.
+    input := sources smalltalkSourcesBig.
+
+    "Created: / 16-05-2015 / 09:44:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+setupSmalltalkNoopParserTokenized
+
+    configuration := PPCConfiguration LL1.
+    parser := PPCSmalltalkNoopParser new compileWithConfiguration: configuration.
+    context := PPCContext new.
+    context initializeFor: parser.
+    input := sources smalltalkSourcesBig.
+
+    "Created: / 16-05-2015 / 09:44:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 setupSmalltalkParser
     
     parser := PPSmalltalkParser new.
@@ -617,6 +683,28 @@
     parser class removeFromSystem.
 !
 
+teardownSmalltalkNoopParserCompiled
+    parser class removeFromSystem.
+"       
+    size := input inject: 0 into: [:r :e | r + e size  ].
+    Transcript crShow: 'Compiled Grammar time: ', time asString.
+    Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
+"
+
+    "Created: / 16-05-2015 / 09:44:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+teardownSmalltalkNoopParserTokenized
+    parser class removeFromSystem.
+"       
+    size := input inject: 0 into: [:r :e | r + e size  ].
+    Transcript crShow: 'Compiled Grammar time: ', time asString.
+    Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
+"
+
+    "Created: / 16-05-2015 / 09:44:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 teardownSmalltalkParserCompiled
     parser class removeFromSystem.
 "	
@@ -624,6 +712,17 @@
     Transcript crShow: 'Compiled Grammar time: ', time asString.
     Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
 "
+!
+
+teardownSmalltalkParserTokenized
+    parser class removeFromSystem.
+"       
+    size := input inject: 0 into: [:r :e | r + e size  ].
+    Transcript crShow: 'Compiled Grammar time: ', time asString.
+    Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
+"
+
+    "Created: / 16-05-2015 / 09:47:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !PPCBenchmark class methodsFor:'documentation'!
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/PPCSmalltalkNoopParser.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,344 @@
+"{ Package: 'stx:goodies/petitparser/compiler/benchmarks' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPSmalltalkGrammar subclass:#PPCSmalltalkNoopParser
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Benchmarks-Parsers'
+!
+
+!PPCSmalltalkNoopParser methodsFor:'accessing'!
+
+startExpression
+    "Make the sequence node has a method node as its parent and that the source is set."
+
+    ^ ([ :stream | stream collection ] asParser and , super startExpression) map: [ :source :node | 
+        (RBMethodNode selector: #doIt body: node)
+            source: source.
+        (node statements size = 1 and: [ node temporaries isEmpty ])
+            ifTrue: [ node statements first ]
+            ifFalse: [ node ] ]
+!
+
+startMethod
+    "Make sure the method node has the source code properly set."
+    
+    ^ ([ :stream | stream collection ] asParser and , super startMethod)
+        map: [ :source :node | node source: source ]
+! !
+
+!PPCSmalltalkNoopParser methodsFor:'grammar'!
+
+array
+        ^ super array map: [ :openNode :statementNodes :closeNode | ]
+
+    "Modified: / 15-05-2015 / 08:54:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+expression
+        ^ super expression map: [ :variableNodes :expressionNodes |  ]
+
+    "Modified: / 15-05-2015 / 08:55:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+method
+        ^ super method map: [ :methodNode :bodyNode | ]
+
+    "Modified (format): / 15-05-2015 / 08:55:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodDeclaration
+        ^ super methodDeclaration ==> [ :nodes | nodes ]
+
+    "Modified: / 15-05-2015 / 08:55:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodSequence
+        ^ super methodSequence map: [ :periodNodes1 :pragmaNodes1 :periodNodes2 :tempNodes :periodNodes3 :pragmaNodes2 :periodNodes4 :statementNodes | ]
+
+    "Modified: / 15-05-2015 / 08:55:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parens
+        ^ super parens map: [ :openToken :expressionNode :closeToken |  ]
+
+    "Modified: / 15-05-2015 / 08:55:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+pragma
+        ^ super pragma ==> [ :nodes | nodes ]
+
+    "Modified: / 15-05-2015 / 08:55:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+return
+        ^ super return map: [ :token :expressionNode |  ]
+
+    "Modified: / 15-05-2015 / 08:55:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+sequence
+        ^ super sequence map: [ :tempNodes :periodNodes :statementNodes |  ]
+
+    "Modified: / 15-05-2015 / 08:56:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+variable
+        ^ super variable ==> [ :token |  ]
+
+    "Modified: / 15-05-2015 / 08:56:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCSmalltalkNoopParser methodsFor:'grammar-blocks'!
+
+block
+        ^ super block map: [ :leftToken :blockNode :rightToken | ]
+
+    "Modified: / 15-05-2015 / 08:56:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+blockArgument
+    ^ super blockArgument ==> #second
+!
+
+blockBody
+        ^ super blockBody
+                ==> [ :nodes |  ]
+
+    "Modified: / 15-05-2015 / 08:56:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCSmalltalkNoopParser methodsFor:'grammar-literals'!
+
+arrayLiteral
+        ^ super arrayLiteral ==> [ :nodes | nodes ]
+
+    "Modified (format): / 15-05-2015 / 08:56:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+arrayLiteralArray
+        ^ super arrayLiteralArray ==> [ :nodes | nodes ]
+
+    "Modified: / 15-05-2015 / 08:56:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+byteLiteral
+        ^ super byteLiteral ==> [ :nodes | nodes ]
+
+    "Modified: / 15-05-2015 / 08:56:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+byteLiteralArray
+        ^ super byteLiteralArray ==> [ :nodes | nodes ]
+
+    "Modified: / 15-05-2015 / 08:56:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+charLiteral
+        ^ super charLiteral ==> [ :nodes | nodes ]
+
+    "Modified: / 15-05-2015 / 08:57:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+falseLiteral
+        ^ super falseLiteral ==> [ :nodes | nodes ]
+
+    "Modified: / 15-05-2015 / 08:57:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+nilLiteral
+        ^ super nilLiteral ==> [ :nodes | nodes ]
+
+    "Modified: / 15-05-2015 / 08:57:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+numberLiteral
+    ^ super numberLiteral ==> [ :nodes | nodes ]
+
+    "Modified: / 15-05-2015 / 08:57:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+stringLiteral
+        ^ super stringLiteral ==> [ :nodes | nodes ]
+
+    "Modified: / 15-05-2015 / 08:57:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+symbolLiteral
+        ^ super symbolLiteral ==> [ :nodes | nodes ]
+
+    "Modified: / 15-05-2015 / 08:57:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+symbolLiteralArray
+        ^ super symbolLiteralArray ==> [ :nodes | nodes ]
+
+    "Modified: / 15-05-2015 / 08:57:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+trueLiteral
+        ^ super trueLiteral ==> [ :nodes | nodes ]
+
+    "Modified: / 15-05-2015 / 08:57:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCSmalltalkNoopParser methodsFor:'grammar-messages'!
+
+binaryExpression
+        ^ super binaryExpression map: [ :receiverNode :messageNodes |  ]
+
+    "Modified: / 15-05-2015 / 08:57:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+cascadeExpression
+        ^ super cascadeExpression map: [ :receiverNode :messageNodes | ]
+
+    "Modified: / 15-05-2015 / 08:57:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+keywordExpression
+        ^ super keywordExpression map: [ :receiveNode :messageNode | ]
+
+    "Modified: / 15-05-2015 / 08:58:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+unaryExpression
+        ^ super unaryExpression map: [ :receiverNode :messageNodes | ]
+
+    "Modified: / 15-05-2015 / 08:58:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCSmalltalkNoopParser methodsFor:'private'!
+
+addStatements: aCollection into: aNode
+    aCollection isNil 
+        ifTrue: [ ^ aNode ].
+    aCollection do: [ :each |
+        each class == PPSmalltalkToken
+            ifFalse: [ aNode addNode:  each ]
+            ifTrue: [
+                aNode statements isEmpty
+                    ifTrue: [ aNode addComments: each comments ]
+                    ifFalse: [ aNode statements last addComments: each comments ].
+                aNode periods: (aNode periods asOrderedCollection
+                    addLast: each start;
+                    yourself) ] ].
+    ^ aNode
+!
+
+build: aNode assignment: anArray
+    ^ anArray isEmpty
+        ifTrue: [ aNode ]
+        ifFalse: [
+            anArray reverse 
+                inject: aNode
+                into: [ :result :each |
+                    RBAssignmentNode 
+                        variable: each first
+                        value: result
+                        position: each second start ] ]
+!
+
+build: aNode cascade: anArray 
+    | messages semicolons |
+    ^ (anArray isNil or: [ anArray isEmpty ]) 
+        ifTrue: [ aNode ]
+        ifFalse: [
+            messages := OrderedCollection new: anArray size + 1.
+            messages addLast: aNode.
+            semicolons := OrderedCollection new.
+            anArray do: [ :each | 
+                messages addLast: (self 
+                    build: aNode receiver
+                    messages: (Array with: each second)).
+                semicolons addLast: each first start ].
+            RBCascadeNode messages: messages semicolons: semicolons ]
+!
+
+build: aNode messages: anArray 
+    ^ (anArray isNil or: [ anArray isEmpty ]) 
+        ifTrue: [ aNode ]
+        ifFalse: [
+            anArray 
+                inject: aNode
+                into: [ :rec :msg | 
+                    msg isNil 
+                        ifTrue: [ rec ]
+                        ifFalse: [
+                            RBMessageNode 
+                                receiver: rec
+                                selectorParts: msg first
+                                arguments: msg second ] ] ]
+!
+
+build: aTempCollection sequence: aStatementCollection
+    | result |
+    result := self
+        addStatements: aStatementCollection
+        into: RBSequenceNode new.
+    aTempCollection isEmpty ifFalse: [
+        result
+            leftBar: aTempCollection first start
+            temporaries: aTempCollection second
+            rightBar: aTempCollection last start ].
+    ^ result
+!
+
+buildArray: aStatementCollection
+    ^ self addStatements: aStatementCollection into: RBArrayNode new
+!
+
+buildMethod: aMethodNode
+    aMethodNode selectorParts 
+        do: [ :each | aMethodNode addComments: each comments ].
+    aMethodNode arguments
+        do: [ :each | aMethodNode addComments: each token comments ].
+    aMethodNode pragmas do: [ :pragma |
+        aMethodNode addComments: pragma comments.
+        pragma selectorParts 
+            do: [ :each | aMethodNode addComments: each comments ].
+        pragma arguments do: [ :each | 
+            each isLiteralArray
+                ifFalse: [ aMethodNode addComments: each token comments ] ].
+        pragma comments: nil ].
+    ^ aMethodNode
+!
+
+buildString: aString 
+    (aString isEmpty or: [ aString first ~= $' or: [ aString last ~= $' ] ])
+        ifTrue: [ ^ aString ].
+    ^ (aString 
+        copyFrom: 2
+        to: aString size - 1) 
+        copyReplaceAll: ''''''
+        with: ''''
+! !
+
+!PPCSmalltalkNoopParser methodsFor:'token'!
+
+binaryToken
+        ^ super binaryToken ==> [ :token | token ]
+
+    "Modified: / 15-05-2015 / 08:54:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+identifierToken
+        ^ super identifierToken ==> [ :token | token ]
+
+    "Modified: / 15-05-2015 / 08:54:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+keywordToken
+        ^ super keywordToken ==> [ :token | token ]
+
+    "Modified: / 15-05-2015 / 08:54:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+unaryToken
+        ^ super unaryToken ==> [ :token | token ]
+
+    "Modified: / 15-05-2015 / 08:54:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/PPCSmalltalkNoopParserTests.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,19 @@
+"{ Package: 'stx:goodies/petitparser/compiler/benchmarks' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPSmalltalkGrammarTests subclass:#PPCSmalltalkNoopParserTests
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Benchmarks-Parsers-Tests'
+!
+
+!PPCSmalltalkNoopParserTests methodsFor:'accessing'!
+
+parserClass
+        ^ PPCSmalltalkNoopParser
+
+    "Created: / 15-05-2015 / 09:00:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- a/compiler/benchmarks/abbrev.stc	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/benchmarks/abbrev.stc	Fri Jul 24 15:06:54 2015 +0100
@@ -2,4 +2,6 @@
 # this file is needed for stc to be able to compile modules independently.
 # it provides information about a classes filename, category and especially namespace.
 PPCBenchmark PPCBenchmark stx:goodies/petitparser/compiler/benchmarks 'PetitCompiler-Benchmarks-Core' 0
+PPCSmalltalkNoopParser PPCSmalltalkNoopParser stx:goodies/petitparser/compiler/benchmarks 'PetitCompiler-Benchmarks-Parsers' 0
+PPCSmalltalkNoopParserTests PPCSmalltalkNoopParserTests stx:goodies/petitparser/compiler/benchmarks 'PetitCompiler-Benchmarks-Parsers-Tests' 1
 stx_goodies_petitparser_compiler_benchmarks stx_goodies_petitparser_compiler_benchmarks stx:goodies/petitparser/compiler/benchmarks '* Projects & Packages *' 3
--- a/compiler/benchmarks/bc.mak	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/benchmarks/bc.mak	Fri Jul 24 15:06:54 2015 +0100
@@ -35,7 +35,7 @@
 
 
 
-LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\compiler -I$(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\java -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser -I$(INCLUDE_TOP)\stx\libbasic
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\compiler -I$(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\java -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk\tests -I$(INCLUDE_TOP)\stx\goodies\petitparser\tests -I$(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser -I$(INCLUDE_TOP)\stx\goodies\sunit -I$(INCLUDE_TOP)\stx\libbasic
 LOCALDEFINES=
 
 STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES)  -varPrefix=$(LIBNAME)
@@ -52,6 +52,15 @@
 # build all mandatory prerequisite packages (containing superclasses) for this package
 prereq:
 	pushd ..\..\..\..\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+	pushd ..\..\..\refactoryBrowser\parser & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+	pushd ..\..\..\..\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+	pushd ..\..\..\..\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+	pushd ..\.. & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+	pushd ..\..\..\..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+	pushd ..\..\parsers\smalltalk & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+	pushd ..\..\..\sunit & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+	pushd ..\..\tests & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+	pushd ..\..\parsers\smalltalk\tests & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
 
 
 
@@ -69,6 +78,7 @@
 
 # BEGINMAKEDEPEND --- do not remove this line; make depend needs it
 $(OUTDIR)PPCBenchmark.$(O) PPCBenchmark.$(H): PPCBenchmark.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCSmalltalkNoopParser.$(O) PPCSmalltalkNoopParser.$(H): PPCSmalltalkNoopParser.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPCompositeParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk\PPSmalltalkGrammar.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)stx_goodies_petitparser_compiler_benchmarks.$(O) stx_goodies_petitparser_compiler_benchmarks.$(H): stx_goodies_petitparser_compiler_benchmarks.st $(INCLUDE_TOP)\stx\libbasic\LibraryDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProjectDefinition.$(H) $(STCHDR)
 
 # ENDMAKEDEPEND --- do not remove this line
--- a/compiler/benchmarks/bmake.bat	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/benchmarks/bmake.bat	Fri Jul 24 15:06:54 2015 +0100
@@ -4,9 +4,7 @@
 @REM do not edit - automatically generated from ProjectDefinition
 @REM -------
 @SET DEFINES=
-@REM Kludge got Mercurial, cannot be implemented in Borland make
-@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
-@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
 make.exe -N -f bc.mak  %DEFINES% %*
 
 
--- a/compiler/benchmarks/libInit.cc	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/benchmarks/libInit.cc	Fri Jul 24 15:06:54 2015 +0100
@@ -28,6 +28,7 @@
 OBJ snd; struct __vmData__ *__pRT__; {
 __BEGIN_PACKAGE2__("libstx_goodies_petitparser_compiler_benchmarks", _libstx_goodies_petitparser_compiler_benchmarks_Init, "stx:goodies/petitparser/compiler/benchmarks");
 _PPCBenchmark_Init(pass,__pRT__,snd);
+_PPCSmalltalkNoopParser_Init(pass,__pRT__,snd);
 _stx_137goodies_137petitparser_137compiler_137benchmarks_Init(pass,__pRT__,snd);
 
 
--- a/compiler/benchmarks/mingwmake.bat	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/benchmarks/mingwmake.bat	Fri Jul 24 15:06:54 2015 +0100
@@ -4,9 +4,6 @@
 @REM do not edit - automatically generated from ProjectDefinition
 @REM -------
 @SET DEFINES=
-@REM Kludge got Mercurial, cannot be implemented in Borland make
-@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
-@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
 
 @pushd ..\..\..\..\rules
 @call find_mingw.bat
--- a/compiler/benchmarks/stx_goodies_petitparser_compiler_benchmarks.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/benchmarks/stx_goodies_petitparser_compiler_benchmarks.st	Fri Jul 24 15:06:54 2015 +0100
@@ -56,6 +56,11 @@
      by searching along the inheritance chain of all of my classes."
 
     ^ #(
+        #'stx:goodies/petitparser'    "PPCompositeParser - superclass of PPCSmalltalkNoopParser"
+        #'stx:goodies/petitparser/parsers/smalltalk'    "PPSmalltalkGrammar - superclass of PPCSmalltalkNoopParser"
+        #'stx:goodies/petitparser/parsers/smalltalk/tests'    "PPSmalltalkGrammarTests - superclass of PPCSmalltalkNoopParserTests"
+        #'stx:goodies/petitparser/tests'    "PPAbstractParserTest - superclass of PPCSmalltalkNoopParserTests"
+        #'stx:goodies/sunit'    "TestAsserter - superclass of PPCSmalltalkNoopParserTests"
         #'stx:libbasic'    "LibraryDefinition - superclass of stx_goodies_petitparser_compiler_benchmarks"
     )
 !
@@ -71,12 +76,10 @@
      by searching all classes (and their packages) which are referenced by my classes."
 
     ^ #(
-        #'stx:goodies/petitparser'    "PPContext - referenced by PPCBenchmark>>benchmarkSmalltalkParser"
         #'stx:goodies/petitparser/compiler'    "PPCConfiguration - referenced by PPCBenchmark>>benchmarkSmalltalkParserCompiled"
         #'stx:goodies/petitparser/compiler/tests/extras'    "PPCResources - referenced by PPCBenchmark>>initialize"
         #'stx:goodies/petitparser/parsers/java'    "PPJavaSyntax - referenced by PPCBenchmark>>benchmarkJavaSyntax"
-        #'stx:goodies/petitparser/parsers/smalltalk'    "PPSmalltalkGrammar - referenced by PPCBenchmark>>setupSmalltalkGrammar"
-        #'stx:goodies/refactoryBrowser/parser'    "RBParser - referenced by PPCBenchmark>>benchmarkRBParserC"
+        #'stx:goodies/refactoryBrowser/parser'    "RBArrayNode - referenced by PPCSmalltalkNoopParser>>buildArray:"
     )
 !
 
@@ -101,6 +104,8 @@
     ^ #(
         "<className> or (<className> attributes...) in load order"
         PPCBenchmark
+        PPCSmalltalkNoopParser
+        (PPCSmalltalkNoopParserTests autoload)
         #'stx_goodies_petitparser_compiler_benchmarks'
     )
 !
--- a/compiler/benchmarks/vcmake.bat	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/benchmarks/vcmake.bat	Fri Jul 24 15:06:54 2015 +0100
@@ -10,11 +10,8 @@
     popd
 )
 @SET DEFINES=
-@REM Kludge got Mercurial, cannot be implemented in Borland make
-@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
-@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
 make.exe -N -f bc.mak -DUSEVC=1 %DEFINES% %*
 
 
 
-
--- a/compiler/bmake.bat	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/bmake.bat	Fri Jul 24 15:06:54 2015 +0100
@@ -4,9 +4,7 @@
 @REM do not edit - automatically generated from ProjectDefinition
 @REM -------
 @SET DEFINES=
-@REM Kludge got Mercurial, cannot be implemented in Borland make
-@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
-@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
 make.exe -N -f bc.mak  %DEFINES% %*
 
 
--- a/compiler/extensions.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/extensions.st	Fri Jul 24 15:06:54 2015 +0100
@@ -8,6 +8,12 @@
 
 !Object methodsFor:'*petitcompiler'!
 
+canHavePPCId
+    ^ false
+! !
+
+!Object methodsFor:'*petitcompiler'!
+
 isInlinedMethod
     ^ false
 ! !
@@ -93,6 +99,17 @@
     ^ aPetitCompiler compileChoice: self
 ! !
 
+!PPCompositeParser methodsFor:'*petitcompiler'!
+
+asCompilerNode
+    ^ PPCForwardNode new
+        name: self name;
+        child: parser;
+        yourself
+
+    "Modified: / 22-05-2015 / 21:54:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !PPContext methodsFor:'*petitcompiler'!
 
 asCompiledParserContext
@@ -189,7 +206,9 @@
             child: parser;
             yourself
     ].
-    ^ super asCompilerNode 
+    ^ super asCompilerNode
+
+    "Modified: / 22-05-2015 / 21:53:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !PPDelegateParser methodsFor:'*petitcompiler'!
@@ -612,10 +631,20 @@
     ^ aCollection
 ! !
 
+!PPSequenceParser methodsFor:'*petitcompiler'!
+
+map: aBlock
+        ^ aBlock numArgs = self children size
+                ifTrue: [ PPMappedActionParser on: self block: aBlock ]
+                ifFalse: [ self error: aBlock numArgs asString , ' arguments expected.' ]
+
+    "Modified: / 02-06-2015 / 17:16:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !PPSmalltalkGrammar methodsFor:'*petitcompiler'!
 
 comment
- 	^ $" asParser, $" asParser negate star, $" asParser.	
+ 		^ $" asParser, $" asParser negate star, $" asParser.	
 ! !
 
 !PPSmalltalkGrammar methodsFor:'*petitcompiler'!
--- a/compiler/libInit.cc	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/libInit.cc	Fri Jul 24 15:06:54 2015 +0100
@@ -27,8 +27,17 @@
 void _libstx_goodies_petitparser_compiler_Init(pass, __pRT__, snd)
 OBJ snd; struct __vmData__ *__pRT__; {
 __BEGIN_PACKAGE2__("libstx_goodies_petitparser_compiler", _libstx_goodies_petitparser_compiler_Init, "stx:goodies/petitparser/compiler");
+_PEGFsa_Init(pass,__pRT__,snd);
+_PEGFsaFailure_Init(pass,__pRT__,snd);
+_PEGFsaInterpret_Init(pass,__pRT__,snd);
+_PEGFsaPair_Init(pass,__pRT__,snd);
+_PEGFsaState_Init(pass,__pRT__,snd);
+_PEGFsaTransition_Init(pass,__pRT__,snd);
 _PPCArguments_Init(pass,__pRT__,snd);
 _PPCBridge_Init(pass,__pRT__,snd);
+_PPCClassBuilder_Init(pass,__pRT__,snd);
+_PPCCodeBlock_Init(pass,__pRT__,snd);
+_PPCCodeGen_Init(pass,__pRT__,snd);
 _PPCCompiledMethod_Init(pass,__pRT__,snd);
 _PPCCompiler_Init(pass,__pRT__,snd);
 _PPCCompilerTokenErrorStrategy_Init(pass,__pRT__,snd);
@@ -43,9 +52,14 @@
 _PPCNode_Init(pass,__pRT__,snd);
 _PPCNodeVisitor_Init(pass,__pRT__,snd);
 _PPCPluggableConfiguration_Init(pass,__pRT__,snd);
+_PPCScanner_Init(pass,__pRT__,snd);
+_PPCScannerCodeGenerator_Init(pass,__pRT__,snd);
 _PPCTokenGuard_Init(pass,__pRT__,snd);
 _PPCompiledParser_Init(pass,__pRT__,snd);
+_PPMappedActionParser_Init(pass,__pRT__,snd);
 _stx_137goodies_137petitparser_137compiler_Init(pass,__pRT__,snd);
+_FooScanner_Init(pass,__pRT__,snd);
+_PEGFsaGenerator_Init(pass,__pRT__,snd);
 _PPCAbstractLiteralNode_Init(pass,__pRT__,snd);
 _PPCAbstractPredicateNode_Init(pass,__pRT__,snd);
 _PPCAnyNode_Init(pass,__pRT__,snd);
@@ -53,6 +67,7 @@
 _PPCCodeGenerator_Init(pass,__pRT__,snd);
 _PPCDelegateNode_Init(pass,__pRT__,snd);
 _PPCEndOfFileNode_Init(pass,__pRT__,snd);
+_PPCFSACodeGen_Init(pass,__pRT__,snd);
 _PPCInlinedMethod_Init(pass,__pRT__,snd);
 _PPCInliningVisitor_Init(pass,__pRT__,snd);
 _PPCListNode_Init(pass,__pRT__,snd);
@@ -112,6 +127,7 @@
 _PPCTokenChoiceNode_Init(pass,__pRT__,snd);
 _PPCTrimNode_Init(pass,__pRT__,snd);
 _PPCTrimmingCharacterTokenNode_Init(pass,__pRT__,snd);
+_PPCMappedActionNode_Init(pass,__pRT__,snd);
 _PPCTokenStarMessagePredicateNode_Init(pass,__pRT__,snd);
 _PPCTokenStarSeparatorNode_Init(pass,__pRT__,snd);
 
--- a/compiler/mingwmake.bat	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/mingwmake.bat	Fri Jul 24 15:06:54 2015 +0100
@@ -4,9 +4,6 @@
 @REM do not edit - automatically generated from ProjectDefinition
 @REM -------
 @SET DEFINES=
-@REM Kludge got Mercurial, cannot be implemented in Borland make
-@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
-@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
 
 @pushd ..\..\..\rules
 @call find_mingw.bat
--- a/compiler/stx_goodies_petitparser_compiler.st	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/stx_goodies_petitparser_compiler.st	Fri Jul 24 15:06:54 2015 +0100
@@ -75,7 +75,9 @@
 
     ^ #(
         #'stx:goodies/petitparser/analyzer'    "PPSentinel - referenced by PPCompiledParser class>>referringParser"
-        #'stx:libbasic2'    "Stack - referenced by PPCCompiler>>initializeForCompiledClassName:"
+        #'stx:goodies/refactoryBrowser/parser'    "RBAssignmentNode - referenced by PPCCodeGenerator>>visitActionNode:"
+        #'stx:libbasic2'    "IdentityBag - referenced by PEGFsa>>checkTransitionsIdentity"
+        #'stx:libview'    "Color - referenced by PEGFsa>>viewGraphOn:"
     )
 !
 
@@ -107,8 +109,17 @@
 
     ^ #(
         "<className> or (<className> attributes...) in load order"
+        PEGFsa
+        PEGFsaFailure
+        PEGFsaInterpret
+        PEGFsaPair
+        PEGFsaState
+        PEGFsaTransition
         PPCArguments
         PPCBridge
+        PPCClassBuilder
+        PPCCodeBlock
+        PPCCodeGen
         PPCCompiledMethod
         PPCCompiler
         PPCCompilerTokenErrorStrategy
@@ -123,9 +134,14 @@
         PPCNode
         PPCNodeVisitor
         PPCPluggableConfiguration
+        PPCScanner
+        PPCScannerCodeGenerator
         PPCTokenGuard
         PPCompiledParser
+        PPMappedActionParser
         #'stx_goodies_petitparser_compiler'
+        FooScanner
+        PEGFsaGenerator
         PPCAbstractLiteralNode
         PPCAbstractPredicateNode
         PPCAnyNode
@@ -133,6 +149,7 @@
         PPCCodeGenerator
         PPCDelegateNode
         PPCEndOfFileNode
+        PPCFSACodeGen
         PPCInlinedMethod
         PPCInliningVisitor
         PPCListNode
@@ -192,6 +209,7 @@
         PPCTokenChoiceNode
         PPCTrimNode
         PPCTrimmingCharacterTokenNode
+        PPCMappedActionNode
         PPCTokenStarMessagePredicateNode
         PPCTokenStarSeparatorNode
     )
@@ -308,6 +326,9 @@
         PPParser allNodesDo:seen:
         PPSmalltalkWhitespaceParser hash
         PPParser compileTokenizing
+        Object canHavePPCId
+        PPCompositeParser asCompilerNode
+        PPSequenceParser map:
     )
 ! !
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/FooScannerTest.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,162 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#FooScannerTest
+	instanceVariableNames:'scanner result'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Tests-Scanner'
+!
+
+!FooScannerTest methodsFor:'as yet unclassified'!
+
+fail: stream rule: rule 
+    scanner initialize.
+    scanner stream: stream asPetitStream. 
+    result := scanner perform: rule.
+        
+    self assert: result isEmpty
+!
+
+fail: stream token: token rule: rule
+    self fail: stream token: token rule: rule position: stream size
+!
+
+fail: stream token: token rule: rule position: position
+    scanner initialize.
+    scanner stream: stream asPetitStream. 
+    result := scanner perform: rule.
+        
+    self assert: (result at: token ifAbsent: [nil]) isNil.
+!
+
+parse: stream token: token rule: rule
+    self parse: stream token: token rule: rule position: stream size.
+!
+
+parse: stream token: token rule: rule position: position
+    scanner initialize.
+    scanner stream: stream asPetitStream. 
+    result := scanner perform: rule.
+    
+    self assert: (result includesKey: token).	
+    self assert: (result at: token) = position.
+!
+
+setUp
+    scanner := FooScanner new.
+!
+
+testA
+    self parse: 'aaa' token: #a rule: #nextTokenA position: 1.
+!
+
+testAAorA
+    self fail: 	'a' token: #aa rule: #nextTokenAAorA.
+    self parse: 	'aa' token: #aa rule: #nextTokenAAorA.
+    self parse: 	'aaa' token: #aa rule: #nextTokenAAorA position: 2.
+
+    self parse: 	'a' token: #a rule: #nextTokenAAorA.
+    self fail: 	'aa' token: #a rule: #nextTokenAAorA.
+    self fail: 	'aaa' token: #a rule: #nextTokenAAorA.
+
+    self fail: 'b' rule: #nextTokenAAorA.		
+!
+
+testAAplusA
+    self parse: 'aaa' token: #AAplusA rule: #nextTokenAAplusA.
+    self parse: 'aaaaa' token: #AAplusA rule: #nextTokenAAplusA.
+
+    self fail: '' rule: #nextTokenAAplusA.
+    self fail: 'a' rule: #nextTokenAAplusA.
+    self fail: 'aa' rule: #nextTokenAAplusA.
+    self fail: 'aaaa' rule: #nextTokenAAplusA.	
+!
+
+testAAstarA
+    self parse: 'a' token: #AAstarA rule: #nextTokenAAstarA.
+    self parse: 'aaa' token: #AAstarA rule: #nextTokenAAstarA.
+    self parse: 'aaaaa' token: #AAstarA rule: #nextTokenAAstarA.
+
+    self fail: '' rule: #nextTokenAAstarA.
+    self fail: 'aa' rule: #nextTokenAAstarA.
+    self fail: 'aaaa' rule: #nextTokenAAstarA.
+!
+
+testAB
+    self parse: 'ab' token: #b rule: #nextTokenAB position: 2.
+!
+
+testABorBC
+    self parse: 'ab' token: #ab rule: #nextTokenABorBC position: 2.
+    self parse: 'bc' token: #bc rule: #nextTokenABorBC position: 2.
+    
+    self fail: 'ac' rule: #nextTokenABorBC.
+!
+
+testABstarA
+    self parse: 'a' token: #ABstarA rule: #nextTokenABstarA position: 1.
+    self parse: 'aa' token: #ABstarA rule: #nextTokenABstarA position: 1.
+    self parse: 'aba' token: #ABstarA rule: #nextTokenABstarA position: 3.
+    self parse: 'abaa' token: #ABstarA rule: #nextTokenABstarA position: 3.
+    self parse: 'ababa' token: #ABstarA rule: #nextTokenABstarA position: 5.
+
+    self fail: 'ab' rule: #nextTokenABstarA.
+    self fail: 'abab' rule: #nextTokenABstarA.
+
+    self fail: '' rule: #nextTokenABstarA.
+
+!
+
+testA_Bstar_A
+    self parse: 'aa' token: #A_Bstar_A rule: #nextTokenA_Bstar_A.
+    self parse: 'aba' token: #A_Bstar_A rule: #nextTokenA_Bstar_A.
+
+    self fail: '' rule: #nextTokenABstarA.	
+    self fail: 'ab' rule: #nextTokenABstarA.
+!
+
+testAorAA
+    self fail: 	'a' token: #aa rule: #nextTokenAorAA.
+    self fail: 	'aa' token: #aa rule: #nextTokenAorAA.
+    self fail: 	'aaa' token: #aa rule: #nextTokenAorAA.
+
+    self parse: 	'a' token: #a rule: #nextTokenAorAA position: 1.
+    self parse: 	'aa' token: #a rule: #nextTokenAorAA position: 1.
+    self parse: 	'aaa' token: #a rule: #nextTokenAorAA position: 1.
+
+    self fail: 'b' rule: #nextTokenAAorA.		
+!
+
+testAorB
+    self parse: 'a' token: #a rule: #nextTokenAorB.
+    self parse: 'b' token: #b rule: #nextTokenAorB.	
+
+    self parse: 'ab' token: #a rule: #nextTokenAorB position: 1.	
+    self fail: 'c' rule: #nextTokenAorB.	
+    self fail: 'c' rule: #nextTokenAorB.		
+!
+
+testAstarA
+    self fail: '' rule: #nextTokenAstarA.
+    self fail: 'a' rule: #nextTokenAstarA.
+    self fail: 'aa' rule: #nextTokenAstarA.
+    self fail: 'aaa' rule: #nextTokenAstarA.
+!
+
+testAstarB
+    self parse: 'ab' token: #AstarB rule: #nextTokenAstarB.
+    self parse: 'b' token: #AstarB rule: #nextTokenAstarB.
+    self parse: 'aaab' token: #AstarB rule: #nextTokenAstarB.
+
+    self fail: 'c' rule: #nextTokenAstarB.	
+!
+
+testAuorA
+    self parse: 'a' token: #a1 rule: #nextTokenAuorA.
+    self parse: 'a' token: #a2 rule: #nextTokenAuorA.
+
+    self fail: 'b' rule: #nextTokenAuorA.	
+! !
+
--- a/compiler/tests/Make.proto	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/tests/Make.proto	Fri Jul 24 15:06:54 2015 +0100
@@ -103,7 +103,6 @@
 prereq:
 	cd ../../../../libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
 	cd ../../../../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
-	cd ../../../../libbasic3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
 	cd ../../../../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
 	cd ../../ && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
 	cd ../../../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
@@ -128,6 +127,15 @@
 
 
 # BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)FooScannerTest.$(O) FooScannerTest.$(H): FooScannerTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaDeterminizationTest.$(O) PEGFsaDeterminizationTest.$(H): PEGFsaDeterminizationTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaGeneratorTest.$(O) PEGFsaGeneratorTest.$(H): PEGFsaGeneratorTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaInterpretTest.$(O) PEGFsaInterpretTest.$(H): PEGFsaInterpretTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaScannerIntegrationTest.$(O) PEGFsaScannerIntegrationTest.$(H): PEGFsaScannerIntegrationTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaStateTest.$(O) PEGFsaStateTest.$(H): PEGFsaStateTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaTest.$(O) PEGFsaTest.$(H): PEGFsaTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaTransitionTest.$(O) PEGFsaTransitionTest.$(H): PEGFsaTransitionTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCClassBuilderTest.$(O) PPCClassBuilderTest.$(H): PPCClassBuilderTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCCodeGeneratorTest.$(O) PPCCodeGeneratorTest.$(H): PPCCodeGeneratorTest.st $(INCLUDE_TOP)/stx/goodies/petitparser/tests/PPAbstractParserTest.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCCompilerTest.$(O) PPCCompilerTest.$(H): PPCCompilerTest.st $(INCLUDE_TOP)/stx/goodies/petitparser/tests/PPAbstractParserTest.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCContextMementoTest.$(O) PPCContextMementoTest.$(H): PPCContextMementoTest.st $(INCLUDE_TOP)/stx/goodies/petitparser/tests/PPContextMementoTest.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
@@ -144,6 +152,7 @@
 $(OUTDIR)PPCOptimizeChoicesTest.$(O) PPCOptimizeChoicesTest.$(H): PPCOptimizeChoicesTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCRecognizerComponentDetectorTest.$(O) PPCRecognizerComponentDetectorTest.$(H): PPCRecognizerComponentDetectorTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCRecognizerComponentVisitorTest.$(O) PPCRecognizerComponentVisitorTest.$(H): PPCRecognizerComponentVisitorTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCScannerCodeGeneratorTest.$(O) PPCScannerCodeGeneratorTest.$(H): PPCScannerCodeGeneratorTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCSpecializingVisitorTest.$(O) PPCSpecializingVisitorTest.$(H): PPCSpecializingVisitorTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCTokenDetectorTest.$(O) PPCTokenDetectorTest.$(H): PPCTokenDetectorTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)PPCTokenGuardTest.$(O) PPCTokenGuardTest.$(H): PPCTokenGuardTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
--- a/compiler/tests/Make.spec	Thu May 21 14:12:22 2015 +0100
+++ b/compiler/tests/Make.spec	Fri Jul 24 15:06:54 2015 +0100
@@ -51,6 +51,15 @@
 STCWARNINGS=-warnNonStandard
 
 COMMON_CLASSES= \
+	FooScannerTest \
+	PEGFsaDeterminizationTest \
+	PEGFsaGeneratorTest \
+	PEGFsaInterpretTest \
+	PEGFsaScannerIntegrationTest \
+	PEGFsaStateTest \
+	PEGFsaTest \
+	PEGFsaTransitionTest \
+	PPCClassBuilderTest \
 	PPCCodeGeneratorTest \
 	PPCCompilerTest \
 	PPCContextMementoTest \
@@ -67,6 +76,7 @@
 	PPCOptimizeChoicesTest \
 	PPCRecognizerComponentDetectorTest \
 	PPCRecognizerComponentVisitorTest \
+	PPCScannerCodeGeneratorTest \
 	PPCSpecializingVisitorTest \
 	PPCTokenDetectorTest \
 	PPCTokenGuardTest \
@@ -81,6 +91,15 @@
 
 
 COMMON_OBJS= \
+    $(OUTDIR_SLASH)FooScannerTest.$(O) \
+    $(OUTDIR_SLASH)PEGFsaDeterminizationTest.$(O) \
+    $(OUTDIR_SLASH)PEGFsaGeneratorTest.$(O) \
+    $(OUTDIR_SLASH)PEGFsaInterpretTest.$(O) \
+    $(OUTDIR_SLASH)PEGFsaScannerIntegrationTest.$(O) \
+    $(OUTDIR_SLASH)PEGFsaStateTest.$(O) \
+    $(OUTDIR_SLASH)PEGFsaTest.$(O) \
+    $(OUTDIR_SLASH)PEGFsaTransitionTest.$(O) \
+    $(OUTDIR_SLASH)PPCClassBuilderTest.$(O) \
     $(OUTDIR_SLASH)PPCCodeGeneratorTest.$(O) \
     $(OUTDIR_SLASH)PPCCompilerTest.$(O) \
     $(OUTDIR_SLASH)PPCContextMementoTest.$(O) \
@@ -97,6 +116,7 @@
     $(OUTDIR_SLASH)PPCOptimizeChoicesTest.$(O) \
     $(OUTDIR_SLASH)PPCRecognizerComponentDetectorTest.$(O) \
     $(OUTDIR_SLASH)PPCRecognizerComponentVisitorTest.$(O) \
+    $(OUTDIR_SLASH)PPCScannerCodeGeneratorTest.$(O) \
     $(OUTDIR_SLASH)PPCSpecializingVisitorTest.$(O) \
     $(OUTDIR_SLASH)PPCTokenDetectorTest.$(O) \
     $(OUTDIR_SLASH)PPCTokenGuardTest.$(O) \
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PEGFsaDeterminizationTest.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,259 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PEGFsaDeterminizationTest
+	instanceVariableNames:'fsa a b c result d interpreter e'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Tests-FSA'
+!
+
+!PEGFsaDeterminizationTest methodsFor:'as yet unclassified'!
+
+assert: anFsa fail: input
+    | stream |
+    stream := input asPetitStream.
+
+    result := interpreter interpret: anFsa on: stream.
+
+    self assert: result isEmpty.
+    ^ result
+!
+
+assert: anFsa parse: input retval: name
+    ^ self assert: anFsa parse: input retval: name end: input size
+!
+
+assert: anFsa parse: input retval: name end: end
+    | stream |
+    stream := input asPetitStream.
+
+    result := interpreter interpret: anFsa on: stream.
+
+    self assert: result isEmpty not.
+    self assert: ((result at: name) = end) description: 'wrong position'.
+    
+    ^ result
+!
+
+assertFail: name
+    self assert: (result includesKey: name) not
+!
+
+assertPass: name
+    self assert: (result includesKey: name)
+!
+
+setUp
+    a := PEGFsaState new name: #a; retval: #a; yourself.
+    b := PEGFsaState new name: #b; retval: #b; yourself.
+    c := PEGFsaState new name: #c; retval: #c; yourself.
+    d := PEGFsaState new name: #d; retval: #d; yourself.
+    e := PEGFsaState new name: #e; retval: #e; yourself.
+
+    fsa := PEGFsa new.
+
+    interpreter := PEGFsaInterpret new
+        yourself.
+!
+
+testAAplusA
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa addState: e.
+    fsa startState: a.
+    fsa finalState: e.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: c on: $a.
+    fsa addTransitionFrom: c to: a.	
+    fsa addTransitionFrom: c to: d priority: -1. 
+    fsa addTransitionFrom: d to: e on: $a.
+    
+    c priority: 0.
+    
+    fsa determinize.
+
+"	self assert: fsa states size = 3."
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+    
+    self assert: fsa fail: 'a'.
+    self assert: fsa fail: 'aa'.
+    self assert: fsa fail: 'aaaa'.
+
+    self assert: fsa parse: 'aaa' retval: #e.
+    self assert: fsa parse: 'aaaaa' retval: #e.
+    self assert: fsa parse: 'aaaaaaa' retval: #e.
+!
+
+testAB
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa startState: a.
+    fsa finalState: d.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: c to: d on: $b.	
+    fsa addTransitionFrom: b to: c priority: -1. 
+    
+    fsa determinize.
+
+    self assert: fsa states size = 3.
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+    
+    self assert: fsa parse: 'ab' retval: #d.
+    self assert: fsa parse: 'abc' retval: #d end: 2.
+    
+    self assert: fsa fail: 'ac'.
+!
+
+testAPlusA
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa startState: a.
+    fsa finalState: d.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: a.	
+    fsa addTransitionFrom: b to: c priority: -1. 
+    fsa addTransitionFrom: c to: d on: $a.
+    
+    b priority: 0.
+    
+    fsa determinize.
+
+"	self assert: fsa states size = 2."
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+    
+    self assert: fsa fail: 'a'.
+    self assert: fsa fail: 'aa'.
+    self assert: fsa fail: 'b'.
+!
+
+testAPlusB
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa startState: a.
+    fsa finalState: d.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: a.	
+    fsa addTransitionFrom: b to: c priority: -1. 
+    fsa addTransitionFrom: c to: d on: $b.
+    
+    fsa determinize.
+
+    self assert: fsa states size = 3.
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+    
+    self assert: fsa parse: 'ab' retval: #d.
+    self assert: fsa parse: 'aaaab' retval: #d.
+    self assert: fsa parse: 'aaaabc' retval: #d end: 5.
+    
+    self assert: fsa fail: 'b'.
+!
+
+testAorA
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa addState: e.
+    fsa startState: a.
+    fsa finalState: c.
+    fsa finalState: e.
+    
+    fsa addTransitionFrom: a to: b.
+    fsa addTransitionFrom: a to: d.	
+    fsa addTransitionFrom: b to: c on: $a. 
+    fsa addTransitionFrom: d to: e on: $a. 
+    
+    c priority: 0.
+    e priority: 0.
+    
+    fsa determinize.
+
+    self assert: fsa states size = 2.
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+    
+    self assert: fsa parse: 'a' retval: #c.
+    self assert: fsa parse: 'a' retval: #e.
+    self assert: (a transitions allSatisfy: [:t | t priority = 0]).
+    
+    self assert: fsa fail: 'b'.
+!
+
+testApriorityOrA
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa addState: e.
+    fsa startState: a.
+    fsa finalState: c.
+    fsa finalState: e.
+    
+    c priority: 0.
+    e priority: 0.
+    
+    fsa addTransitionFrom: a to: b priority: -1.
+    fsa addTransitionFrom: a to: d.	
+    fsa addTransitionFrom: b to: c on: $a. 
+    fsa addTransitionFrom: d to: e on: $a. 
+    
+    fsa determinize.
+
+    self assert: fsa states size = 2.
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+    
+    self assert: fsa parse: 'a' retval: #e.
+    self assertFail: #c.
+    
+    self assert: fsa fail: 'b'.
+!
+
+testApriorityOrA2
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa addState: e.
+    fsa startState: a.
+    fsa finalState: c.
+    fsa finalState: e.
+    
+    c priority: 0.
+    e priority: 0.
+    
+    fsa addTransitionFrom: a to: b.
+    fsa addTransitionFrom: a to: d priority: -1.	
+    fsa addTransitionFrom: b to: c on: $a. 
+    fsa addTransitionFrom: d to: e on: $a. 
+    
+    fsa determinize.
+
+    self assert: fsa states size = 2.
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+    
+    self assert: fsa parse: 'a' retval: #c.
+    self assertFail: #e.
+    
+    self assert: fsa fail: 'b'.
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PEGFsaGeneratorTest.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,466 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PEGFsaGeneratorTest
+	instanceVariableNames:'result node fsa generator interpreter'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Tests-FSA'
+!
+
+
+!PEGFsaGeneratorTest methodsFor:'as yet unclassified'!
+
+assert: anFsa fail: input
+    | stream |
+    stream := input asPetitStream.
+
+    result := interpreter interpret: anFsa on: stream.
+
+    self assert: result isEmpty.
+    ^ result
+!
+
+assert: interpret parse: input 
+    ^ self assert: interpret parse: input end: input size
+!
+
+assert: anFsa parse: input end: end
+    | stream |
+    stream := input asPetitStream.
+
+    result := interpreter interpret: anFsa on: stream.
+
+    self assert: result isEmpty not.
+    self assert: (result values anySatisfy: [ :pos | pos = end ]) description: 'wrong position'.
+    
+    ^ result
+!
+
+fsaFrom: aNode
+    ^ (aNode accept: generator)
+        compact;
+        yourself
+!
+
+setUp
+    super setUp.
+    generator := PEGFsaGenerator new.
+    interpreter := PEGFsaInterpret new.	
+!
+
+testAAA_Aplusnot
+    | parser |
+    parser := 'aaa' asParser not, $a asParser plus.
+    node := parser asCompilerTree.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: 'a'.	
+    self assert: fsa parse: 'aa'.	
+    self assert: fsa fail: ''.
+    self assert: fsa fail: 'aaa'.
+    self assert: fsa fail: 'aaaa'.
+    self assert: fsa fail: 'aaaaa'.
+!
+
+testAAplusA
+    | parser |
+    parser := 'aa' asParser plus, $a asParser.
+    node := parser asCompilerTree.
+        
+    fsa := self fsaFrom: node.
+
+    self assert: fsa parse: 'aaa'.	
+    self assert: fsa parse: 'aaaaa'.	
+    self assert: fsa parse: 'aaaaaaa'.	
+    self assert: fsa fail: 'a'.
+    self assert: fsa fail: 'aa'.
+    self assert: fsa fail: 'aaaa'.
+!
+
+testAAplusB
+    | parser |
+    parser := 'aa' asParser plus, $b asParser.
+    node := parser asCompilerTree.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: 'aab'.	
+    self assert: fsa parse: 'aaaab'.	
+    self assert: fsa fail: 'a'.
+    self assert: fsa fail: 'aa'.
+    self assert: fsa fail: 'aaaa'.
+    self assert: fsa fail: 'aaaac'.
+!
+
+testAB
+    | parser |
+    parser := $a asParser, $b asParser.
+    node := parser asCompilerTree.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: 'ab'.	
+    self assert: fsa fail: 'a'.
+    self assert: fsa fail: 'b'.
+    self assert: fsa fail: 'ac'.
+!
+
+testA_Boptional
+    | parser |
+    parser := $a asParser, $b asParser optional.
+    node := parser asCompilerTree.
+    
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: 'ab'.	
+    self assert: fsa parse: 'ac' end: 1.	
+    self assert: fsa parse: 'a'.
+    self assert: fsa fail: 'b'.
+!
+
+testA_Boptionaloptional
+    | parser |
+    parser := ($a asParser, $b asParser optional) optional.
+    node := parser asCompilerTree.
+        
+    fsa := self fsaFrom: node.
+
+    self assert: fsa parse: ''.	
+    self assert: fsa parse: 'a'.	
+    self assert: fsa parse: 'ab'.	
+    self assert: fsa parse: 'b' end: 0.
+!
+
+testA_BorC_D
+    | parser |
+    parser := $a asParser, ($b asParser / $c asParser), $d asParser.
+    node := parser asCompilerTree.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: 'abd'.	
+    self assert: fsa parse: 'acd'.	
+    self assert: fsa fail: 'abc'.
+    self assert: fsa fail: 'add'.
+    self assert: fsa fail: 'ad'.
+!
+
+testAorAA
+    | parser |
+    parser := 'a' asParser / 'aa' asParser.
+    node := parser asCompilerTree.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: 'a'.	
+    self assert: fsa parse: 'aa' end: 1.	
+    self assert: fsa parse: 'aaaaaaa' end: 1.	
+    self assert: fsa fail: ''.
+    self assert: fsa fail: 'b'.
+!
+
+testAorAX_X
+    | parser |
+    parser := ('a' asParser / 'ax' asParser), $x asParser.
+    node := parser asCompilerTree.
+    
+    fsa := self fsaFrom: node.
+
+    self assert: fsa parse: 'ax'.	
+    self assert: fsa parse: 'axx' end: 2.	
+    self assert: fsa fail: 'a'.
+    self assert: fsa fail: 'x'.
+    self assert: fsa fail: ''.
+!
+
+testAorBC_X
+    | parser |
+    parser := ('a' asParser / 'bc' asParser), $x asParser.
+    node := parser asCompilerTree.
+        
+    fsa := self fsaFrom: node.
+
+    self assert: fsa parse: 'ax'.	
+    self assert: fsa parse: 'bcx' end: 3.	
+    self assert: fsa fail: 'bx'.
+    self assert: fsa fail: 'cx'.
+    self assert: fsa fail: 'a'.	
+    self assert: fsa fail: 'bc'.		
+!
+
+testAorB_Coptionaloptional
+    | parser |
+    parser := (($a asParser / $b asParser), $c asParser optional) optional.
+    node := parser asCompilerTree.
+        
+    fsa := self fsaFrom: node.
+
+    self assert: fsa parse: ''.	
+    self assert: fsa parse: 'a'.	
+    self assert: fsa parse: 'b'.	
+    self assert: fsa parse: 'ac'.	
+    self assert: fsa parse: 'bc'.	
+    self assert: fsa parse: 'ad' end: 1.	
+    self assert: fsa parse: 'bd' end: 1.	
+    self assert: fsa parse: 'd' end: 0.	
+    self assert: fsa parse: 'c' end: 0.
+!
+
+testAstarA
+    | parser |
+    parser := $a asParser star, $a asParser.
+    node := parser asCompilerTree.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa fail: 'a'.
+    self assert: fsa fail: 'aa'.
+    self assert: fsa fail: 'aaa'.
+!
+
+testAstarB
+    | parser |
+    parser := $a asParser star, $b asParser.
+    node := parser asCompilerTree.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: 'b'.	
+    self assert: fsa parse: 'ab'.	
+    self assert: fsa parse: 'aaab'.	
+    self assert: fsa fail: 'a'.
+    self assert: fsa fail: 'ac'.
+    self assert: fsa fail: 'aac'.
+!
+
+testCharSet
+    | parser |
+    parser := #letter asParser.
+    node := parser asCompilerTree.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: 'a'.	
+    self assert: fsa parse: 'z'.	
+    self assert: fsa parse: 'A'.	
+    self assert: fsa parse: 'Z'.	
+    self assert: fsa fail: '_'.
+    self assert: fsa fail: '()'.
+    self assert: fsa fail: ''.
+!
+
+testCharSetPredicateNode
+    node := PPCCharSetPredicateNode new 
+        predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
+        yourself.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: 'a' end: 1.
+    self assert: fsa parse: 'ab' end: 1.
+    self assert: fsa fail: 'b'.
+!
+
+testCharSetPredicateNode2
+    node := PPCCharSetPredicateNode new 
+        predicate: (PPCharSetPredicate on: [ :e | e isDigit ]);
+        yourself.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: '1' end: 1.
+    self assert: fsa parse: '0' end: 1.
+    self assert: fsa parse: '5' end: 1.
+    self assert: fsa fail: 'a'.
+!
+
+testCharacterNode
+    node := PPCCharacterNode new
+        character: $a;
+        yourself.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: 'a' end: 1.
+    self assert: fsa parse: 'ab' end: 1.
+    self assert: fsa fail: 'b'.
+!
+
+testChoiceNode
+    | literal1 literal2 |
+    literal1 := PPCLiteralNode new
+        literal: 'foo';
+        yourself.
+    literal2 := PPCLiteralNode new
+        literal: 'bar';
+        yourself.
+    
+    node := PPCChoiceNode new
+        children: { literal1 . literal2 };
+        yourself.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: 'foo'.
+    self assert: fsa parse: 'bar'.	
+self assert: fsa fail: 'fof'.		
+!
+
+testChoicePriorities
+    | parser |
+    parser := ($a asParser optional, $b asParser optional) / $a asParser.
+    node := parser asCompilerTree.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: 'ab'.	
+    self assert: fsa parse: 'a' end: 1.	
+    self assert: fsa parse: 'b' end: 1.	
+    self assert: fsa parse: ''.
+    self assert: fsa parse: 'c' end: 0.
+!
+
+testLiteralNode
+    node := PPCLiteralNode new
+        literal: 'foo';
+        yourself.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: 'foo' end: 3.
+    self assert: fsa parse: 'foobar' end: 3.
+    self assert: fsa fail: 'fox'.
+    self assert: fsa fail: 'bar'.
+!
+
+testLiteralNode2
+    node := PPCLiteralNode new
+        literal: '';
+        yourself.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: ''.
+!
+
+testNot
+    | parser |
+    parser := 'aaa' asParser not, $a asParser plus.
+    node := parser asCompilerTree.
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: 'a'.	
+    self assert: fsa parse: 'aa'.	
+    self assert: fsa fail: 'aaa'.
+    self assert: fsa fail: 'aaaa'.
+    self assert: fsa fail: ''.
+!
+
+testNotNode
+    | literal  |
+    literal := PPCLiteralNode new
+        literal: 'foo';
+        yourself.
+
+    node := PPCNotNode new
+        child: literal;
+        yourself.
+    
+    fsa := self fsaFrom: node.
+
+    self assert: fsa parse: 'fo' end: 0.	
+    self assert: fsa parse: 'z' end: 0.	
+    self assert: fsa parse: 'foO' end: 0.	
+    self assert: fsa parse: 'bar' end: 0.	
+    self assert: fsa parse: ''.
+    self assert: fsa fail: 'foo'.
+!
+
+testPlusNode
+    | literal |
+    literal := PPCLiteralNode new
+        literal: 'foo';
+        yourself.
+    
+    node := PPCPlusNode new
+        child: literal;
+        yourself.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa fail: ''.
+    self assert: fsa parse: 'foo'.	
+    self assert: fsa parse: 'foofoofoo'.		
+!
+
+testSequenceNode
+    | literal1 literal2 |
+    literal1 := PPCLiteralNode new
+        literal: 'foo';
+        yourself.
+    literal2 := PPCLiteralNode new
+        literal: 'bar';
+        yourself.
+    
+    node := PPCSequenceNode new
+        children: { literal1 . literal2 };
+        yourself.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: 'foobar'.
+    self assert: fsa fail: 'foo'.	
+    self assert: fsa fail: 'bar'.		
+!
+
+testSequenceNode2
+    | literal1 literal2 literal3 |
+    literal1 := PPCLiteralNode new
+        literal: 'b';
+        yourself.
+    literal2 := PPCLiteralNode new
+        literal: 'a';
+        yourself.
+    literal3 := PPCLiteralNode new
+        literal: 'z';
+        yourself.
+    
+    node := PPCSequenceNode new
+        children: { literal1 . literal2 . literal3 };
+        yourself.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: 'baz'.
+    self assert: fsa fail: 'bar'.	
+    self assert: fsa fail: 'faz'.		
+    self assert: fsa fail: 'boz'.				
+!
+
+testStarNode
+    | literal |
+    literal := PPCLiteralNode new
+        literal: 'foo';
+        yourself.
+    
+    node := PPCStarNode new
+        child: literal;
+        yourself.
+        
+    fsa := self fsaFrom: node.
+    
+    self assert: fsa parse: ''.
+    self assert: fsa parse: 'foo'.	
+    self assert: fsa parse: 'foofoofoo'.		
+! !
+
+!PEGFsaGeneratorTest class methodsFor:'documentation'!
+
+version_HG
+
+    ^ '$Changeset: <not expanded> $'
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PEGFsaInterpretTest.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,442 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PEGFsaInterpretTest
+	instanceVariableNames:'fsa a b c result d interpreter e'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Tests-FSA'
+!
+
+!PEGFsaInterpretTest methodsFor:'as yet unclassified'!
+
+assert: anFsa fail: input
+    | stream |
+    stream := input asPetitStream.
+
+    result := interpreter interpret: anFsa on: stream.
+
+    self assert: result isEmpty.
+    ^ result
+!
+
+assert: anFsa parse: input 
+    ^ self assert: anFsa parse: input end: input size
+!
+
+assert: anFsa parse: input end: end
+    | stream |
+    stream := input asPetitStream.
+    anFsa fixFinalStatePriorities.
+
+    result := interpreter interpret: anFsa on: stream.
+
+    self assert: result isEmpty not.
+    self assert: (result values anySatisfy: [ :pos | pos = end ]) description: 'wrong position'.
+    
+    ^ result
+!
+
+assert: anFsa parse: input retval: name
+    ^ self assert: anFsa parse: input retval: name end: input size
+!
+
+assert: anFsa parse: input retval: name end: end
+    | stream |
+    stream := input asPetitStream.
+    anFsa fixFinalStatePriorities.
+    
+    result := interpreter interpret: anFsa on: stream.
+
+    self assert: result isEmpty not.
+    self assert: ((result at: name) = end) description: 'wrong position'.
+    
+    ^ result
+!
+
+assert: name position: pos
+    ^ self assert: ((result at: name) = pos)
+!
+
+assertFail: name
+    self assert: (result includesKey: name) not
+!
+
+assertPass: name
+    self assert: (result includesKey: name)
+!
+
+setUp
+    a := PEGFsaState new name: #a; retval: #a; yourself.
+    b := PEGFsaState new name: #b; retval: #b; yourself.
+    c := PEGFsaState new name: #c; retval: #c; yourself.
+    d := PEGFsaState new name: #d; retval: #d; yourself.
+    e := PEGFsaState new name: #e; retval: #e; yourself.
+
+    fsa := PEGFsa new.
+
+    interpreter := PEGFsaInterpret new
+        yourself.
+!
+
+testAB
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: c.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: c on: $b.	
+    
+    self assert: fsa parse: 'ab' retval: #c.
+    self assert: fsa parse: 'abc' retval: #c end: 2.
+    
+    self assert: fsa fail: 'ac'.
+!
+
+testABPlus
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: c.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: a on: $b.	
+    fsa addTransitionFrom: b to: c on: $b.	
+    
+    self assert: fsa parse: 'ab'.
+    self assert: fsa parse: 'ababab'.
+    self assert: fsa parse: 'abababc' end: 6.
+    
+    self assert: fsa fail: 'ac'.
+!
+
+testAOptional
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: b.
+    fsa finalState: c.
+    
+    c priority: -1.
+    b priority: 0.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: a to: c priority: -1.
+    
+    self assert: fsa parse: 'a'.
+    self assert: fsa parse: 'ab' end: 1.
+    self assert: fsa parse: 'b' end: 0.
+!
+
+testAPlusA
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa startState: a.
+    fsa finalState: d.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+
+    fsa addTransitionFrom: c to: d on: $a.	
+    fsa addTransitionFrom: c to: d on: $b.	
+
+    b priority: 0.
+    d priority: -1.
+    fsa addTransitionFrom: b to: a.	"a-loop"
+    fsa addTransitionFrom: b to: c priority: -1. "sequence"
+
+    
+    self assert: fsa parse: 'aaab'.
+    self assert: fsa fail: 'aaaa'.
+!
+
+testAPlusB
+    fsa addState: a.
+    fsa addState: b.
+    fsa startState: a.
+    fsa finalState: b.
+    
+    fsa addTransitionFrom: a to: a on: $a.
+    fsa addTransitionFrom: a to: b on: $b.	
+    
+    self assert: fsa parse: 'ab'.
+    self assert: fsa parse: 'aaaab'.
+    self assert: fsa parse: 'abc' end: 2.
+    
+    self assert: fsa fail: 'ac'.
+!
+
+testChoice
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: b.
+    fsa finalState: c.
+    
+    fsa addTransitionFrom: a to: b on: $b.
+    fsa addTransitionFrom: a to: c on: $c.	
+    
+    self assert: fsa parse: 'b'.
+    self assert: fsa parse: 'c'.
+
+    self assert: fsa fail: 'a'
+!
+
+testChoice2
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: b.
+    fsa finalState: c.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: a to: c on: $a.	
+    
+    self assert: fsa parse: 'a'.
+    self assert: #b position: 1.
+    self assert: #c position: 1.
+    
+    self assert: fsa fail: 'b'
+!
+
+testEmpty
+    fsa addState: a.
+    fsa startState: a.
+    fsa finalState: a.
+    
+"	fsa addTransitionFrom: a to: b.
+"	
+    self assert: fsa parse: '' retval: #a.
+!
+
+testEpsilonChoice
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa addState: e.
+    fsa startState: a.
+    fsa finalState: c.
+    fsa finalState: e.
+    
+    fsa addTransitionFrom: b to: c on: $c.
+    fsa addTransitionFrom: d to: e on: $e.	
+    
+    fsa addTransitionFrom: a to: b.
+    fsa addTransitionFrom: a to: d.
+    
+    self assert: fsa parse: 'c'.
+    self assert: fsa parse: 'e'.
+
+    self assert: fsa fail: 'a'
+!
+
+testEpsilonChoice2
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa addState: e.
+    fsa startState: a.
+    fsa finalState: c.
+    fsa finalState: e.
+    
+    fsa addTransitionFrom: b to: c on: $a.
+    fsa addTransitionFrom: d to: e on: $a.	
+    
+    fsa addTransitionFrom: a to: b.
+    fsa addTransitionFrom: a to: d.
+    
+    self assert: fsa parse: 'a'.
+    self assert: #c position: 1.
+    self assert: #e position: 1.
+
+    self assert: fsa fail: 'b'
+!
+
+testOverlap
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: b.
+    fsa finalState: c.
+    
+    b priority: -1.
+    c priority: -1.
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: c on: $a priority: -1.	
+    
+    self assert: fsa parse: 'aa'.
+    self assertPass: #b.
+    self assertPass: #c.
+    
+    self assert: fsa parse: 'ac' end: 1.
+    self assertPass: #b.
+    self assertFail: #c.	
+!
+
+testOverlap2
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: b.
+    fsa finalState: c.
+    
+    b priority: 0.
+    c priority: -1.
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: c on: $a priority: -1.	
+    
+    self assert: fsa parse: 'aa' end: 1.
+    self assertPass: #b.
+    self assertFail: #c.
+    
+    self assert: fsa parse: 'ac' end: 1.
+    self assertPass: #b.
+    self assertFail: #c.	
+!
+
+testPriorityChoice
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: b.
+    fsa finalState: c.
+    
+    b priority: 0.
+    c priority: -1.
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: a to: c on: $a priority: -1.	
+    
+    self assert: fsa parse: 'a'.
+    self assert: #b position: 1.
+    self assert: (result includesKey: #b).
+    self assert: (result includesKey: #c) not.
+    
+    self assert: fsa fail: 'b'
+!
+
+testPriorityChoice2
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: b.
+    fsa finalState: c.
+    
+    b priority: -1.
+    c priority: 0.
+    fsa addTransitionFrom: a to: b on: $a priority: -1.
+    fsa addTransitionFrom: a to: c on: $a.	
+    
+    self assert: fsa parse: 'a'.
+    self assert: #c position: 1.
+    self assert: (result includesKey: #b) not.
+    self assert: (result includesKey: #c).
+    
+    self assert: fsa fail: 'b'
+!
+
+testPriorityContinuation
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    
+    fsa finalState: b.
+    fsa finalState: c.
+    
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: c on: $a priority: -1.	
+    
+    b retval: PEGFsaFailure new.
+    b priority: 0.
+    c priority: -1.
+    
+    self assert: fsa fail: 'a'.
+    self assert: fsa fail: 'aa'
+!
+
+testPriorityEpsilonChoice
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa addState: e.
+    fsa startState: a.
+    fsa finalState: c.
+    fsa finalState: e.
+    
+    fsa addTransitionFrom: b to: c on: $a.
+    fsa addTransitionFrom: d to: e on: $a.	
+    
+    c priority: 0.
+    e priority: -1.
+    fsa addTransitionFrom: a to: b.
+    fsa addTransitionFrom: a to: d priority: -1.
+    
+    self assert: fsa parse: 'a'.
+    self assert: #c position: 1.
+    self assertPass: #c.
+    self assertFail: #e.
+    
+    self assert: fsa fail: 'b'
+!
+
+testPriorityEpsilonChoice2
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa addState: e.
+    fsa startState: a.
+    fsa finalState: c.
+    fsa finalState: e.
+    
+    fsa addTransitionFrom: b to: c on: $a.
+    fsa addTransitionFrom: d to: e on: $a.	
+    
+    c priority: -1.
+    e priority: 0.
+    fsa addTransitionFrom: a to: b priority: -1.
+    fsa addTransitionFrom: a to: d.
+    
+    self assert: fsa parse: 'a'.
+    self assert: #e position: 1.
+    self assertPass: #e.
+    self assertFail: #c.
+
+    self assert: fsa fail: 'b'
+!
+
+testPriorityReturn
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: b.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: c on: $a.	
+    
+    b priority: -1.
+    c priority: 0.
+    
+    self assert: fsa parse: 'a'.
+    self assert: #b position: 1.
+
+    self assert: fsa fail: 'aa'
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PEGFsaScannerIntegrationTest.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,392 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PEGFsaScannerIntegrationTest
+	instanceVariableNames:'fsa fsaGenerator parser scanner result compiled'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Tests-Scanner'
+!
+
+!PEGFsaScannerIntegrationTest methodsFor:'as yet unclassified'!
+
+compile
+    | ppcTree |
+    compiled ifTrue: [ ^ self ].
+    ppcTree := parser asCompilerTree.
+    fsa := ppcTree asFsa.
+    fsa name: #nextToken.
+    fsa finalStates do: [ :s | s isFailure ifFalse: [s retval: #token ]].
+
+    scanner := ((PPCScannerCodeGenerator new)
+        generate: fsa).
+
+    compiled := true
+!
+
+failScan: stream
+    self compile.
+
+    scanner initialize.
+    scanner stream: stream asPetitStream. 
+    result := scanner nextToken.
+        
+    self assert: result isEmpty
+!
+
+scan: stream token: token
+    self scan: stream token: token position: stream size.
+!
+
+scan: stream token: token position: position
+    self compile.
+
+    scanner initialize.
+    scanner stream: stream asPetitStream. 
+    result := scanner nextToken.
+        
+    self assert: result isCollection description: 'no collection returned as a result!!'.
+    self assert: (result isEmpty not) description: 'no token found'.
+    self assert: (result at: token) = position.
+!
+
+setUp
+    compiled := false.
+    fsaGenerator := PEGFsaGenerator new.
+!
+
+testA
+    parser := 'a' asParser.
+    
+    self compile.
+
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+    
+    self failScan: ''.
+    self failScan: 'b'.
+
+    self scan: 'a' token: #token position: 1.
+    self scan: 'aaa' token: #token position: 1.
+!
+
+testAAA_Aplusnot
+    parser := 'aaa' asParser not, $a asParser plus.
+    self compile.
+
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+
+    self scan: 'a' token: #token.
+    self scan: 'aa' token: #token.
+
+    self failScan: ''.
+    self failScan: 'aaa'.
+    self failScan: 'aaaa'.
+    self failScan: 'aaaaa'.
+!
+
+testAAplus_A
+    parser := 'aa' asParser plus, $a asParser.
+    
+    self scan: 'aaa' token: #token.
+    self scan: 'aaaaa' token: #token.
+
+    self failScan: 'a'.
+    self failScan: 'aa'.
+    self failScan: 'aaaa'.
+!
+
+testAAplus_B
+    parser := 'aa' asParser plus, $b asParser.
+    
+    self scan: 'aab' token: #token.
+    self scan: 'aaaab' token: #token.
+
+    self failScan: 'ab'.
+    self failScan: 'aaab'.
+    self failScan: 'aac'.
+!
+
+testAAstar_A
+    parser := 'aa' asParser star, $a asParser.
+    
+    self scan: 'a' token: #token.
+    self scan: 'aaa' token: #token.
+    self scan: 'aaaaa' token: #token.
+    self scan: 'aaaaaaa' token: #token.
+
+
+    self failScan: 'aa'.
+    self failScan: 'aaaa'.
+!
+
+testAAstar_B
+    parser := 'aa' asParser star, $b asParser.
+    
+    self scan: 'b' token: #token.
+    self scan: 'aab' token: #token.
+    self scan: 'aaaab' token: #token.
+    self scan: 'aaaaaab' token: #token.
+
+
+    self failScan: 'ab'.
+    self failScan: 'aaa'.
+!
+
+testAB
+    parser := 'ab' asParser.
+    
+    self compile.
+
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+    
+    self failScan: ''.
+    self failScan: 'b'.
+
+    self scan: 'ab' token: #token position: 2.
+    self scan: 'aba' token: #token position: 2.
+!
+
+testA_BCorCD_D
+    parser := $a asParser, ('bc' asParser / 'cd' asParser), $d asParser.
+    
+    self scan: 'abcd' token: #token.
+    self scan: 'acdd' token: #token.
+
+    self failScan: 'abdd'.
+    self failScan: 'ad'.
+    self failScan: 'aacd'.
+!
+
+testA_BCorCDplus_D
+    parser := $a asParser, ('bc' asParser / 'cd' asParser) plus, $d asParser.
+    
+    self scan: 'abcd' token: #token.
+    self scan: 'acdd' token: #token.
+    self scan: 'abcbccdd' token: #token.
+    self scan: 'acdcdbcbcd' token: #token.
+
+    self failScan: 'abdd'.
+    self failScan: 'ad'.
+    self failScan: 'abcccd'.
+!
+
+testA_BCorCDstar_D
+    parser := $a asParser, ('bc' asParser / 'cd' asParser) star, $d asParser.
+    
+    self scan: 'ad' token: #token.
+    self scan: 'abcd' token: #token.
+    self scan: 'acdd' token: #token.
+    self scan: 'abcbccdd' token: #token.
+    self scan: 'acdcdbcbcd' token: #token.
+
+    self failScan: 'abdd'.
+    self failScan: 'abcccd'.
+!
+
+testA_Bnot
+    parser := 'a' asParser, $b asParser not.
+    
+    self compile.
+
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+    
+    self failScan: 'ab'.
+    self failScan: 'bb'.
+
+    self scan: 'a' token: #token position: 1.
+    self scan: 'ac' token: #token position: 1.
+!
+
+testA_Boptional
+    parser := $a asParser, $b asParser optional.
+    
+    self compile.
+
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+    
+    self failScan: ''.
+    self failScan: 'b'.
+
+    self scan: 'ab' token: #token position: 2.
+    self scan: 'ac' token: #token position: 1.
+    self scan: 'a' token: #token position: 1.
+!
+
+testA_BorC_D
+    parser := $a asParser, ($b asParser / $c asParser), $d asParser.
+    
+    self scan: 'abd' token: #token.
+    self scan: 'acd' token: #token.
+
+    self failScan: 'a'.
+    self failScan: 'abc'.
+    self failScan: 'add'.
+!
+
+testA_BorCplus_D
+    parser := $a asParser, ($b asParser / $c asParser) plus, $d asParser.
+    
+    self scan: 'abd' token: #token.
+    self scan: 'acd' token: #token.
+    self scan: 'abcbcd' token: #token.
+    self scan: 'acbcbcd' token: #token.
+
+    self failScan: 'a'.
+    self failScan: 'ad'.
+    self failScan: 'abc'.
+    self failScan: 'aad'.
+!
+
+testA_BorCstar_D
+    parser := $a asParser, ($b asParser / $c asParser) star, $d asParser.
+    
+    self scan: 'ad' token: #token.
+    self scan: 'abd' token: #token.
+    self scan: 'acd' token: #token.
+    self scan: 'abcbcd' token: #token.
+    self scan: 'acbcbcd' token: #token.
+
+    self failScan: 'a'.
+    self failScan: 'abc'.
+    self failScan: 'aad'.
+!
+
+testAorAA
+    parser := 'a' asParser / 'aa' asParser.
+    self compile.
+
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+    
+    self failScan: ''.
+    self failScan: 'b'.
+
+    self scan: 'aa' token: #token position: 1.
+    self scan: 'a' token: #token position: 1.
+!
+
+testAorAX_X
+    parser := ('a' asParser / 'ax' asParser), $x asParser.
+    
+    self compile.
+
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+    
+    self scan: 'ax' token: #token position: 2.
+    self scan: 'axx' token: #token position: 2.	
+
+    self failScan: 'a'.
+    self failScan: 'x'.
+    self failScan: ''.		
+!
+
+testAorB
+    parser := $a asParser / $b asParser.
+    
+    self compile.
+
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+    
+    self failScan: ''.
+    self failScan: 'c'.
+
+    self scan: 'aa' token: #token position: 1.
+    self scan: 'bb' token: #token position: 1.
+!
+
+testAplus_B
+    parser := $a asParser plus, $b asParser.
+    
+    self scan: 'ab' token: #token.
+    self scan: 'aab' token: #token.
+    self scan: 'aaab' token: #token.
+
+    self failScan: 'b'.
+    self failScan: 'ac'.
+!
+
+testAstar_A
+    parser := $a asParser star, $a asParser.
+    
+    self failScan: 'a'.
+    self failScan: 'aa'.
+    self failScan: 'ac'.
+!
+
+testAstar_B
+    parser := $a asParser star, $b asParser.
+    
+    self scan: 'b' token: #token.
+    self scan: 'ab' token: #token.
+    self scan: 'aab' token: #token.
+
+    self failScan: ''.
+    self failScan: 'ac'.
+!
+
+testAstar_Bnot
+    parser := 'a' asParser star, $b asParser not.
+    
+    self compile.
+
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+    
+    self failScan: 'aaab'.
+    self failScan: 'b'.
+
+    self scan: '' token: #token position: 0.
+    self scan: 'a' token: #token position: 1.
+    self scan: 'aac' token: #token position: 2.
+    self scan: 'aaaac' token: #token position: 4.
+!
+
+testFoo
+    parser := 'foo' asParser.
+    
+    self scan: 'foo' token: #token.
+    self scan: 'foobar' token: #token position: 3.
+
+    self failScan: 'bar'.
+    self failScan: 'fo'.
+!
+
+testNumber
+    parser := #digit asParser plus.
+    
+    self compile.
+
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+    
+    self failScan: ''.
+    self failScan: 'b'.
+
+    self scan: '12' token: #token position: 2.
+    self scan: '2312' token: #token position: 4.
+!
+
+testSmalltalkIdentifier
+    parser := #letter asParser, #word asParser star, $: asParser not.
+    self compile.
+
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.	
+
+    self scan: 'a' token: #token.
+    self scan: 'hithere' token: #token.
+    self scan: 'hi123' token: #token.
+
+    self failScan: ''.
+    self failScan: 'aaa:'.
+    self failScan: '123'.	
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PEGFsaStateTest.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,210 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PEGFsaStateTest
+	instanceVariableNames:'state t1 t2 t3 t4 anotherState'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Tests-FSA'
+!
+
+!PEGFsaStateTest methodsFor:'as yet unclassified'!
+
+setUp
+    state := PEGFsaState new name: #state; retval: #state; yourself.
+    anotherState := PEGFsaState new name: #anotherState; retval: #anotherState; yourself.
+
+    t1 := PEGFsaTransition new.
+    t2 := PEGFsaTransition new.
+    t3 := PEGFsaTransition new.
+    t4 := PEGFsaTransition new.
+    
+!
+
+testCopy
+    state addTransition: t1.
+    anotherState := state copy.
+    
+    self assert: (state = anotherState).
+    self assert: (state == anotherState) not.
+    
+    state retval: #foo.
+    self assert: (state = anotherState) not.
+
+    anotherState retval: #foo.
+    self assert: (state = anotherState).
+    
+    state addTransition: t2.
+    self assert: (state = anotherState) not.
+    
+    anotherState addTransition: t2.
+    self assert: (state = anotherState).
+    
+!
+
+testCopy2
+    state addTransition: t1.
+    anotherState := state copy.
+    
+    self assert: (state = anotherState).
+    self assert: (state == anotherState) not.
+    
+    state addTransition: t2.
+    self assert: (state = anotherState) not.
+    
+    anotherState addTransition: t2 copy.
+    self assert: (state = anotherState).
+    
+!
+
+testCopy3
+    state addTransition: t1.
+    anotherState := state copy.
+    
+    self assert: (state = anotherState).
+    self assert: (state == anotherState) not.
+    
+    t1 addCharacter: $x.
+    self assert: (state = anotherState) not.
+    
+    anotherState transitions anyOne addCharacter: $x.	
+    self assert: (state = anotherState).
+    
+!
+
+testEquals
+    state addTransition: t1.
+    anotherState addTransition: t2.
+
+    state retval: #baz.
+    anotherState retval: #baz.
+    
+    t1 destination: #foo.
+    t2 destination: #bar.
+        
+    self assert: (state equals: anotherState) not
+!
+
+testEquals2
+    state addTransition: t1.
+    anotherState addTransition: t2.
+
+    state retval: #baz.
+    anotherState retval: #baz.
+    
+    t1 destination: #foo.
+    t2 destination: #foo.
+        
+    self assert: (state equals: anotherState).
+!
+
+testEquals3
+    state addTransition: t1.
+    anotherState addTransition: t2.
+
+    state retval: #bar.
+    anotherState retval: #baz.
+    
+    t1 destination: #foo.
+    t2 destination: #foo.
+        
+    self assert: (state equals: anotherState) not
+!
+
+testEquals4
+    state addTransition: t1.
+    anotherState addTransition: t2.
+
+    state retval: #bar.
+    anotherState retval: #bar.
+    
+    state priority: 0.
+    anotherState priority: -1.
+    
+    t1 destination: #foo.
+    t2 destination: #foo.
+        
+    self assert: (state equals: anotherState) not
+!
+
+testEquals5
+    state addTransition: t1.
+    state addTransition: t2.
+    anotherState addTransition: t2.
+    anotherState addTransition: t3.
+
+    state retval: #bar.
+    anotherState retval: #bar.
+    
+    state priority: -1.
+    anotherState priority: -1.
+    
+    t1 destination: #foobar.
+    t2 destination: #foo.
+    t3 destination: #foobar.
+        
+    self assert: (state equals: anotherState)
+!
+
+testEquals6
+    state addTransition: t1.
+    state addTransition: t2.
+    anotherState addTransition: t1.
+
+    state retval: #bar.
+    anotherState retval: #bar.
+    
+    state priority: -1.
+    anotherState priority: -1.
+    
+    t1 destination: #foo.
+    t2 destination: #bar.
+        
+    self assert: (state equals: anotherState) not
+!
+
+testJoin
+    | newState |
+    state addTransition: t1.
+    anotherState addTransition: t2.
+    state final: true.
+    
+    t1 destination: #t1.
+    t2 destination: #t2.
+    
+    newState := state join: anotherState.
+    
+    self assert: (newState transitions contains: [ :t | t = t1 ]).
+    self assert: (newState transitions contains: [ :t | t = t2 ]).
+    self assert: (newState isFinal).	
+!
+
+testJoin2
+    | newState |
+    state addTransition: t1.
+    anotherState addTransition: t2.
+    state final: true.
+    
+    t1 destination: #t1.
+    t2 destination: #t2.
+    
+    newState := anotherState join: state.
+    
+    self assert: (newState transitions contains: [ :t | t = t1 ]).
+    self assert: (newState transitions contains: [ :t | t = t2 ]).
+    self assert: (newState isFinal).	
+!
+
+testTransitionPairs
+    state addTransition: t1.
+    state addTransition: t2.
+    state addTransition: t3.
+    
+    self assert: state transitions size = 3.
+    self assert: state transitionPairs size = 3.
+    self assert: (state transitionPairs includes: (PEGFsaPair with: t1 with: t2)).
+    self assert: (state transitionPairs includes: (PEGFsaPair with: t1 with: t3)).
+    self assert: (state transitionPairs includes: (PEGFsaPair with: t2 with: t3)).		
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PEGFsaTest.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,616 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PEGFsaTest
+	instanceVariableNames:'fsa a b c d e result newFsa'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Tests-FSA'
+!
+
+!PEGFsaTest methodsFor:'as yet unclassified'!
+
+assert: col allSatisfy: block
+    self assert: (col allSatisfy: block).
+!
+
+assert: col anySatisfy: block
+    self assert: (col anySatisfy: block).
+!
+
+setUp
+    a := PEGFsaState new name: #a; retval: #a; yourself.
+    b := PEGFsaState new name: #b; retval: #b; yourself.
+    c := PEGFsaState new name: #c; retval: #c; yourself.
+    d := PEGFsaState new name: #d; retval: #d; yourself.
+    e := PEGFsaState new name: #e; retval: #e; yourself.
+
+    fsa := PEGFsa new.
+!
+
+testBackTransitions
+    fsa addState: a.
+    fsa addState: b.
+    fsa startState: a.
+    fsa finalState: b.
+    
+    fsa addTransitionFrom: a to: a on: $a.
+    fsa addTransitionFrom: a to: b on: $a.
+    
+    result := fsa backTransitions.
+        
+    self assert: result size = 1.
+    self assert: result anyOne destination = a.
+!
+
+testBackTransitions2
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: c.
+    
+    fsa addTransitionFrom: a to: a on: $a.
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: c on: $a.
+    fsa addTransitionFrom: c to: a.
+    
+    result := fsa backTransitions.
+        
+    self assert: result size = 2.
+    self assert: result allSatisfy: [:t | t destination = a ].
+!
+
+testBackTransitions3
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa startState: a.
+    fsa finalState: d.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: a to: c on: $a.
+    fsa addTransitionFrom: b to: d on: $a.
+    fsa addTransitionFrom: c to: d on: $a.
+    fsa addTransitionFrom: d to: b on: $a.
+    fsa addTransitionFrom: d to: c on: $a.
+    result := fsa backTransitions.
+        
+    self assert: result size = 2.
+
+    d transitions allSatisfy: [ :t | result includes: t ].
+!
+
+testBackTransitions4
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: c.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: c on: $a.
+    fsa addTransitionFrom: a to: c on: $a.
+    
+    result := fsa backTransitions.
+        
+    self assert: result size = 0.
+!
+
+testBackTransitions5
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: c.
+    
+    fsa addTransitionFrom: a to: c on: $a.
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: c on: $a.
+    
+    result := fsa backTransitions.
+        
+    self assert: result size = 0.
+!
+
+testDeterminize
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: c.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: a to: c on: $a.
+    
+    fsa determinize.
+        
+    self assert: fsa states size = 2.
+    self assert: a transitions size = 1.	
+    self assert: a transitions anyOne destination retval = #c.
+!
+
+testDeterminize2
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: b.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: a to: c on: $a.
+    
+    fsa determinize.
+        
+    self assert: fsa states size = 2.
+    self assert: a transitions size = 1.	
+    self assert: a transitions anyOne destination retval = #b.
+!
+
+testDeterminize3
+    | merged |
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa addState: e.
+
+    fsa startState: a.
+    fsa finalState: e.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: a to: c on: $a.
+    fsa addTransitionFrom: b to: e on: $e.
+    fsa addTransitionFrom: c to: d on: $d.
+    fsa addTransitionFrom: d to: e on: $e.
+    
+    fsa determinize.
+    merged := a transitions anyOne destination.
+        
+    self assert: fsa states size = 4.
+    self assert: a transitions size = 1.	
+    self assert: merged transitions size = 2.
+    self assert: (merged transitions anySatisfy: [ :t | (t accepts: $d) and: [ t destination = d ]]).
+    self assert: (merged transitions anySatisfy: [ :t | (t accepts: $e) and: [ t destination = e ]]).	
+!
+
+testDeterminize4
+    | merged |
+    fsa addState: a.
+    fsa addState: b.
+
+    fsa startState: a.
+    fsa finalState: b.
+    
+    fsa addTransitionFrom: a to: a on: $a.
+    fsa addTransitionFrom: a to: b on: $a.
+    
+    fsa determinize.
+    merged := a transitions anyOne destination.
+        
+    self assert: fsa states size = 2.
+    self assert: a transitions size = 1.	
+    self assert: merged transitions size = 1.
+    self assert: ((merged name = #'a-b') or: [merged name = #'b-a']).
+    self assert: (merged transitions anySatisfy: [ :t | (t accepts: $a) and: [ t destination = merged ]]).
+!
+
+testDeterminize5
+    | merged |
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa startState: a.
+    fsa finalState: d.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: a.	
+    fsa addTransitionFrom: b to: c priority: -1. 
+    fsa addTransitionFrom: c to: d on: $a.
+    b priority: 0.
+    
+    fsa determinize.
+    merged := b transitions anyOne destination.
+    
+    self assert: fsa isDeterministic.	
+    self assert: fsa states size = 3.
+    
+    
+    self assert: a transitions size = 1.	
+    self assert: b transitions size = 1.	
+    self assert: (fsa states noneSatisfy: [ :s | s isFinal ]).
+!
+
+testDeterminize6
+    |  merged |
+    fsa addState: a.
+    fsa addState: b.
+    
+    fsa startState: a.
+    fsa finalState: b.
+
+    fsa addTransitionFrom: a to: a on: $a.
+    fsa addTransitionFrom: a to: b on: $a priority: -1.	
+
+    fsa determinize.
+    self assert: fsa isDeterministic.	
+    self assert: fsa states size = 2.
+    
+    
+    self assert: a transitions size = 1.	
+    self assert: a isFinal not.
+    
+    merged := a transitions anyOne destination.
+    self assert: merged transitions size = 1.
+    self assert: merged isFinal.
+!
+
+testIsDeterministic
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: c.
+    
+    fsa addTransitionFrom: a to: b on: $b.
+    fsa addTransitionFrom: a to: c on: $c.	
+
+    self assert: fsa isDeterministic.
+!
+
+testIsDeterministic2
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: c.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: a to: c on: $a.	
+
+    self assert: fsa isDeterministic not.
+!
+
+testIsWithoutEpsilons
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: c.
+    
+    fsa addTransitionFrom: a to: b.
+    fsa addTransitionFrom: b to: c on: $c.	
+
+    self assert: fsa isWithoutEpsilons not.
+!
+
+testMergeTransitions
+    fsa addState: a.
+    fsa addState: b.
+    fsa startState: a.
+    fsa finalState: b.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: a to: b on: $b.	
+
+    fsa mergeTransitions.
+        
+    self assert: a transitions size = 1.
+    self assert: (a transitions anyOne accepts: $a).
+    self assert: (a transitions anyOne accepts: $b).
+!
+
+testMergeTransitions2
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: b.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: a to: c on: $b.	
+
+    fsa mergeTransitions.
+        
+    self assert: a transitions size = 2.
+!
+
+testMinimize
+    | merged |
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa startState: a.
+    fsa finalState: d.
+    
+    fsa addTransitionFrom: a to: b on: $b.
+    fsa addTransitionFrom: a to: c on: $c.
+
+    fsa addTransitionFrom: b to: d on: $a.
+    fsa addTransitionFrom: c to: d on: $a.
+    b retval: nil.
+    c retval: nil.
+    
+    fsa minimize.
+        
+    self assert: fsa states size = 3.
+    self assert: a transitions size = 1.	
+    
+    merged := a transitions anyOne destination.
+    self assert: merged transitions size = 1.
+    self assert: merged transitions anyOne destination = d.
+    self assert: (merged transitions anyOne accepts: $a).
+!
+
+testMinimze2
+    |  merged |
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa addState: e.
+    
+    fsa startState: a.
+    fsa finalState: e.
+
+    "states c and d are equivalent"
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: c on: $c priority: -1.	
+    fsa addTransitionFrom: b to: d on: $d priority: -2.	
+    fsa addTransitionFrom: c to: e on: $e priority: -3.	
+    fsa addTransitionFrom: d to: e on: $e priority: -4.	
+    
+    c retval: nil.
+    d retval: nil.
+    
+    fsa minimize.
+    
+    self assert: fsa isDeterministic.	
+    self assert: fsa states size = 4.
+    
+    self assert: b transitions size = 1.	
+    
+    merged := b destination.
+    self assert: merged transitions size = 1.
+    self assert: merged destination isFinal.
+!
+
+testRemoveEpsilons
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: c.
+    
+    fsa addTransitionFrom: a to: b.
+    fsa addTransitionFrom: b to: c on: $c.	
+
+    fsa removeEpsilons.
+        
+    self assert: a transitions size = 1.
+    self assert: b transitions size = 1.
+    self assert: a transitions anyOne isEpsilon not.
+    self assert: (a transitions anyOne accepts: $c).
+    self assert: (fsa isReachableState: c).
+    self assert: (fsa isReachableState: b) not.
+    self assert: fsa isWithoutEpsilons.
+!
+
+testRemoveEpsilons2
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: c.
+    
+    fsa addTransitionFrom: a to: b.
+    fsa addTransitionFrom: a to: b on: $b.
+    fsa addTransitionFrom: b to: c on: $c.	
+    
+    fsa removeEpsilons.
+        
+    self assert: a transitions size = 2.
+    self assert: b transitions size = 1.
+    self assert: (a transitions noneSatisfy: [:t | t isEpsilon ]).
+    self assert: (a transitions anySatisfy: [:t | t accepts: $c ]).
+    self assert: (a transitions anySatisfy: [:t | t accepts: $b ]).	
+!
+
+testRemoveEpsilons3
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa startState: a.
+    fsa finalState: d.
+    
+    fsa addTransitionFrom: a to: b.
+    fsa addTransitionFrom: b to: c.	
+    fsa addTransitionFrom: c to: d on: $d.	
+    
+    fsa removeEpsilons.
+        
+    self assert: a transitions size = 1.
+
+    self assert: a transitions anyOne isEpsilon not.
+    self assert: (a transitions anyOne accepts: $d).
+    self assert: (fsa isReachableState: d).	
+    self assert: (fsa isReachableState: b) not.
+    self assert: (fsa isReachableState: c) not.
+!
+
+testRemoveEpsilons4
+    fsa addState: a.
+    fsa addState: b.
+    fsa startState: a.
+    fsa finalState: b.
+    
+    fsa addTransitionFrom: a to: b.
+    
+    fsa removeEpsilons.
+        
+    self assert: a isFinal.
+!
+
+testRemoveEpsilons5
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+
+
+    fsa startState: a.
+    fsa finalState: d.
+
+    c priority: 0.
+    d priority: 0.
+    
+    fsa addTransitionFrom: a to: b priority: -1.
+    fsa addTransitionFrom: a to: c on: $c.
+    fsa addTransitionFrom: b to: d on: $d.
+    fsa addTransitionFrom: c to: d on: $d.
+    
+    fsa removeEpsilons.
+            
+    self assert: c priority = 0.
+    self assert: d priority = -1.
+    self assert: (a transitions anySatisfy: [:t | t accepts: $d ]).
+!
+
+testRemoveEpsilons6
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa startState: a.
+    fsa finalState: d.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: a.	
+    fsa addTransitionFrom: b to: c priority: -1. 
+    fsa addTransitionFrom: c to: d on: $b.
+        
+    d priority: 0.	
+        
+    fsa removeEpsilons.
+    
+    self assert: fsa isWithoutEpsilons.
+        
+    self assert: a transitions size = 1.
+    self assert: b transitions size = 2.
+    self assert: b transitions anySatisfy: [ :t | (t accepts: $a) and: [t destination = b]].
+    self assert: b transitions anySatisfy: [ :t | (t accepts: $b) and: [t destination = d]].
+
+    self assert: d priority = -1.	
+!
+
+testRemoveEpsilons7
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa addState: d.
+    fsa startState: a.
+    fsa finalState: d.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: a.	
+        
+    fsa removeEpsilons.
+    
+    self assert: fsa isWithoutEpsilons.
+        
+    self assert: a transitions size = 1.
+    self assert: b transitions size = 1.
+    self assert: (a transitions anyOne == b transitions anyOne) not.
+!
+
+testRemoveLowPriorityTransitions
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: a.
+    fsa finalState: b.
+    fsa finalState: c.
+
+    b priority: 0.	
+    fsa addTransitionFrom: a to: b on: $a priority: -1.
+    fsa addTransitionFrom: b to: c on: $b priority: -1.
+        
+    fsa removeLowPriorityTransitions.
+    
+    self assert: fsa isWithoutEpsilons.
+        
+    self assert: a transitions size = 1.
+    self assert: b transitions size = 0.
+!
+
+testRemoveUnreachableStates
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    fsa startState: a.
+    fsa finalState: c.
+    
+    fsa addTransitionFrom: a to: c.
+    fsa addTransitionFrom: b to: c.
+    
+    fsa removeUnreachableStates.
+        
+    self assert: fsa states size = 2.
+!
+
+testTopologicalOrder
+    |  |
+    fsa addState: a.
+    fsa addState: b.
+
+    fsa startState: a.
+    fsa finalState: b.
+    
+    fsa addTransitionFrom: a to: a on: $a.
+    fsa addTransitionFrom: a to: b on: $a.
+    
+    result := fsa topologicalOrder.
+            
+    self assert: result first == a.
+    self assert: result second == b.
+! !
+
+!PEGFsaTest methodsFor:'tests - copy'!
+
+testCopy
+    | newA newC |
+    fsa addState: a.
+    fsa addState: b.
+    fsa addState: c.
+    
+    fsa finalState: c.
+    fsa startState: a.
+    
+    fsa addTransitionFrom: a to: b on: $a.
+    fsa addTransitionFrom: b to: c on: $b priority: -1.
+    fsa addTransitionFrom: c to: a priority: -2.
+    
+    newFsa := fsa copy.
+    
+    self assert: (fsa isIsomorphicTo: newFsa).
+    
+    newA := newFsa states detect: [ :s | s canBeIsomorphicTo: a ].
+
+    self assert: newFsa startState = newA.
+    self assert: (a == newA) not.
+    self assert: (newA transitions anyOne canBeIsomorphicTo: a transitions anyOne).
+    self assert: (newA transitions anyOne == a transitions anyOne) not.
+    self assert: newA destination destination destination == newA.
+    
+    newC := newA destination destination.
+    self assert: (newC == c) not.
+    self assert: newC isFinal.
+    self assert: newC retval = #c.
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PEGFsaTransitionTest.st	Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,130 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PEGFsaTransitionTest
+	instanceVariableNames:'t1 t2 result'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Tests-FSA'
+!
+
+!PEGFsaTransitionTest methodsFor:'as yet unclassified'!
+
+setUp
+    t1 := PEGFsaTransition new.
+    t2 := PEGFsaTransition new.
+!
+
+testCompare
+    t1 addCharacter: $a.
+    t1 addCharacter: $b.
+    t2 addCharacter: $a.
+    t2 addCharacter: $b.
+    
+    self assert: t1 = t2.
+!
+
+testComplement
+    t1 addCharacter: $a.
+    t1 addCharacter: $b.
+    t2 addCharacter: $b.
+    t2 addCharacter: $c.
+    
+    result := t1 complement: t2.
+    
+    self assert: (result at: $a codePoint).
+    self assert: (result at: $b codePoint) not.
+    self assert: (result at: $c codePoint) not.
+!
+
+testComplement2
+    t1 addCharacter: $a.
+    t1 addCharacter: $b.
+    t2 addCharacter: $b.
+    t2 addCharacter: $c.
+    
+    result := t2 complement: t1.
+    
+    self assert: (result at: $a codePoint) not.
+    self assert: (result at: $b codePoint) not.
+    self assert: (result at: $c codePoint).
+!
+
+testCopy
+    t1 addCharacter: $a.
+    t1 addCharacter: $b.
+    
+    t2 := t1 copy.
+    
+    
+    self assert: t1 = t2.
+    self assert: (t1 == t2) not.
+    
+    t2 destination: #foo.
+    self assert: (t1 = t2) not.
+        
+    t1 destination: #foo.
+    self assert: (t1 = t2).
+
+    t1 addCharacter: $c.
+    self assert: (t1 = t2) not.
+    
+    t2 addCharacter: $c.
+    t1 priority: -1.
+    self assert: (t1 = t2) not.	
+    
+    t2 priority: -1.
+    self assert: (t1 = t2).
+!
+
+testDisjunction
+    t1 addCharacter: $a.
+    t1 addCharacter: $c.
+    t2 addCharacter: $b.
+    t2 addCharacter: $c.
+    
+    result := t1 disjunction: t2.
+    
+    self assert: (result at: $a codePoint).
+    self assert: (result at: $b codePoint).
+    self assert: (result at: $c codePoint) not.
+!
+
+testIntersection
+    t1 addCharacter: $a.
+    t1 addCharacter: $b.
+    t2 addCharacter: $b.
+    t2 addCharacter: $c.
+    
+    result := t1 intersection: t2.
+    
+    self assert: (result at: $b codePoint).
+    self assert: (result at: $a codePoint) not.
+    self assert: (result at: $c codePoint) not.
+!
+
+testIntersection2
+    t1 addCharacter: $a.
+    t2 addCharacter: $b.
+    
+    result := t1 intersection: t2.
+    
+    self assert: (result allSatisfy: [:e | e not ]).
+    
+!