# HG changeset patch # User Jan Vrany # Date 1437746814 -3600 # Node ID 1e45d3c96ec58e53caf50ec3c59a65e22ea38639 # Parent f6d77fee98112f0691eb222ec15e7f3291904e1c 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 diff -r f6d77fee9811 -r 1e45d3c96ec5 PPCompositeParser.st --- 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 diff -r f6d77fee9811 -r 1e45d3c96ec5 PPDelegateParser.st --- 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 diff -r f6d77fee9811 -r 1e45d3c96ec5 PPFlattenParser.st --- 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: $' +! + version_SVN ^ '$Id: PPFlattenParser.st,v 1.4 2014-03-04 14:32:30 cg Exp $' ! ! diff -r f6d77fee9811 -r 1e45d3c96ec5 PPSequenceParser.st --- 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 diff -r f6d77fee9811 -r 1e45d3c96ec5 analyzer/bmake.bat --- 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% %* diff -r f6d77fee9811 -r 1e45d3c96ec5 analyzer/mingwmake.bat --- 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 diff -r f6d77fee9811 -r 1e45d3c96ec5 analyzer/tests/Make.proto --- 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)" diff -r f6d77fee9811 -r 1e45d3c96ec5 analyzer/tests/bc.mak --- 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) " diff -r f6d77fee9811 -r 1e45d3c96ec5 analyzer/tests/bmake.bat --- 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% %* diff -r f6d77fee9811 -r 1e45d3c96ec5 analyzer/tests/mingwmake.bat --- 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 diff -r f6d77fee9811 -r 1e45d3c96ec5 analyzer/tests/vcmake.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% %* - diff -r f6d77fee9811 -r 1e45d3c96ec5 analyzer/vcmake.bat --- 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% %* - diff -r f6d77fee9811 -r 1e45d3c96ec5 bmake.bat --- 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 "***********************************" diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/FooScanner.st --- /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 +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/Make.proto --- 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) diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/Make.spec --- 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) \ diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PEGFsa.st --- /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 + + composite roassal2 + title: 'Graph'; + initializeView: [ RTMondrian new ]; + painting: [ :view | + self viewGraphOn: view. + ]. +! + +gtStringViewIn: composite + + + 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 ] +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PEGFsaFailure.st --- /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' +! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PEGFsaGenerator.st --- /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 +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PEGFsaInterpret.st --- /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 ] + +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PEGFsaPair.st --- /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 +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PEGFsaState.st --- /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. +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PEGFsaTransition.st --- /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: ''. + ^ 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 +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCArguments.st --- 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 ! diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCClassBuilder.st --- /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. +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCCodeBlock.st --- /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 " +! + +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 " + "Modified: / 03-06-2015 / 05:52:39 / Jan Vrany " +! + +codeIndent + self codeIndent:indentation + + "Created: / 01-06-2015 / 22:58:00 / Jan Vrany " +! + +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 " +! ! + +!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 " + "Modified: / 01-06-2015 / 21:03:39 / Jan Vrany " +! ! + +!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 " + "Modified (comment): / 18-06-2015 / 06:04:21 / Jan Vrany " +! ! + +!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 " +! ! + +!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 +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCCodeGen.st --- /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 " +! + +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 " +! + +addOnLine: string + currentMethod addOnLine: string. +! + +addVariable: name + ^ self currentNonInlineMethod addVariable: name + + "Modified: / 23-04-2015 / 17:34:02 / Jan Vrany " +! + +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 " +! + +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 " +! + +codeBlock: contents + currentMethod codeBlock: contents + + "Created: / 01-06-2015 / 22:35:32 / Jan Vrany " +! + +codeClearError + self add: 'self clearError.'. +! + +codeComment: string + currentMethod add: '"', string, '"'. +! + +codeDot + self addOnLine:'.'. + + "Created: / 16-06-2015 / 06:09:07 / Jan Vrany " +! + +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 " +! + +codeIf: condition then: then + self codeIf: condition then: then else: nil + + "Created: / 16-06-2015 / 06:07:06 / Jan Vrany " +! + +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 " + "Modified: / 16-06-2015 / 06:09:33 / Jan Vrany " +! + +codeIfErrorThen: then + ^ self codeIf: 'error' then: then else: nil + + "Created: / 16-06-2015 / 06:06:44 / Jan Vrany " +! + +codeIfErrorThen: then else: else + ^ self codeIf: 'error' then: then else: else + + "Created: / 16-06-2015 / 06:05:56 / Jan Vrany " +! + +codeNextToken + self add: 'self nextToken.' + + "Created: / 23-04-2015 / 18:01:05 / Jan Vrany " + "Modified: / 23-04-2015 / 20:51:41 / Jan Vrany " +! + +codeProfileStart + self add: 'context methodInvoked: #', currentMethod methodName, '.' + + "Created: / 01-06-2015 / 21:17:19 / Jan Vrany " +! + +codeProfileStop + self add: 'context methodFinished: #', currentMethod methodName, '.' + + "Created: / 01-06-2015 / 21:19:11 / Jan Vrany " +! + +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 " + "Modified: / 01-06-2015 / 21:49:04 / Jan Vrany " +! + +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 " + "Modified: / 01-06-2015 / 21:48:51 / Jan Vrany " +! + +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 " +! + +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 " +! + +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 " +! + +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 " +! + +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 " +! + +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 " +! + +stopInline + ^ self pop. + + "Modified: / 01-06-2015 / 21:37:59 / Jan Vrany " +! + +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 " +! + +top + ^ compilerStack top +! ! + +!PPCCodeGen methodsFor:'variables'! + +allocateReturnVariable + ^ self allocateReturnVariableNamed: 'retval' + + "Created: / 23-04-2015 / 18:03:40 / Jan Vrany " + "Modified: / 15-06-2015 / 17:52:56 / Jan Vrany " +! + +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 " +! + +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 " +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCCodeGenerator.st --- 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 " +! ! + !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 " ! 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 " "Modified: / 23-04-2015 / 19:13:25 / Jan Vrany " - "Modified (comment): / 23-04-2015 / 21:31:24 / Jan Vrany " + "Modified (format): / 15-06-2015 / 18:03:07 / Jan Vrany " ! 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 and check if in all cases it's used + in one of the following patterns: + + * first , second, ... , sixth + * at: + + 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 at: " + ((parent selector == #at:) and:[ parent arguments first isLiteralNumber ]) ifTrue:[ + blockMatches at: parent put: (childValueVars at: parent arguments first value). + ] ifFalse:[ + "Check for 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 " + 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 " ! 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 " + "Modified: / 29-05-2015 / 07:17:36 / Jan Vrany " ! 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 " ! 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 " + "Modified: / 19-06-2015 / 07:06:19 / Jan Vrany " +! + 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 " + "Modified: / 26-05-2015 / 19:04:27 / Jan Vrany " ! 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 " + "Modified (comment): / 16-06-2015 / 06:38:02 / Jan Vrany " ! 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 " + + "Modified: / 15-06-2015 / 18:53:58 / Jan Vrany " ! 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 " ! ! diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCCompiler.st --- 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 " ! 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 " +! + 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 " +! + +codeBlock: contents + currentMethod codeBlock: contents + + "Created: / 01-06-2015 / 22:35:32 / Jan Vrany " +! + codeClearError self add: 'self clearError.'. ! +codeDot + self addOnLine:'.'. + + "Created: / 16-06-2015 / 06:09:07 / Jan Vrany " +! + 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 " ! +codeIf: condition then: then + self codeIf: condition then: then else: nil + + "Created: / 16-06-2015 / 06:07:06 / Jan Vrany " +! + +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 " + "Modified: / 16-06-2015 / 06:09:33 / Jan Vrany " +! + +codeIfErrorThen: then + ^ self codeIf: 'error' then: then else: nil + + "Created: / 16-06-2015 / 06:06:44 / Jan Vrany " +! + +codeIfErrorThen: then else: else + ^ self codeIf: 'error' then: then else: else + + "Created: / 16-06-2015 / 06:05:56 / Jan Vrany " +! + codeNextToken self add: 'self nextToken.' @@ -244,28 +323,65 @@ "Modified: / 23-04-2015 / 20:51:41 / Jan Vrany " ! +codeProfileStart + self add: 'context methodInvoked: #', currentMethod methodName, '.' + + "Created: / 01-06-2015 / 21:17:19 / Jan Vrany " +! + +codeProfileStop + self add: 'context methodFinished: #', currentMethod methodName, '.' + + "Created: / 01-06-2015 / 21:19:11 / Jan Vrany " +! + 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 " - "Modified: / 23-04-2015 / 20:51:41 / Jan Vrany " + "Modified: / 01-06-2015 / 21:49:04 / Jan Vrany " ! 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 " - "Modified: / 23-04-2015 / 20:51:41 / Jan Vrany " + "Modified: / 01-06-2015 / 21:48:51 / Jan Vrany " +! + +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 " ! 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 " + "Modified: / 01-06-2015 / 21:48:35 / Jan Vrany " ! 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 " + "Modified: / 01-06-2015 / 21:19:41 / Jan Vrany " ! stopInline - ^ self pop. - "Modified: / 23-04-2015 / 18:28:33 / Jan Vrany " + "Modified: / 01-06-2015 / 21:37:59 / Jan Vrany " ! 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 " + "Modified: / 01-06-2015 / 21:38:05 / Jan Vrany " ! 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 " + "Modified: / 15-06-2015 / 17:52:56 / Jan Vrany " +! - ^ 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 " - "Modified (comment): / 23-04-2015 / 21:12:57 / Jan Vrany " + "Created: / 15-06-2015 / 18:04:48 / Jan Vrany " ! 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 " ! ! !PPCCompiler class methodsFor:'documentation'! diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCConfiguration.st --- 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 diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCContextMemento.st --- 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. ! diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCFSACodeGen.st --- /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 " +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCInlinedMethod.st --- 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 " ! isInline @@ -31,6 +33,12 @@ "Created: / 23-04-2015 / 21:06:12 / Jan Vrany " ! +allocateReturnVariableNamed: name + self error: 'return variable must be assigned by the non-inlined method....' + + "Created: / 15-06-2015 / 17:52:35 / Jan Vrany " +! + allocateTemporaryVariableNamed:aString self error: 'sorry, I can''t allocate variables....' diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCInliningVisitor.st --- 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 " +! + visitCharSetPredicateNode: node ^ self markForInline: node ! diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCMappedActionNode.st --- /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 " +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCMethod.st --- 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 " + "Modified: / 01-06-2015 / 21:24:47 / Jan Vrany " ! id: value id := value ! +indentationLevel + ^ buffer indentationLevel + + "Created: / 01-06-2015 / 21:38:31 / Jan Vrany " +! + +indentationLevel: anInteger + buffer indentationLevel: anInteger + + "Created: / 01-06-2015 / 21:38:58 / Jan Vrany " +! + 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 " ! addOnLine: string - buffer nextPutAll: string. + buffer addOnLine: string + + "Modified: / 01-06-2015 / 21:09:20 / Jan Vrany " ! 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 " + "Modified (format): / 01-06-2015 / 23:50:26 / Jan Vrany " +! + +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 " + "Modified: / 03-06-2015 / 06:11:32 / Jan Vrany " +! ! + +!PPCMethod methodsFor:'code generation - indenting'! + +dedent + buffer dedent + + "Created: / 01-06-2015 / 21:32:28 / Jan Vrany " +! - "Modified: / 23-04-2015 / 12:29:58 / Jan Vrany " +indent + buffer indent + + "Created: / 01-06-2015 / 21:32:22 / Jan Vrany " ! +nl + + buffer nl + + "Created: / 01-06-2015 / 21:52:31 / Jan Vrany " +! ! + +!PPCMethod methodsFor:'code generation - variables'! + allocateReturnVariable ^ variableForReturn isNil ifTrue:[ @@ -122,65 +172,52 @@ "Created: / 23-04-2015 / 18:03:40 / Jan Vrany " ! +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 " +! + 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 " + "Modified: / 01-06-2015 / 21:04:02 / Jan Vrany " ! -returnVariable - ^ variableForReturn +returnVariable + ^ variableForReturn "Created: / 23-04-2015 / 20:50:50 / Jan Vrany " + "Modified (format): / 15-06-2015 / 18:12:28 / Jan Vrany " ! 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 " - "Modified: / 23-04-2015 / 21:08:54 / Jan Vrany " -! - -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 " ! ! !PPCMethod methodsFor:'initialization'! initialize - buffer := WriteStream on: ''. - indentation := 1. - variables := OrderedCollection new. + buffer := PPCCodeBlock new. + + "Modified: / 01-06-2015 / 21:33:36 / Jan Vrany " ! ! !PPCMethod methodsFor:'printing'! diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCNilNode.st --- 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: $' +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCNode.st --- 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 " ! ! !PPCNode methodsFor:'testing'! +canHavePPCId + ^ true +! + isMarkedForInline ^ self propertyAt: #inlined ifAbsent: [ false ]. "Created: / 23-04-2015 / 15:40:10 / Jan Vrany " ! +isSequenceNode + ^ false + + "Created: / 15-06-2015 / 18:29:32 / Jan Vrany " +! + isTokenNode ^ false ! @@ -513,6 +528,12 @@ ^ self ! +asFsa + | visitor | + visitor := PEGFsaGenerator new. + ^ visitor visit: self +! + replace: node with: anotherNode ! diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCNodeVisitor.st --- 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 " +! + visitMessagePredicateNode: node ^ self visitNode: node ! diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCProfilingContext.st --- 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. ]. diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCScanner.st --- /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 +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCScannerCodeGenerator.st --- /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' ]. +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCSequenceNode.st --- 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 " +! + +preferredChildrenVariableNames: aSequenceableCollection + "Sets an array of preferred variable names" + + self propertyAt: #preferredChildrenVariableNames put: aSequenceableCollection + + "Created: / 04-06-2015 / 23:09:12 / Jan Vrany " +! + prefix ^ #seq +! + +returnParsedObjectsAsCollection + ^ self propertyAt: #returnParsedObjectsAsCollection ifAbsent:[ true ] + + "Created: / 04-06-2015 / 23:43:18 / Jan Vrany " +! + +returnParsedObjectsAsCollection: aBoolean + self propertyAt: #returnParsedObjectsAsCollection put: aBoolean + + "Created: / 04-06-2015 / 23:43:28 / Jan Vrany " ! ! !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 " +! ! + !PPCSequenceNode methodsFor:'visiting'! accept: visitor diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCSpecializingVisitor.st --- 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 " ! ! diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCTokenCodeGenerator.st --- 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. diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCTokenizingCodeGenerator.st --- 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 " ! 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. ! diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPCTokenizingVisitor.st --- 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 " ! eofToken diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPMappedActionParser.st --- /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 " +! ! + +!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 " +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PPTokenizingCompiledParser.st --- 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. diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/abbrev.stc --- 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 diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/bc.mak --- 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) diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/benchmarks/Make.proto --- 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 diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/benchmarks/Make.spec --- 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) \ diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/benchmarks/PPCBenchmark.st --- 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 " + "Modified: / 16-05-2015 / 19:19:00 / Jan Vrany " ! ! !PPCBenchmark methodsFor:'benchmark support'! @@ -370,6 +384,26 @@ input do: [ :source | parser parse: source withContext: context ] ! +benchmarkSmalltalkNoopParserCompiledC + + + + + input do: [ :source | parser parse: source withContext: context ] + + "Created: / 16-05-2015 / 09:45:55 / Jan Vrany " +! + +benchmarkSmalltalkNoopParserTokenizedC + + + + + input do: [ :source | parser parse: source withContext: context ] + + "Created: / 16-05-2015 / 09:46:15 / Jan Vrany " +! + benchmarkSmalltalkParserC @@ -384,6 +418,16 @@ input do: [ :source | parser parse: source withContext: context ] +! + +benchmarkSmalltalkParserTokenizedC + + + + + input do: [ :source | parser parse: source withContext: context ] + + "Created: / 16-05-2015 / 09:45:16 / Jan Vrany " ! ! !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 " +! + +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 " +! + 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 " +! + +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 " +! + 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 " ! ! !PPCBenchmark class methodsFor:'documentation'! diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/benchmarks/PPCSmalltalkNoopParser.st --- /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 " +! + +expression + ^ super expression map: [ :variableNodes :expressionNodes | ] + + "Modified: / 15-05-2015 / 08:55:05 / Jan Vrany " +! + +method + ^ super method map: [ :methodNode :bodyNode | ] + + "Modified (format): / 15-05-2015 / 08:55:17 / Jan Vrany " +! + +methodDeclaration + ^ super methodDeclaration ==> [ :nodes | nodes ] + + "Modified: / 15-05-2015 / 08:55:27 / Jan Vrany " +! + +methodSequence + ^ super methodSequence map: [ :periodNodes1 :pragmaNodes1 :periodNodes2 :tempNodes :periodNodes3 :pragmaNodes2 :periodNodes4 :statementNodes | ] + + "Modified: / 15-05-2015 / 08:55:38 / Jan Vrany " +! + +parens + ^ super parens map: [ :openToken :expressionNode :closeToken | ] + + "Modified: / 15-05-2015 / 08:55:44 / Jan Vrany " +! + +pragma + ^ super pragma ==> [ :nodes | nodes ] + + "Modified: / 15-05-2015 / 08:55:51 / Jan Vrany " +! + +return + ^ super return map: [ :token :expressionNode | ] + + "Modified: / 15-05-2015 / 08:55:57 / Jan Vrany " +! + +sequence + ^ super sequence map: [ :tempNodes :periodNodes :statementNodes | ] + + "Modified: / 15-05-2015 / 08:56:04 / Jan Vrany " +! + +variable + ^ super variable ==> [ :token | ] + + "Modified: / 15-05-2015 / 08:56:09 / Jan Vrany " +! ! + +!PPCSmalltalkNoopParser methodsFor:'grammar-blocks'! + +block + ^ super block map: [ :leftToken :blockNode :rightToken | ] + + "Modified: / 15-05-2015 / 08:56:16 / Jan Vrany " +! + +blockArgument + ^ super blockArgument ==> #second +! + +blockBody + ^ super blockBody + ==> [ :nodes | ] + + "Modified: / 15-05-2015 / 08:56:29 / Jan Vrany " +! ! + +!PPCSmalltalkNoopParser methodsFor:'grammar-literals'! + +arrayLiteral + ^ super arrayLiteral ==> [ :nodes | nodes ] + + "Modified (format): / 15-05-2015 / 08:56:45 / Jan Vrany " +! + +arrayLiteralArray + ^ super arrayLiteralArray ==> [ :nodes | nodes ] + + "Modified: / 15-05-2015 / 08:56:50 / Jan Vrany " +! + +byteLiteral + ^ super byteLiteral ==> [ :nodes | nodes ] + + "Modified: / 15-05-2015 / 08:56:55 / Jan Vrany " +! + +byteLiteralArray + ^ super byteLiteralArray ==> [ :nodes | nodes ] + + "Modified: / 15-05-2015 / 08:56:58 / Jan Vrany " +! + +charLiteral + ^ super charLiteral ==> [ :nodes | nodes ] + + "Modified: / 15-05-2015 / 08:57:01 / Jan Vrany " +! + +falseLiteral + ^ super falseLiteral ==> [ :nodes | nodes ] + + "Modified: / 15-05-2015 / 08:57:04 / Jan Vrany " +! + +nilLiteral + ^ super nilLiteral ==> [ :nodes | nodes ] + + "Modified: / 15-05-2015 / 08:57:08 / Jan Vrany " +! + +numberLiteral + ^ super numberLiteral ==> [ :nodes | nodes ] + + "Modified: / 15-05-2015 / 08:57:31 / Jan Vrany " +! + +stringLiteral + ^ super stringLiteral ==> [ :nodes | nodes ] + + "Modified: / 15-05-2015 / 08:57:17 / Jan Vrany " +! + +symbolLiteral + ^ super symbolLiteral ==> [ :nodes | nodes ] + + "Modified: / 15-05-2015 / 08:57:36 / Jan Vrany " +! + +symbolLiteralArray + ^ super symbolLiteralArray ==> [ :nodes | nodes ] + + "Modified: / 15-05-2015 / 08:57:38 / Jan Vrany " +! + +trueLiteral + ^ super trueLiteral ==> [ :nodes | nodes ] + + "Modified: / 15-05-2015 / 08:57:41 / Jan Vrany " +! ! + +!PPCSmalltalkNoopParser methodsFor:'grammar-messages'! + +binaryExpression + ^ super binaryExpression map: [ :receiverNode :messageNodes | ] + + "Modified: / 15-05-2015 / 08:57:48 / Jan Vrany " +! + +cascadeExpression + ^ super cascadeExpression map: [ :receiverNode :messageNodes | ] + + "Modified: / 15-05-2015 / 08:57:56 / Jan Vrany " +! + +keywordExpression + ^ super keywordExpression map: [ :receiveNode :messageNode | ] + + "Modified: / 15-05-2015 / 08:58:01 / Jan Vrany " +! + +unaryExpression + ^ super unaryExpression map: [ :receiverNode :messageNodes | ] + + "Modified: / 15-05-2015 / 08:58:07 / Jan Vrany " +! ! + +!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 " +! + +identifierToken + ^ super identifierToken ==> [ :token | token ] + + "Modified: / 15-05-2015 / 08:54:10 / Jan Vrany " +! + +keywordToken + ^ super keywordToken ==> [ :token | token ] + + "Modified: / 15-05-2015 / 08:54:13 / Jan Vrany " +! + +unaryToken + ^ super unaryToken ==> [ :token | token ] + + "Modified: / 15-05-2015 / 08:54:17 / Jan Vrany " +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/benchmarks/PPCSmalltalkNoopParserTests.st --- /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 " +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/benchmarks/abbrev.stc --- 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 diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/benchmarks/bc.mak --- 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 diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/benchmarks/bmake.bat --- 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% %* diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/benchmarks/libInit.cc --- 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); diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/benchmarks/mingwmake.bat --- 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 diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/benchmarks/stx_goodies_petitparser_compiler_benchmarks.st --- 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 @@ ^ #( " or ( attributes...) in load order" PPCBenchmark + PPCSmalltalkNoopParser + (PPCSmalltalkNoopParserTests autoload) #'stx_goodies_petitparser_compiler_benchmarks' ) ! diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/benchmarks/vcmake.bat --- 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% %* - diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/bmake.bat --- 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% %* diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/extensions.st --- 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 " +! ! + !PPContext methodsFor:'*petitcompiler'! asCompiledParserContext @@ -189,7 +206,9 @@ child: parser; yourself ]. - ^ super asCompilerNode + ^ super asCompilerNode + + "Modified: / 22-05-2015 / 21:53:28 / Jan Vrany " ! ! !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 " +! ! + !PPSmalltalkGrammar methodsFor:'*petitcompiler'! comment - ^ $" asParser, $" asParser negate star, $" asParser. + ^ $" asParser, $" asParser negate star, $" asParser. ! ! !PPSmalltalkGrammar methodsFor:'*petitcompiler'! diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/libInit.cc --- 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); diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/mingwmake.bat --- 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 diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/stx_goodies_petitparser_compiler.st --- 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 @@ ^ #( " or ( 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: ) ! ! diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/FooScannerTest.st --- /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. +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/Make.proto --- 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) diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/Make.spec --- 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) \ diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/PEGFsaDeterminizationTest.st --- /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'. +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/PEGFsaGeneratorTest.st --- /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: $' +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/PEGFsaInterpretTest.st --- /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' +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/PEGFsaScannerIntegrationTest.st --- /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'. +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/PEGFsaStateTest.st --- /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)). +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/PEGFsaTest.st --- /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. +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/PEGFsaTransitionTest.st --- /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 ]). + +! + +testUnion + t1 addCharacter: $a. + t1 addCharacter: $b. + t2 addCharacter: $b. + t2 addCharacter: $c. + + result := t1 union: t2. + + self assert: (result at: $b codePoint). + self assert: (result at: $a codePoint). + self assert: (result at: $c codePoint). + self assert: (result at: $d codePoint) not. +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/PPCClassBuilderTest.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/PPCClassBuilderTest.st Fri Jul 24 15:06:54 2015 +0100 @@ -0,0 +1,110 @@ +"{ Package: 'stx:goodies/petitparser/compiler/tests' }" + +"{ NameSpace: Smalltalk }" + +TestCase subclass:#PPCClassBuilderTest + instanceVariableNames:'builder method1 result' + classVariableNames:'' + poolDictionaries:'' + category:'PetitCompiler-Tests-Core' +! + +!PPCClassBuilderTest methodsFor:'as yet unclassified'! + +foo + ^ PPCMethod new + id: #foo; + code: '^ 1'; + yourself +! + +setUp + super setUp. + builder := PPCClassBuilder new. +! + +tearDown + super tearDown. + result removeFromSystem. +! + +testCompileClass + builder compiledClassName: #PPCGenerated. + builder compiledSuperclass: Object. + + method1 := self foo. + builder methodDictionary at: #foo put: method1. + + builder instvars add: #foo. + + builder constants at: #foobar put: #foobar. + builder constants at: #barbar put: #barbar. + + result := builder compileClass. + + self assert: result isNil not. + self assert: result name = #PPCGenerated. + self assert: result superclass = Object. + + self assert: result methodDictionary size =1. + self assert: result instanceVariables size = 1. + self assert: result classVariables size = 2. + self assert: (result classVariableNamed: #foobar) value = #foobar. + self assert: (result classVariableNamed: #barbar) value = #barbar. + + self assert: result new foo = 1. +! + +testCompileClass2 + Object subclass: #PPCGenerated + instanceVariableNames: '' + classVariableNames: 'foobar' + category: 'PetitCompiler-generated'. + + (Smalltalk at: #PPCGenerated) compileSilently: 'bar ^ 12' classified: 'test'. + (Smalltalk at: #PPCGenerated) compileSilently: 'foo ^ 123' classified: 'generated'. + (Smalltalk at: #PPCGenerated) compileSilently: 'foo2 ^ 1234' classified: 'generated'. + + builder compiledClassName: #PPCGenerated. + builder compiledSuperclass: Object. + + method1 := self foo. + builder methodDictionary at: #foo put: method1. + + result := builder compileClass. + + self assert: result isNil not. + self assert: result name = #PPCGenerated. + self assert: result superclass = Object. + self assert: result methodDictionary size = 2. + + self assert: result classVariables size = 0. + + self assert: result new foo = 1. + self assert: result new bar = 12. +! + +testCompileClass3 + Object subclass: #PPCGenerated + instanceVariableNames: '' + classVariableNames: 'foobar' + category: 'PetitCompiler-generated'. + + (Smalltalk at: #PPCGenerated) compileSilently: 'foo ^ 123' classified: 'testing'. + + builder compiledClassName: #PPCGenerated. + builder compiledSuperclass: Object. + + method1 := self foo. + builder methodDictionary at: #foo put: method1. + + result := builder compileClass. + + self assert: result isNil not. + self assert: result name = #PPCGenerated. + self assert: result superclass = Object. + self assert: result methodDictionary size = 1. + + self assert: result new foo = 123. +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/PPCCodeGeneratorTest.st --- a/compiler/tests/PPCCodeGeneratorTest.st Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/PPCCodeGeneratorTest.st Fri Jul 24 15:06:54 2015 +0100 @@ -71,6 +71,77 @@ self assert: parser fail: ''. ! +testActionNode2 + node := PPCPlusNode new + child: + (PPCActionNode new + block: [ :res | res asUppercase ]; + child: #letter asParser asCompilerTree; + yourself); + yourself. + + self compileTree: node. + + self assert: parser parse: 'foo' to: { $F . $O . $O}. + self assert: parser parse: 'bar' to: { $B . $A . $R}. + self assert: parser fail: ''. + + "Created: / 15-06-2015 / 13:57:36 / Jan Vrany " +! + +testActionNode3 + node := ((#letter asParser , #letter asParser) + ==> [:nodes | String with:(nodes first) with:(nodes second) ]) asCompilerTree. + node child markForInline. + + self compileTree:node. + + self assert:parser parse:'ab' to:'ab'. + self assert:parser parse:'cz' to:'cz'. + self assert:parser fail:''. + + "Created: / 16-06-2015 / 06:53:17 / Jan Vrany " +! + +testActionNode4 + node := ((#letter asParser , #letter asParser) + ==> [:nodes | String with:(nodes first) with:(nodes second) ]) asCompilerTree. + node child markForInline. + + self compileTree:node. + + self assert:parser fail:'a'. + + "Created: / 16-06-2015 / 06:53:09 / Jan Vrany " +! + +testActionNode5 + node := ((#letter asParser , #letter asParser optional) + ==> [:nodes | String with:(nodes first) with:((nodes second) isNil ifTrue:[$?] ifFalse:[nodes second]) ]) asCompilerTree. + node child markForInline. + + self compileTree:node. + + self assert:parser parse:'cz' to:'cz'. + self assert:parser parse:'c' to:'c?'. + + "Created: / 16-06-2015 / 06:53:03 / Jan Vrany " +! + +testActionNode6 + node := ((#letter asParser , #letter asParser) + ==> [:nodes | String withAll:nodes ]) asCompilerTree. + node child markForInline. + + self compileTree:node. + + self assert:parser parse:'ab' to:'ab'. + self assert:parser parse:'cz' to:'cz'. + self assert:parser fail:''. + + "Created: / 16-06-2015 / 07:22:19 / Jan Vrany " +! + testAnyNode node := PPCForwardNode new child: PPCAnyNode new; @@ -365,21 +436,21 @@ testInlinePluggableNode "Sadly, on Smalltalk/X blocks cannot be inlined because - the VM does not provide enough information to map - it back to source code. Very bad indeed!!" - ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ - self skipIf: true description: 'Blocks cannot be inlined due to a lack of proper VM support'. - ]. + the VM does not provide enough information to map + it back to source code. Very bad indeed!!" + ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ + self skipIf: true description: 'Blocks cannot be inlined due to a lack of proper VM support'. + ]. - node := PPCSequenceNode new - children: { - PPCPluggableNode new block: [ :ctx | ctx next ]; markForInline; yourself. - $a asParser asCompilerNode }. - - self compileTree: node. - - self assert: parser class methodDictionary size = 2. - self assert: parser parse: 'ba' to: #($b $a). + node := PPCSequenceNode new + children: { + PPCPluggableNode new block: [ :ctx | ctx next ]; markForInline; yourself. + $a asParser asCompilerNode }. + + self compileTree: node. + + self assert: parser class methodDictionary size = 2. + self assert: parser parse: 'ba' to: #($b $a). ! testLiteralNode @@ -421,6 +492,54 @@ self assert: parser fail: 'boo'. ! +testMappedActionNode1 + node := ((#letter asParser , #letter asParser) + map:[:a :b | String with:a with:b ]) asCompilerTree. + + self compileTree:node. + + self assert:parser parse:'ab' to:'ab'. + self assert:parser parse:'cz' to:'cz'. + self assert:parser fail:''. + self assert:parser fail:'a'. + + "Created: / 02-06-2015 / 17:04:35 / Jan Vrany " + "Modified: / 04-06-2015 / 22:44:04 / Jan Vrany " + "Modified (format): / 15-06-2015 / 14:08:11 / Jan Vrany " +! + +testMappedActionNode2 + node := ((#letter asParser , #letter asParser) + map:[:a :b | String with:a with:b ]) asCompilerTree. + node child markForInline. + + self compileTree:node. + + self assert:parser parse:'ab' to:'ab'. + self assert:parser parse:'cz' to:'cz'. + self assert:parser fail:''. + self assert:parser fail:'a'. + + "Created: / 04-06-2015 / 23:13:37 / Jan Vrany " + "Modified (format): / 15-06-2015 / 14:08:36 / Jan Vrany " +! + +testMappedActionNode3 + node := PPCPlusNode new + child: + (PPCMappedActionNode new + block: [ :l | l asUppercase ]; + child: #letter asParser asCompilerTree; + yourself); + yourself. + + self compileTree:node. + + self assert:parser parse:'abc' to:#($A $B $C). + + "Created: / 15-06-2015 / 18:27:18 / Jan Vrany " +! + testMessagePredicate | messageNode | messageNode := PPCMessagePredicateNode new @@ -755,6 +874,48 @@ self assert: parser fail: 'ab'. ! +testSequenceOptInlined1 + | a b bOpt | + + a := $a asParser asCompilerNode. + b := $b asParser asCompilerNode. + bOpt := PPCOptionalNode new + child: b ; + markForInline; + yourself. + node := PPCSequenceNode new + children: { a . bOpt }; + yourself. + self compileTree: node. + + self assert: parser parse: 'ab' to: #($a $b ) end: 2. + self assert: parser parse: 'a' to: #( $a nil ) end: 1. + + "Created: / 22-05-2015 / 11:47:11 / Jan Vrany " +! + +testSequenceOptInlined2 + | a b bOpt | + + a := $a asParser asCompilerNode. + a markForInline. + b := $b asParser asCompilerNode. + b markForInline. + bOpt := PPCOptionalNode new + child: b ; + markForInline; + yourself. + node := PPCSequenceNode new + children: { a . bOpt }; + yourself. + self compileTree: node. + + self assert: parser parse: 'ab' to: #($a $b ) end: 2. + self assert: parser parse: 'a' to: #( $a nil ) end: 1. + + "Created: / 22-05-2015 / 11:47:09 / Jan Vrany " +! + testStarAnyNode arguments cacheFirstFollow: false. node := PPCStarAnyNode new diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/PPCScannerCodeGeneratorTest.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/PPCScannerCodeGeneratorTest.st Fri Jul 24 15:06:54 2015 +0100 @@ -0,0 +1,247 @@ +"{ Package: 'stx:goodies/petitparser/compiler/tests' }" + +"{ NameSpace: Smalltalk }" + +TestCase subclass:#PPCScannerCodeGeneratorTest + instanceVariableNames:'fsa a b c d e codeGenerator scanner result' + classVariableNames:'' + poolDictionaries:'' + category:'PetitCompiler-Tests-Scanner' +! + +!PPCScannerCodeGeneratorTest methodsFor:'as yet unclassified'! + +fail: stream rule: rule + scanner initialize. + scanner stream: stream asPetitStream. + result := scanner perform: rule. + + self assert: result isEmpty +! + +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 at: token) = position. +! + +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. + + codeGenerator := PPCScannerCodeGenerator new. +! + +testA + fsa addState: a. + fsa addState: b. + + fsa startState: a. + fsa finalState: b. + + fsa addTransitionFrom: a to: b on: $a. + fsa name: #nextTokenA. + b retval: #a. + + scanner := (codeGenerator generate: fsa). + + self parse: 'aaa' token: #a rule: #nextTokenA position: 1. + self fail: 'b' rule: #nextTokenA. +! + +testAAstarA + 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. + fsa addTransitionFrom: c to: b on: $a. + + fsa name: #nextTokenAAstarA. + b priority: -1. + c priority: 0. + b retval: #AAstarA. + + scanner := (codeGenerator generate: fsa). + + 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 + 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. + + fsa name: #nextTokenAB. + c retval: #ab. + + scanner := (codeGenerator generate: fsa). + + self parse: 'ab' token: #ab rule: #nextTokenAB position: 2. +! + +testABorBC + 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 on: $a. + fsa addTransitionFrom: b to: c on: $b. + + fsa addTransitionFrom: a to: d on: $b. + fsa addTransitionFrom: d to: e on: $c. + + fsa name: #nextTokenABorBC. + c retval: #ab. + e retval: #bc. + + scanner := (codeGenerator generate: fsa). + + self parse: 'ab' token: #ab rule: #nextTokenABorBC position: 2. + self parse: 'abbc' token: #ab rule: #nextTokenABorBC position: 2. + self parse: 'bc' token: #bc rule: #nextTokenABorBC position: 2. + + self fail: 'ac' rule: #nextTokenABorBC. +! + +testABstarA + 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: $b. + fsa addTransitionFrom: c to: b on: $a. + + fsa name: #nextTokenABstarA. + b retval: #ABstarA. + + scanner := (codeGenerator generate: fsa). + + 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: '' rule: #nextTokenABstarA. +! + +testA_Bstar_A + 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: b on: $b. + fsa addTransitionFrom: b to: c on: $a. + + fsa name: #nextTokenA_Bstar_A. + c retval: #A_Bstar_A. + + scanner := (codeGenerator generate: fsa). + + 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: #nextTokenA_Bstar_A. +! + +testAorB + 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: $b. + + fsa name: #nextTokenAorB. + b retval: #a. + c retval: #b. + + scanner := (codeGenerator generate: fsa). + + self parse: 'a' token: #a rule: #nextTokenAorB. + self parse: 'b' token: #b rule: #nextTokenAorB. + + self fail: 'c' rule: #nextTokenAorB. + self fail: 'c' rule: #nextTokenAorB. +! + +testAstarA + 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 name: #nextTokenAstarA. + b retval: #AstarA. + + self should: [codeGenerator generate: fsa ] raise: Exception. +! + +testAstarB + 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. + + fsa name: #nextTokenAstarB. + b retval: #AstarB. + + scanner := (codeGenerator generate: fsa). + + 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. +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/abbrev.stc --- a/compiler/tests/abbrev.stc Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/abbrev.stc Fri Jul 24 15:06:54 2015 +0100 @@ -1,6 +1,15 @@ # 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. +FooScannerTest FooScannerTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Scanner' 1 +PEGFsaDeterminizationTest PEGFsaDeterminizationTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-FSA' 1 +PEGFsaGeneratorTest PEGFsaGeneratorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-FSA' 1 +PEGFsaInterpretTest PEGFsaInterpretTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-FSA' 1 +PEGFsaScannerIntegrationTest PEGFsaScannerIntegrationTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Scanner' 1 +PEGFsaStateTest PEGFsaStateTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-FSA' 1 +PEGFsaTest PEGFsaTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-FSA' 1 +PEGFsaTransitionTest PEGFsaTransitionTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-FSA' 1 +PPCClassBuilderTest PPCClassBuilderTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 1 PPCCodeGeneratorTest PPCCodeGeneratorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1 PPCCompilerTest PPCCompilerTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 1 PPCContextMementoTest PPCContextMementoTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Context' 1 @@ -17,6 +26,7 @@ PPCOptimizeChoicesTest PPCOptimizeChoicesTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1 PPCRecognizerComponentDetectorTest PPCRecognizerComponentDetectorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1 PPCRecognizerComponentVisitorTest PPCRecognizerComponentVisitorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1 +PPCScannerCodeGeneratorTest PPCScannerCodeGeneratorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Scanner' 1 PPCSpecializingVisitorTest PPCSpecializingVisitorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1 PPCTokenDetectorTest PPCTokenDetectorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1 PPCTokenGuardTest PPCTokenGuardTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Guards' 1 diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/bc.mak --- a/compiler/tests/bc.mak Thu May 21 14:12:22 2015 +0100 +++ b/compiler/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) " @@ -75,6 +74,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) @@ -91,6 +99,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) diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/bmake.bat --- a/compiler/tests/bmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/compiler/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% %* diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/Make.proto --- a/compiler/tests/extras/Make.proto Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/extras/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)" diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/PPCExpressionsVerificationTest.st --- a/compiler/tests/extras/PPCExpressionsVerificationTest.st Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/extras/PPCExpressionsVerificationTest.st Fri Jul 24 15:06:54 2015 +0100 @@ -75,7 +75,22 @@ source := fileResources expressionOfSize: 100. result := normalParser parse: source. - self assert: ((result deepFlatten select: [ :e | e isNumber ]) size) = 100. - self assert: ((result deepFlatten select: [ :e | e isNumber ]) size) = 100. + self assert: (((self deepFlattened: result) select: [ :e | e isNumber ]) size) = 100. + self assert: (((self deepFlattened: result)select: [ :e | e isNumber ]) size) = 100. ! ! +!PPCExpressionsVerificationTest methodsFor:'utilities'! + +deepFlatten: anObject into: aCollection + (anObject isCollection and:[anObject isString not]) ifTrue:[ + anObject do:[:each|self deepFlatten: each into: aCollection] + ] ifFalse:[ + aCollection add: anObject + ]. + ^aCollection +! + +deepFlattened: aCollection + ^self deepFlatten: aCollection into: OrderedCollection new. +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/PPCompiledExpressionGrammarResource.st --- a/compiler/tests/extras/PPCompiledExpressionGrammarResource.st Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/extras/PPCompiledExpressionGrammarResource.st Fri Jul 24 15:06:54 2015 +0100 @@ -14,7 +14,7 @@ setUp | time configuration | configuration := PPCConfiguration universal. - configuration arguments name: #PPCompiledExpressionGrammar. + configuration arguments parserName: #PPCompiledExpressionGrammar. time := Time millisecondsToRun: [ diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/PPCompiledJavaResource.st --- a/compiler/tests/extras/PPCompiledJavaResource.st Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/extras/PPCompiledJavaResource.st Fri Jul 24 15:06:54 2015 +0100 @@ -15,7 +15,7 @@ | time configuration | configuration := PPCConfiguration universal. - configuration arguments name:#PPCompiledJavaSyntax. + configuration arguments parserName:#PPCompiledJavaSyntax. time := Time millisecondsToRun: [ PPJavaSyntax new compileWithConfiguration: configuration. diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/PPCompiledJavaSyntaxTest.st --- a/compiler/tests/extras/PPCompiledJavaSyntaxTest.st Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/extras/PPCompiledJavaSyntaxTest.st Fri Jul 24 15:06:54 2015 +0100 @@ -106,9 +106,9 @@ self parse: ' public class OddEven { - private int input; - public static void main(String[] args) { - OddEven number = new OddEven(); + private int input; + public static void main(String[] args) { + OddEven number = new OddEven(); number.showDialog(); } public void showDialog() { diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/PPCompiledSmalltalkGrammarResource.st --- a/compiler/tests/extras/PPCompiledSmalltalkGrammarResource.st Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/extras/PPCompiledSmalltalkGrammarResource.st Fri Jul 24 15:06:54 2015 +0100 @@ -14,7 +14,7 @@ setUp | time configuration | configuration := PPCConfiguration universal. - configuration arguments name:#PPCompiledSmalltalkGrammar. + configuration arguments parserName:#PPCompiledSmalltalkGrammar. time := Time millisecondsToRun: [ PPSmalltalkGrammar new compileWithConfiguration: configuration. diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/PPCompiledSmalltalkParserResource.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/extras/PPCompiledSmalltalkParserResource.st Fri Jul 24 15:06:54 2015 +0100 @@ -0,0 +1,26 @@ +"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }" + +"{ NameSpace: Smalltalk }" + +TestResource subclass:#PPCompiledSmalltalkParserResource + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + category:'PetitCompiler-Extras-Tests-Smalltalk' +! + +!PPCompiledSmalltalkParserResource methodsFor:'as yet unclassified'! + +setUp + | time configuration | + configuration := PPCConfiguration universal. + configuration arguments parserName:#PPCompiledSmalltalkParser. + + time := Time millisecondsToRun: [ + PPSmalltalkParser new compileWithConfiguration: configuration. + ]. + Transcript show: 'Smalltalk Parser compiled in: '; show: time asString; show: 'ms'; cr. + + "Modified: / 10-05-2015 / 07:57:43 / Jan Vrany " +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/PPCompiledSmalltalkParserTests.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/extras/PPCompiledSmalltalkParserTests.st Fri Jul 24 15:06:54 2015 +0100 @@ -0,0 +1,39 @@ +"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }" + +"{ NameSpace: Smalltalk }" + +PPCompositeParserTest subclass:#PPCompiledSmalltalkParserTests + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + category:'PetitCompiler-Extras-Tests-Smalltalk' +! + +!PPCompiledSmalltalkParserTests class methodsFor:'as yet unclassified'! + +resources + ^ (OrderedCollection with: PPCompiledSmalltalkParserResource) + addAll: super resources; + yourself +! ! + +!PPCompiledSmalltalkParserTests methodsFor:'as yet unclassified'! + +context + ^ PPCContext new +! + +parserClass + ^ Smalltalk at: #PPCompiledSmalltalkParser +! + +parserInstanceFor: aSymbol + ^ (Smalltalk at: #PPCompiledSmalltalkParser) new startSymbol: aSymbol +! + +testBlock1 + self + parse: '[]' + rule: #block +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/PPLL1ExpressionGrammar.st --- a/compiler/tests/extras/PPLL1ExpressionGrammar.st Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/extras/PPLL1ExpressionGrammar.st Fri Jul 24 15:06:54 2015 +0100 @@ -14,12 +14,14 @@ add ^ prod, addPrime optional - map: [ :_prod :_addPrime | - _addPrime isNil - ifTrue: [ _prod ] - ifFalse: [ Array with: _prod withAll: _addPrime ] - - ] + map: [ :_prod :_addPrime | + _addPrime isNil + ifTrue: [ _prod ] + ifFalse: [ (Array with: _prod) , _addPrime ] + + ] + + "Modified (format): / 26-05-2015 / 07:23:34 / Jan Vrany " ! addPrime @@ -28,12 +30,14 @@ mul ^ prim, mulPrime optional - map: [ :_prim :_mulPrime | - _mulPrime isNil - ifTrue: [ _prim ] - ifFalse: [ Array with: _prim withAll: _mulPrime ] - - ] + map: [ :_prim :_mulPrime | + _mulPrime isNil + ifTrue: [ _prim ] + ifFalse: [ (Array with: _prim) , _mulPrime ] + + ] + + "Modified (format): / 26-05-2015 / 07:23:51 / Jan Vrany " ! mulPrime @@ -62,11 +66,13 @@ term ^ prod, termPrime optional - map: [ :_prod :_termPrime | + map: [ :_prod :_termPrime | _termPrime isNil ifTrue: [ _prod ] - ifFalse: [ Array with: _prod withAll: _termPrime ] - ] + ifFalse: [ (Array with: _prod) , _termPrime ] + ] + + "Modified: / 26-05-2015 / 07:24:03 / Jan Vrany " ! termPrime diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/PPTokenizedExpressionGrammarResource.st --- a/compiler/tests/extras/PPTokenizedExpressionGrammarResource.st Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/extras/PPTokenizedExpressionGrammarResource.st Fri Jul 24 15:06:54 2015 +0100 @@ -9,18 +9,27 @@ category:'PetitCompiler-Extras-Tests-Expressions' ! + !PPTokenizedExpressionGrammarResource methodsFor:'as yet unclassified'! setUp | time configuration | configuration := PPCTokenizingConfiguration new. - configuration arguments name:#PPTokenizedExpressionGrammar. + configuration arguments parserName:#PPTokenizedExpressionGrammar. time := Time millisecondsToRun: [ PPExpressionGrammar new compileWithConfiguration: configuration. ]. - Transcript crShow: 'Expression grammar tokenized in: ', time asString, 'ms'. - + Transcript show: 'Expression grammar tokenized in: '; show: time asString; show: 'ms'; cr. + + "Modified: / 26-05-2015 / 07:25:13 / Jan Vrany " ! ! +!PPTokenizedExpressionGrammarResource class methodsFor:'documentation'! + +version_HG + + ^ '$Changeset: $' +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/PPTokenizedLL1ExpressionGrammarResource.st --- a/compiler/tests/extras/PPTokenizedLL1ExpressionGrammarResource.st Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/extras/PPTokenizedLL1ExpressionGrammarResource.st Fri Jul 24 15:06:54 2015 +0100 @@ -14,13 +14,14 @@ setUp | time configuration | configuration := PPCTokenizingConfiguration new. - configuration arguments name:#PPTokenizedLL1ExpressionGrammar. + configuration arguments parserName:#PPTokenizedLL1ExpressionGrammar. time := Time millisecondsToRun: [ PPLL1ExpressionGrammar new compileWithConfiguration: configuration. ]. - Transcript crShow: 'LL1 Expression grammar tokenized in: ', time asString, 'ms'. - + Transcript show: 'LL1 Expression grammar tokenized in: '; show: time asString; show: 'ms'; cr. + + "Modified: / 26-05-2015 / 07:24:35 / Jan Vrany " ! ! diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/PPTokenizedSmalltalkGrammarResource.st --- a/compiler/tests/extras/PPTokenizedSmalltalkGrammarResource.st Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/extras/PPTokenizedSmalltalkGrammarResource.st Fri Jul 24 15:06:54 2015 +0100 @@ -15,7 +15,7 @@ setUp | time configuration | configuration := PPCConfiguration tokenizing. - configuration arguments name:#PPTokenizedSmalltalkGrammar. + configuration arguments parserName:#PPTokenizedSmalltalkGrammar. time := Time millisecondsToRun: [ PPSmalltalkGrammar new compileWithConfiguration: configuration. diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/PPTokenizedSmalltalkParserResource.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/extras/PPTokenizedSmalltalkParserResource.st Fri Jul 24 15:06:54 2015 +0100 @@ -0,0 +1,39 @@ +"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }" + +"{ NameSpace: Smalltalk }" + +TestResource subclass:#PPTokenizedSmalltalkParserResource + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + category:'PetitCompiler-Extras-Tests-Smalltalk' +! + +!PPTokenizedSmalltalkParserResource methodsFor:'as yet unclassified'! + +setUp + | time configuration | + configuration := PPCConfiguration tokenizing. + configuration arguments parserName:#PPTokenizedSmalltalkParser. + + time := Time millisecondsToRun: [ + PPSmalltalkParser new compileWithConfiguration: configuration. + ]. + Transcript show: 'Smalltalk Parser tokenized in: '; show: time asString; show: 'ms'; cr. + + "Modified: / 10-05-2015 / 07:55:07 / Jan Vrany " +! + +tearDown + | parserClass | + super tearDown. + + parserClass := (Smalltalk at: #PPTokenizedSmalltalkParser ifAbsent: [nil]). + self flag: 'uncomment:'. +" + parserClass notNil ifTrue:[ + parserClass removeFromSystem + ]. +" +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/PPTokenizedSmalltalkParserTests.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/extras/PPTokenizedSmalltalkParserTests.st Fri Jul 24 15:06:54 2015 +0100 @@ -0,0 +1,935 @@ +"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }" + +"{ NameSpace: Smalltalk }" + +PPCompositeParserTest subclass:#PPTokenizedSmalltalkParserTests + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + category:'PetitCompiler-Extras-Tests-Smalltalk' +! + +!PPTokenizedSmalltalkParserTests class methodsFor:'accessing'! + +resources + ^ (OrderedCollection with: PPTokenizedSmalltalkParserResource) + addAll: super resources; + yourself +! ! + +!PPTokenizedSmalltalkParserTests methodsFor:'accessing'! + +context + ^ PPCContext new +! + +parserClass + ^ Smalltalk at: #PPTokenizedSmalltalkParser +! + +parserInstanceFor: aSymbol + ^ (Smalltalk at: #PPTokenizedSmalltalkParser) new startSymbol: aSymbol +! + +testSmalltalkWhitespace + | whitespaces | + whitespaces := parser class methodDictionary keys select: [:e | e beginsWith: 'smalltalk_ws' ]. + self assert: whitespaces size = 1. +! ! + +!PPTokenizedSmalltalkParserTests methodsFor:'testing'! + +testArray1 + self + parse: '{}' + rule: #array +! + +testArray2 + self + parse: '{self foo}' + rule: #array +! + +testArray3 + self + parse: '{self foo. self bar}' + rule: #array +! + +testArray4 + self + parse: '{self foo. self bar.}' + rule: #array +! + +testAssignment1 + self + parse: '1' + rule: #expression +! + +testAssignment2 + self + parse: 'a := 1' + rule: #expression +! + +testAssignment3 + self + parse: 'a := b := 1' + rule: #expression +! + +testAssignment4 + PPSmalltalkGrammar allowUnderscoreAssignment + ifTrue: [ self parse: 'a _ 1' rule: #expression ] + ifFalse: [ self fail: 'a _ 1' rule: #expression ] +! + +testAssignment5 + PPSmalltalkGrammar allowUnderscoreAssignment + ifTrue: [ self parse: 'a _ b _ 1' rule: #expression ] + ifFalse: [ self fail: 'a _ b _ 1' rule: #expression ] +! + +testAssignment6 + self + parse: 'a := (b := c)' + rule: #expression +! + +testComment1 + self + parse: '1"one"+2' + rule: #expression +! + +testComment2 + self + parse: '1 "one" +2' + rule: #expression +! + +testComment3 + self + parse: '1"one"+"two"2' + rule: #expression +! + +testComment4 + self + parse: '1"one""two"+2' + rule: #expression +! + +testComment5 + self + parse: '1"one" "two"+2' + rule: #expression +! + +testCompleteness + "This test asserts that all subclasses override all test methods." + + self class allSubclasses do: [ :subclass | + self class testSelectors do: [ :selector | + self + assert: (selector = #testCompleteness or: [ subclass selectors includes: selector ]) + description: subclass printString , ' does not test ' , selector printString ] ] +! + +testMethod1 + self + parse: 'negated ^ 0 - self' + rule: #method +! + +testMethod2 + "Spaces at the beginning of the method." + self + parse: ' negated ^ 0 - self' + rule: #method +! + +testMethod3 + "Spaces at the end of the method." + self + parse: ' negated ^ 0 - self ' + rule: #method +! + +testMethod4 + self + parse: 'foo: bar + foo:= bar' + rule: #method +! + +testSequence1 + self + parse: '| a | 1 . 2' + rule: #sequence +! + +testStatements1 + self + parse: '1' + rule: #sequence +! + +testStatements2 + self + parse: '1 . 2' + rule: #sequence +! + +testStatements3 + self + parse: '1 . 2 . 3' + rule: #sequence +! + +testStatements4 + self + parse: '1 . 2 . 3 .' + rule: #sequence +! + +testStatements5 + self + parse: '1 . . 2' + rule: #sequence +! + +testStatements6 + self + parse: '1. 2' + rule: #sequence +! + +testStatements7 + self + parse: '. 1' + rule: #sequence +! + +testStatements8 + self + parse: '.1' + rule: #sequence +! + +testStatements9 + self + parse: '' + rule: #statements +! + +testTemporaries1 + self + parse: '| a |' + rule: #sequence +! + +testTemporaries2 + self + parse: '| a b |' + rule: #sequence +! + +testTemporaries3 + self + parse: '| a b c |' + rule: #sequence +! + +testVariable1 + self + parse: 'trueBinding' + rule: #primary +! + +testVariable2 + self + parse: 'falseBinding' + rule: #primary +! + +testVariable3 + self + parse: 'nilly' + rule: #primary +! + +testVariable4 + self + parse: 'selfish' + rule: #primary +! + +testVariable5 + self + parse: 'supernanny' + rule: #primary +! + +testVariable6 + PPSmalltalkGrammar allowUnderscoreAssignment ifFalse: [ + self + parse: 'super_nanny' + rule: #primary ] +! + +testVariable7 + PPSmalltalkGrammar allowUnderscoreAssignment ifFalse: [ + self + parse: '__gen_var_123__' + rule: #primary ] +! ! + +!PPTokenizedSmalltalkParserTests methodsFor:'testing-blocks'! + +testArgumentsBlock1 + self + parse: '[ :a | ]' + rule: #block +! + +testArgumentsBlock2 + self + parse: '[ :a :b | ]' + rule: #block +! + +testArgumentsBlock3 + self + parse: '[ :a :b :c | ]' + rule: #block +! + +testBlock1 + self + parse: '[]' + rule: #block +! + +testComplexBlock1 + self + parse: '[ :a | | b | c ]' + rule: #block +! + +testComplexBlock2 + self + parse: '[:a||b|c]' + rule: #block +! + +testSimpleBlock1 + self + parse: '[ ]' + rule: #block +! + +testSimpleBlock2 + self + parse: '[ nil ]' + rule: #block +! + +testSimpleBlock3 + self + parse: '[ :a ]' + rule: #block +! + +testStatementBlock1 + self + parse: '[ nil ]' + rule: #block +! + +testStatementBlock2 + self + parse: '[ | a | nil ]' + rule: #block +! + +testStatementBlock3 + self + parse: '[ | a b | nil ]' + rule: #block +! ! + +!PPTokenizedSmalltalkParserTests methodsFor:'testing-literals'! + +testArrayLiteral1 + self + parse: '#()' + rule: #arrayLiteral +! + +testArrayLiteral10 + self + parse: '#((1 2) #(1 2 3))' + rule: #arrayLiteral +! + +testArrayLiteral11 + self + parse: '#([1 2] #[1 2 3])' + rule: #arrayLiteral +! + +testArrayLiteral2 + self + parse: '#(1)' + rule: #arrayLiteral +! + +testArrayLiteral3 + self + parse: '#(1 2)' + rule: #arrayLiteral +! + +testArrayLiteral4 + self + parse: '#(true false nil)' + rule: #arrayLiteral +! + +testArrayLiteral5 + self + parse: '#($a)' + rule: #arrayLiteral +! + +testArrayLiteral6 + self + parse: '#(1.2)' + rule: #arrayLiteral +! + +testArrayLiteral7 + self + parse: '#(size #at: at:put: #''=='')' + rule: #arrayLiteral +! + +testArrayLiteral8 + self + parse: '#(''baz'')' + rule: #arrayLiteral +! + +testArrayLiteral9 + self + parse: '#((1) 2)' + rule: #arrayLiteral +! + +testByteLiteral1 + self + parse: '#[]' + rule: #byteLiteral +! + +testByteLiteral2 + self + parse: '#[0]' + rule: #byteLiteral +! + +testByteLiteral3 + self + parse: '#[255]' + rule: #byteLiteral +! + +testByteLiteral4 + self + parse: '#[ 1 2 ]' + rule: #byteLiteral +! + +testByteLiteral5 + self + parse: '#[ 2r1010 8r77 16rFF ]' + rule: #byteLiteral +! + +testCharLiteral1 + self + parse: '$a' + rule: #charLiteral +! + +testCharLiteral2 + self + parse: '$ ' + rule: #charLiteral +! + +testCharLiteral3 + self + parse: '$$' + rule: #charLiteral +! + +testNumberLiteral1 + self + parse: '0' + rule: #numberLiteral +! + +testNumberLiteral10 + self + parse: '10r10' + rule: #numberLiteral +! + +testNumberLiteral11 + self + parse: '8r777' + rule: #numberLiteral +! + +testNumberLiteral12 + self + parse: '16rAF' + rule: #numberLiteral +! + +testNumberLiteral13 + self + parse: '16rCA.FE' + rule: #numberLiteral +! + +testNumberLiteral14 + self + parse: '3r-22.2' + rule: #numberLiteral +! + +testNumberLiteral15 + self + parse: '0.50s2' + rule: #numberLiteral +! + +testNumberLiteral2 + self + parse: '0.1' + rule: #numberLiteral +! + +testNumberLiteral3 + self + parse: '123' + rule: #numberLiteral +! + +testNumberLiteral4 + self + parse: '123.456' + rule: #numberLiteral +! + +testNumberLiteral5 + self + parse: '-0' + rule: #numberLiteral +! + +testNumberLiteral6 + self + parse: '-0.1' + rule: #numberLiteral +! + +testNumberLiteral7 + self + parse: '-123' + rule: #numberLiteral +! + +testNumberLiteral8 + self + parse: '-125' + rule: #numberLiteral +! + +testNumberLiteral9 + self + parse: '-123.456' + rule: #numberLiteral +! + +testSpecialLiteral1 + self + parse: 'true' + rule: #trueLiteral +! + +testSpecialLiteral2 + self + parse: 'false' + rule: #falseLiteral +! + +testSpecialLiteral3 + self + parse: 'nil' + rule: #nilLiteral +! + +testStringLiteral1 + self + parse: '''''' + rule: #stringLiteral +! + +testStringLiteral2 + self + parse: '''ab''' + rule: #stringLiteral +! + +testStringLiteral3 + self + parse: '''ab''''cd''' + rule: #stringLiteral +! + +testSymbolLiteral1 + self + parse: '#foo' + rule: #symbolLiteral +! + +testSymbolLiteral2 + self + parse: '#+' + rule: #symbolLiteral +! + +testSymbolLiteral3 + self + parse: '#key:' + rule: #symbolLiteral +! + +testSymbolLiteral4 + self + parse: '#key:value:' + rule: #symbolLiteral +! + +testSymbolLiteral5 + self + parse: '#''testing-result''' + rule: #symbolLiteral +! + +testSymbolLiteral6 + PPSmalltalkGrammar allowUnderscoreAssignment ifFalse: [ + self + parse: '#__gen__binding' + rule: #symbolLiteral ] +! + +testSymbolLiteral7 + self + parse: '# fucker' + rule: #symbolLiteral +! + +testSymbolLiteral8 + self + parse: '##fucker' + rule: #symbolLiteral +! + +testSymbolLiteral9 + self + parse: '## fucker' + rule: #symbolLiteral +! ! + +!PPTokenizedSmalltalkParserTests methodsFor:'testing-messages'! + +testBinaryExpression1 + self + parse: '1 + 2' + rule: #expression +! + +testBinaryExpression2 + self + parse: '1 + 2 + 3' + rule: #expression +! + +testBinaryExpression3 + self + parse: '1 // 2' + rule: #expression +! + +testBinaryExpression4 + self + parse: '1 -- 2' + rule: #expression +! + +testBinaryExpression5 + self + parse: '1 ==> 2' + rule: #expression. +! + +testBinaryMethod1 + self + parse: '+ a' + rule: #method +! + +testBinaryMethod2 + self + parse: '+ a | b |' + rule: #method +! + +testBinaryMethod3 + self + parse: '+ a b' + rule: #method +! + +testBinaryMethod4 + self + parse: '+ a | b | c' + rule: #method +! + +testBinaryMethod5 + self + parse: '-- a' + rule: #method +! + +testCascadeExpression1 + self + parse: '1 abs; negated' + rule: #expression +! + +testCascadeExpression2 + self + parse: '1 abs negated; raisedTo: 12; negated' + rule: #expression +! + +testCascadeExpression3 + self + parse: '1 + 2; - 3' + rule: #expression +! + +testIdentifierToken + self + parse: 'foo' + rule: #identifierToken +! + +testIdentifierToken2 + self + parse: ' foo' + rule: #identifierToken +! + +testKeywordExpression1 + self + parse: '1 to: 2' + rule: #expression +! + +testKeywordExpression2 + self + parse: '1 to: 2 by: 3' + rule: #expression +! + +testKeywordExpression3 + self + parse: '1 to: 2 by: 3 do: 4' + rule: #expression +! + +testKeywordMethod1 + self + parse: 'to: a' + rule: #method +! + +testKeywordMethod2 + self + parse: 'to: a do: b | c |' + rule: #method +! + +testKeywordMethod3 + self + parse: 'to: a do: b by: c d' + rule: #method +! + +testKeywordMethod4 + self + parse: 'to: a do: b by: c | d | e' + rule: #method +! + +testUnaryExpression1 + self + parse: '1 abs' + rule: #expression +! + +testUnaryExpression2 + self + parse: '1 abs negated' + rule: #expression +! + +testUnaryMethod1 + self + parse: 'abs' + rule: #method +! + +testUnaryMethod2 + self + parse: 'abs | a |' + rule: #method +! + +testUnaryMethod3 + self + parse: 'abs a' + rule: #method +! + +testUnaryMethod4 + self + parse: 'abs | a | b' + rule: #method +! + +testUnaryMethod5 + self + parse: 'abs | a |' + rule: #method +! ! + +!PPTokenizedSmalltalkParserTests methodsFor:'testing-pragmas'! + +testPragma1 + self + parse: 'method ' + rule: #method +! + +testPragma10 + self + parse: 'method ' + rule: #method +! + +testPragma11 + self + parse: 'method ' + rule: #method +! + +testPragma12 + self + parse: 'method ' + rule: #method +! + +testPragma13 + self + parse: 'method ' + rule: #method +! + +testPragma14 + self + parse: 'method ' + rule: #method +! + +testPragma15 + self + parse: 'method ' + rule: #method +! + +testPragma16 + self + parse: 'method < + 1 >' + rule: #method +! + +testPragma2 + self + parse: 'method ' + rule: #method +! + +testPragma3 + self + parse: 'method | a | ' + rule: #method +! + +testPragma4 + self + parse: 'method | a |' + rule: #method +! + +testPragma5 + self + parse: 'method | a | ' + rule: #method +! + +testPragma6 + self + parse: 'method ' + rule: #method +! + +testPragma7 + self + parse: 'method ' + rule: #method +! + +testPragma8 + self + parse: 'method ' + rule: #method +! + +testPragma9 + self + parse: 'method ' + rule: #method +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/PPTokenizedSmalltalkParserVerificationTest.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/extras/PPTokenizedSmalltalkParserVerificationTest.st Fri Jul 24 15:06:54 2015 +0100 @@ -0,0 +1,39 @@ +"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }" + +"{ NameSpace: Smalltalk }" + +PPCSmalltalkVerificationTest subclass:#PPTokenizedSmalltalkParserVerificationTest + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + category:'PetitCompiler-Extras-Tests-Smalltalk' +! + +!PPTokenizedSmalltalkParserVerificationTest class methodsFor:'as yet unclassified'! + +resources + ^ (OrderedCollection with: PPTokenizedSmalltalkParserResource) + addAll: super resources; + yourself +! ! + +!PPTokenizedSmalltalkParserVerificationTest methodsFor:'accessing'! + +compiledSmalltalkGrammarClass + ^ (Smalltalk at: #PPTokenizedSmalltalkParser) +! ! + +!PPTokenizedSmalltalkParserVerificationTest methodsFor:'tests'! + +testSmalltalk + super testSmalltalk +! + +testSmalltalkClass + super testSmalltalkClass +! + +testSmalltalkObject + super testSmalltalkObject +! ! + diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/abbrev.stc --- a/compiler/tests/extras/abbrev.stc Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/extras/abbrev.stc Fri Jul 24 15:06:54 2015 +0100 @@ -12,6 +12,8 @@ PPCompiledJavaSyntaxTest PPCompiledJavaSyntaxTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Java' 1 PPCompiledSmalltalkGrammarResource PPCompiledSmalltalkGrammarResource stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1 PPCompiledSmalltalkGrammarTests PPCompiledSmalltalkGrammarTests stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1 +PPCompiledSmalltalkParserResource PPCompiledSmalltalkParserResource stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1 +PPCompiledSmalltalkParserTests PPCompiledSmalltalkParserTests stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1 PPExpressionGrammar PPExpressionGrammar stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 0 PPExpressionGrammarTest PPExpressionGrammarTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1 PPLL1ExpressionGrammar PPLL1ExpressionGrammar stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 0 @@ -22,8 +24,11 @@ PPTokenizedLL1ExpressionGrammarTest PPTokenizedLL1ExpressionGrammarTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1 PPTokenizedSmalltalkGrammarResource PPTokenizedSmalltalkGrammarResource stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1 PPTokenizedSmalltalkGrammarTests PPTokenizedSmalltalkGrammarTests stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1 +PPTokenizedSmalltalkParserResource PPTokenizedSmalltalkParserResource stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1 +PPTokenizedSmalltalkParserTests PPTokenizedSmalltalkParserTests stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1 stx_goodies_petitparser_compiler_tests_extras stx_goodies_petitparser_compiler_tests_extras stx:goodies/petitparser/compiler/tests/extras '* Projects & Packages *' 3 PPCompiledExpressionsVerificationTest PPCompiledExpressionsVerificationTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1 PPCompiledSmalltalkVerificationTest PPCompiledSmalltalkVerificationTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1 PPTokenizedExpressionsVerificationTest PPTokenizedExpressionsVerificationTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1 +PPTokenizedSmalltalkParserVerificationTest PPTokenizedSmalltalkParserVerificationTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1 PPTokenizedSmalltalkVerificationTest PPTokenizedSmalltalkVerificationTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1 diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/bc.mak --- a/compiler/tests/extras/bc.mak Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/extras/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) " diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/bmake.bat --- a/compiler/tests/extras/bmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/extras/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% %* diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/mingwmake.bat --- a/compiler/tests/extras/mingwmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/extras/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 diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/stx_goodies_petitparser_compiler_tests_extras.st --- a/compiler/tests/extras/stx_goodies_petitparser_compiler_tests_extras.st Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/extras/stx_goodies_petitparser_compiler_tests_extras.st Fri Jul 24 15:06:54 2015 +0100 @@ -113,6 +113,8 @@ (PPCompiledJavaSyntaxTest autoload) (PPCompiledSmalltalkGrammarResource autoload) (PPCompiledSmalltalkGrammarTests autoload) + (PPCompiledSmalltalkParserResource autoload) + (PPCompiledSmalltalkParserTests autoload) PPExpressionGrammar (PPExpressionGrammarTest autoload) PPLL1ExpressionGrammar @@ -123,10 +125,13 @@ (PPTokenizedLL1ExpressionGrammarTest autoload) (PPTokenizedSmalltalkGrammarResource autoload) (PPTokenizedSmalltalkGrammarTests autoload) + (PPTokenizedSmalltalkParserResource autoload) + (PPTokenizedSmalltalkParserTests autoload) #'stx_goodies_petitparser_compiler_tests_extras' (PPCompiledExpressionsVerificationTest autoload) (PPCompiledSmalltalkVerificationTest autoload) (PPTokenizedExpressionsVerificationTest autoload) + (PPTokenizedSmalltalkParserVerificationTest autoload) (PPTokenizedSmalltalkVerificationTest autoload) ) ! diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/extras/vcmake.bat --- a/compiler/tests/extras/vcmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/extras/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% %* - diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/libInit.cc --- a/compiler/tests/libInit.cc Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/libInit.cc Fri Jul 24 15:06:54 2015 +0100 @@ -27,6 +27,15 @@ void _libstx_goodies_petitparser_compiler_tests_Init(pass, __pRT__, snd) OBJ snd; struct __vmData__ *__pRT__; { __BEGIN_PACKAGE2__("libstx_goodies_petitparser_compiler_tests", _libstx_goodies_petitparser_compiler_tests_Init, "stx:goodies/petitparser/compiler/tests"); +_FooScannerTest_Init(pass,__pRT__,snd); +_PEGFsaDeterminizationTest_Init(pass,__pRT__,snd); +_PEGFsaGeneratorTest_Init(pass,__pRT__,snd); +_PEGFsaInterpretTest_Init(pass,__pRT__,snd); +_PEGFsaScannerIntegrationTest_Init(pass,__pRT__,snd); +_PEGFsaStateTest_Init(pass,__pRT__,snd); +_PEGFsaTest_Init(pass,__pRT__,snd); +_PEGFsaTransitionTest_Init(pass,__pRT__,snd); +_PPCClassBuilderTest_Init(pass,__pRT__,snd); _PPCCodeGeneratorTest_Init(pass,__pRT__,snd); _PPCCompilerTest_Init(pass,__pRT__,snd); _PPCContextMementoTest_Init(pass,__pRT__,snd); @@ -43,6 +52,7 @@ _PPCOptimizeChoicesTest_Init(pass,__pRT__,snd); _PPCRecognizerComponentDetectorTest_Init(pass,__pRT__,snd); _PPCRecognizerComponentVisitorTest_Init(pass,__pRT__,snd); +_PPCScannerCodeGeneratorTest_Init(pass,__pRT__,snd); _PPCSpecializingVisitorTest_Init(pass,__pRT__,snd); _PPCTokenDetectorTest_Init(pass,__pRT__,snd); _PPCTokenGuardTest_Init(pass,__pRT__,snd); diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/mingwmake.bat --- a/compiler/tests/mingwmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/compiler/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 diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/stx_goodies_petitparser_compiler_tests.st --- a/compiler/tests/stx_goodies_petitparser_compiler_tests.st Thu May 21 14:12:22 2015 +0100 +++ b/compiler/tests/stx_goodies_petitparser_compiler_tests.st Fri Jul 24 15:06:54 2015 +0100 @@ -57,7 +57,7 @@ ^ #( #'stx:goodies/petitparser/tests' "PPAbstractParserTest - superclass of PPCCodeGeneratorTest" - #'stx:goodies/sunit' "TestAsserter - superclass of PPCCodeGeneratorTest" + #'stx:goodies/sunit' "TestAsserter - superclass of FooScannerTest" #'stx:libbasic' "LibraryDefinition - superclass of stx_goodies_petitparser_compiler_tests" ) ! @@ -73,8 +73,8 @@ by searching all classes (and their packages) which are referenced by my classes." ^ #( - #'stx:goodies/petitparser' "PPCharSetPredicate - referenced by PPCCodeGeneratorTest>>testCharSetPredicateNode" - #'stx:goodies/petitparser/compiler' "PPCAbstractLiteralNode - referenced by PPCNodeFirstFollowNextTests>>testFirst1" + #'stx:goodies/petitparser' "PPCharSetPredicate - referenced by PEGFsaGeneratorTest>>testCharSetPredicateNode" + #'stx:goodies/petitparser/compiler' "FooScanner - referenced by FooScannerTest>>setUp" #'stx:goodies/petitparser/parsers/java' "PPJavaWhitespaceParser - referenced by PPCMergingVisitorTest>>javaWsNode" ) ! @@ -107,6 +107,15 @@ ^ #( " or ( attributes...) in load order" + FooScannerTest + PEGFsaDeterminizationTest + PEGFsaGeneratorTest + PEGFsaInterpretTest + PEGFsaScannerIntegrationTest + PEGFsaStateTest + PEGFsaTest + PEGFsaTransitionTest + PPCClassBuilderTest PPCCodeGeneratorTest PPCCompilerTest PPCContextMementoTest @@ -123,6 +132,7 @@ PPCOptimizeChoicesTest PPCRecognizerComponentDetectorTest PPCRecognizerComponentVisitorTest + PPCScannerCodeGeneratorTest PPCSpecializingVisitorTest PPCTokenDetectorTest PPCTokenGuardTest diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/vcmake.bat --- a/compiler/tests/vcmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/compiler/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% %* - diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/vcmake.bat --- a/compiler/vcmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/compiler/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% %* - diff -r f6d77fee9811 -r 1e45d3c96ec5 islands/bmake.bat --- a/islands/bmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/islands/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% %* diff -r f6d77fee9811 -r 1e45d3c96ec5 islands/mingwmake.bat --- a/islands/mingwmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/islands/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 diff -r f6d77fee9811 -r 1e45d3c96ec5 islands/tests/bmake.bat --- a/islands/tests/bmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/islands/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% %* diff -r f6d77fee9811 -r 1e45d3c96ec5 islands/tests/mingwmake.bat --- a/islands/tests/mingwmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/islands/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 diff -r f6d77fee9811 -r 1e45d3c96ec5 islands/tests/vcmake.bat --- a/islands/tests/vcmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/islands/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% %* - diff -r f6d77fee9811 -r 1e45d3c96ec5 islands/vcmake.bat --- a/islands/vcmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/islands/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% %* - diff -r f6d77fee9811 -r 1e45d3c96ec5 mingwmake.bat --- a/mingwmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/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 diff -r f6d77fee9811 -r 1e45d3c96ec5 tests/Make.proto --- a/tests/Make.proto Thu May 21 14:12:22 2015 +0100 +++ b/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)" diff -r f6d77fee9811 -r 1e45d3c96ec5 tests/PPArithmeticParser.st --- a/tests/PPArithmeticParser.st Thu May 21 14:12:22 2015 +0100 +++ b/tests/PPArithmeticParser.st Fri Jul 24 15:06:54 2015 +0100 @@ -66,6 +66,11 @@ ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPArithmeticParser.st,v 1.4 2014-03-04 14:33:59 cg Exp $' ! +version_HG + + ^ '$Changeset: $' +! + version_SVN ^ '$Id: PPArithmeticParser.st,v 1.4 2014-03-04 14:33:59 cg Exp $' ! ! diff -r f6d77fee9811 -r 1e45d3c96ec5 tests/bc.mak --- a/tests/bc.mak Thu May 21 14:12:22 2015 +0100 +++ b/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) " diff -r f6d77fee9811 -r 1e45d3c96ec5 tests/bmake.bat --- a/tests/bmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/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% %* diff -r f6d77fee9811 -r 1e45d3c96ec5 tests/mingwmake.bat --- a/tests/mingwmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/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 diff -r f6d77fee9811 -r 1e45d3c96ec5 tests/vcmake.bat --- a/tests/vcmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/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% %* - diff -r f6d77fee9811 -r 1e45d3c96ec5 vcmake.bat --- a/vcmake.bat Thu May 21 14:12:22 2015 +0100 +++ b/vcmake.bat Fri Jul 24 15:06:54 2015 +0100 @@ -10,13 +10,10 @@ 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% %* - @echo "***********************************" @echo "Buildung stx/goodies/petitparser/analyzer @echo "***********************************"