# HG changeset patch # User Jan Vrany # Date 1437748643 -3600 # Node ID ff58cd9f1f3ceb25495d011d4bcadd45fecab6f4 # Parent e29bd90f388ea7e293cc0a02db964b85ca5943b0# Parent 1e45d3c96ec58e53caf50ec3c59a65e22ea38639 Merge diff -r e29bd90f388e -r ff58cd9f1f3c PPCompositeParser.st --- a/PPCompositeParser.st Fri Jun 19 08:13:39 2015 +0100 +++ b/PPCompositeParser.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c PPDelegateParser.st --- a/PPDelegateParser.st Fri Jun 19 08:13:39 2015 +0100 +++ b/PPDelegateParser.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c PPFlattenParser.st --- a/PPFlattenParser.st Fri Jun 19 08:13:39 2015 +0100 +++ b/PPFlattenParser.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c PPSequenceParser.st --- a/PPSequenceParser.st Fri Jun 19 08:13:39 2015 +0100 +++ b/PPSequenceParser.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c analyzer/bmake.bat --- a/analyzer/bmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/analyzer/bmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c analyzer/mingwmake.bat --- a/analyzer/mingwmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/analyzer/mingwmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c analyzer/tests/bmake.bat --- a/analyzer/tests/bmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/analyzer/tests/bmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c analyzer/tests/mingwmake.bat --- a/analyzer/tests/mingwmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/analyzer/tests/mingwmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c analyzer/tests/vcmake.bat --- a/analyzer/tests/vcmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/analyzer/tests/vcmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c analyzer/vcmake.bat --- a/analyzer/vcmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/analyzer/vcmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c bmake.bat --- a/bmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/bmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/FooScanner.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/FooScanner.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/Make.proto --- a/compiler/Make.proto Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/Make.proto Fri Jul 24 15:37:23 2015 +0100 @@ -130,9 +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,10 +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) @@ -158,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) diff -r e29bd90f388e -r ff58cd9f1f3c compiler/Make.spec --- a/compiler/Make.spec Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/Make.spec Fri Jul 24 15:37:23 2015 +0100 @@ -51,9 +51,17 @@ STCWARNINGS=-warnNonStandard COMMON_CLASSES= \ + PEGFsa \ + PEGFsaFailure \ + PEGFsaInterpret \ + PEGFsaPair \ + PEGFsaState \ + PEGFsaTransition \ PPCArguments \ PPCBridge \ PPCCodeBlock \ + PPCClassBuilder \ + PPCCodeGen \ PPCCompiledMethod \ PPCCompiler \ PPCCompilerTokenErrorStrategy \ @@ -68,10 +76,14 @@ PPCNode \ PPCNodeVisitor \ PPCPluggableConfiguration \ + PPCScanner \ + PPCScannerCodeGenerator \ PPCTokenGuard \ PPCompiledParser \ PPMappedActionParser \ stx_goodies_petitparser_compiler \ + FooScanner \ + PEGFsaGenerator \ PPCAbstractLiteralNode \ PPCAbstractPredicateNode \ PPCAnyNode \ @@ -79,6 +91,7 @@ PPCCodeGenerator \ PPCDelegateNode \ PPCEndOfFileNode \ + PPCFSACodeGen \ PPCInlinedMethod \ PPCInliningVisitor \ PPCListNode \ @@ -146,9 +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)PPCCodeBlock.$(O) \ + $(OUTDIR_SLASH)PPCClassBuilder.$(O) \ + $(OUTDIR_SLASH)PPCCodeGen.$(O) \ $(OUTDIR_SLASH)PPCCompiledMethod.$(O) \ $(OUTDIR_SLASH)PPCCompiler.$(O) \ $(OUTDIR_SLASH)PPCCompilerTokenErrorStrategy.$(O) \ @@ -163,10 +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) \ @@ -174,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) \ diff -r e29bd90f388e -r ff58cd9f1f3c compiler/PEGFsa.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/PEGFsa.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/PEGFsaFailure.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/PEGFsaFailure.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/PEGFsaGenerator.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/PEGFsaGenerator.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/PEGFsaInterpret.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/PEGFsaInterpret.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/PEGFsaPair.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/PEGFsaPair.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/PEGFsaState.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/PEGFsaState.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/PEGFsaTransition.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/PEGFsaTransition.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/PPCArguments.st --- a/compiler/PPCArguments.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/PPCArguments.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/PPCClassBuilder.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/PPCClassBuilder.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/PPCCodeBlock.st --- a/compiler/PPCCodeBlock.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/PPCCodeBlock.st Fri Jul 24 15:37:23 2015 +0100 @@ -39,26 +39,12 @@ code: aStringOrBlockOrRBParseNode aStringOrBlockOrRBParseNode isString ifTrue:[ - buffer nextPutAll: aStringOrBlockOrRBParseNode + self emitCodeAsString: aStringOrBlockOrRBParseNode ] ifFalse:[ (aStringOrBlockOrRBParseNode isKindOf: RBProgramNode) ifTrue:[ - aStringOrBlockOrRBParseNode isSequence ifTrue:[ - aStringOrBlockOrRBParseNode temporaries do:[:e | - (temporaries includes: e name) ifFalse:[ - temporaries add: e name - ]. - ]. - aStringOrBlockOrRBParseNode statements do:[:e| - buffer nextPutAll: e formattedCode; nextPut: $.. - self nl; codeIndent. - ]. - - ] ifFalse:[ - buffer nextPutAll: aStringOrBlockOrRBParseNode formattedCode. - ]. - + self emitCodeAsRBNode: aStringOrBlockOrRBParseNode. ] ifFalse:[ - aStringOrBlockOrRBParseNode value + self emitCodeAsBlock: aStringOrBlockOrRBParseNode ]. ]. @@ -143,7 +129,7 @@ ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ indentation * 4 timesRepeat: [ aStream nextPut: Character space ]. ] ifFalse:[ - indentation timesRepeat: [ buffer nextPut: Character tab ]. + indentation timesRepeat: [ aStream nextPut: Character tab ]. ]. aStream nextPut: $|. temporaries do:[:e | aStream space; nextPutAll: e ]. @@ -160,3 +146,37 @@ "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 e29bd90f388e -r ff58cd9f1f3c compiler/PPCCodeGen.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/PPCCodeGen.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/PPCCodeGenerator.st --- a/compiler/PPCCodeGenerator.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/PPCCodeGenerator.st Fri Jul 24 15:37:23 2015 +0100 @@ -9,7 +9,6 @@ category:'PetitCompiler-Visitors' ! - !PPCCodeGenerator class methodsFor:'as yet unclassified'! new @@ -34,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 @@ -401,54 +482,13 @@ ! visitChoiceNode: node - | whitespaceConsumed allowGuard elementVar coding | - - - elementVar := compiler allocateTemporaryVariableNamed: 'element'. - whitespaceConsumed := self addGuardTrimming: node. - allowGuard := whitespaceConsumed. + | whitespaceConsumed useGuards resultVar | - allowGuard ifTrue:[ - coding := - [ :children :index | - self addGuard: (children at: index) ifTrue: [ - compiler add: 'self clearError.'. - compiler - codeAssignParsedValueOf:[ self visit:(children at:index) ] - to:elementVar. - compiler add: 'error ifFalse: [ '. - compiler codeReturn: elementVar. - compiler add: ' ].'. - ] ifFalse:[ - compiler add: 'error := true.'. - ]. - compiler add: 'error ifTrue:[ '. - index < children size ifTrue:[ - coding value: children value: index + 1. - ] ifFalse:[ - compiler codeError: 'no choice suitable'. - ]. - compiler add: '] '. - ] - ] ifFalse:[ - coding := - [ :children :index | - index <= children size ifTrue:[ - compiler add: 'self clearError.'. - compiler - codeAssignParsedValueOf:[ self visit:(children at:index) ] - to:elementVar. - compiler add: 'error ifFalse: [ '. - compiler codeReturn: elementVar. - compiler add: ' ].'. - coding value: children value: index + 1. - ] ifFalse:[ - compiler codeError: 'no choice suitable'. - ]. - ] - ]. - - coding value: node children value: 1. + resultVar := compiler allocateTemporaryVariableNamed: 'element'. + whitespaceConsumed := self addGuardTrimming: node. + useGuards := whitespaceConsumed. + self generateChoiceChildOf: node atIndex: 1 useGuards: useGuards storeResultInto: resultVar + "Modified: / 29-05-2015 / 07:17:36 / Jan Vrany " ! @@ -462,12 +502,10 @@ compiler codeAssignParsedValueOf:[ self visit:node child ] to:self retvalVar. - compiler add: 'context atEnd ifTrue: ['. - compiler codeReturn. - compiler add: '] ifFalse: ['. - compiler codeError: 'End of input expected'. - compiler add: '].'. - + compiler codeIf: 'context atEnd' + then: [ compiler codeReturn ] + else: [ compiler codeError: 'End of input expected' ]. + "Modified: / 26-05-2015 / 19:03:09 / Jan Vrany " ! @@ -762,14 +800,13 @@ visitSequenceNode: node - | elementVars mementoVar canBacktrack coding | + | elementVars mementoVar canBacktrack | elementVars := node preferredChildrenVariableNames. elementVars do:[:e | compiler allocateTemporaryVariableNamed: e. ]. - canBacktrack := (node children allButFirst allSatisfy: [:e | e acceptsEpsilon ]) not. " self addGuardTrimming: node. @@ -783,45 +820,7 @@ node returnParsedObjectsAsCollection ifTrue:[ compiler codeAssign: 'Array new: ', node children size asString, '.' to: self retvalVar. ]. - - coding := [ :index | - | child childValueVar | - - child := node children at: index. - childValueVar := elementVars at: index. - compiler codeAssignParsedValueOf: [ self visit:child ] - to: childValueVar. - child acceptsEpsilon ifFalse: [ - compiler codeIfErrorThen: [ - "Handle error in the first element specially" - "TODO: JK, please explain here why!!!!!!" - index == 1 ifTrue:[ - compiler add: 'error ifTrue: [ ^ failure ].'. - ] ifFalse:[ - compiler smartRestore: node from: mementoVar. - compiler codeReturn: 'failure.'. - ] - ] else:[ - node returnParsedObjectsAsCollection ifTrue:[ - compiler add: self retvalVar , ' at: ', index asString, ' put: ', childValueVar, '.'. - ]. - (index < node children size) ifTrue:[ - coding value: index + 1. - ]. - ] - - ] ifTrue:[ - node returnParsedObjectsAsCollection ifTrue:[ - compiler add: self retvalVar , ' at: ', index asString, ' put: ', childValueVar, '.'. - ]. - (index < node children size) ifTrue:[ - coding value: index + 1. - ]. - ] - ]. - - coding value:1. - + self generateSequenceChildOf: node atIndex: 1 useMememntoVar: mementoVar storeResultInto: elementVars. compiler codeReturn "Modified (comment): / 16-06-2015 / 06:38:02 / Jan Vrany " @@ -1051,10 +1050,3 @@ "Modified: / 15-06-2015 / 17:59:23 / Jan Vrany " ! ! -!PPCCodeGenerator class methodsFor:'documentation'! - -version_HG - - ^ '$Changeset: $' -! ! - diff -r e29bd90f388e -r ff58cd9f1f3c compiler/PPCCompiler.st --- a/compiler/PPCCompiler.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/PPCCompiler.st Fri Jul 24 15:37:23 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'! @@ -133,6 +127,12 @@ currentMethod addOnLine: string. ! +addVariable: name + ^ self currentNonInlineMethod addVariable: name + + "Modified: / 23-04-2015 / 17:34:02 / Jan Vrany " +! + call: anotherMethod currentMethod add: anotherMethod call. ! @@ -199,6 +199,7 @@ method := [ aBlock value ] ensure:[ returnVariable := tmpVarirable ]. + self assert: (method isKindOf: PPCMethod). method isInline ifTrue:[ self callOnLine:method ] ifFalse:[ @@ -243,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 ] ! @@ -336,16 +337,16 @@ codeReturn currentMethod isInline ifTrue: [ - "If inlined, the return variable already holds the value" - ] ifFalse: [ - arguments profile ifTrue:[ - self codeProfileStop. - ]. - 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: / 01-06-2015 / 21:49:04 / Jan Vrany " + "Created: / 23-04-2015 / 18:01:05 / Jan Vrany " + "Modified: / 01-06-2015 / 21:49:04 / Jan Vrany " ! codeReturn: code @@ -364,6 +365,47 @@ "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 + | 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. @@ -523,11 +565,11 @@ stopMethod self cache: currentMethod methodName as: currentMethod. - - "arguments profile ifTrue: [ Transcript show: currentMethod code; cr. ]." - ^ self pop. + + "arguments profile ifTrue: [ Transcript show: currentMethod code; cr. ]." + ^ self pop. - "Modified: / 01-06-2015 / 21:38:05 / Jan Vrany " + "Modified: / 01-06-2015 / 21:38:05 / Jan Vrany " ! top diff -r e29bd90f388e -r ff58cd9f1f3c compiler/PPCConfiguration.st --- a/compiler/PPCConfiguration.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/PPCConfiguration.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/PPCContextMemento.st --- a/compiler/PPCContextMemento.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/PPCContextMemento.st Fri Jul 24 15:37:23 2015 +0100 @@ -99,7 +99,7 @@ self keysAndValuesDo: [ :key :value | (anObject hasProperty: key) ifFalse: [ ^ false ]. ((anObject propertyAt: key) = value) ifFalse: [ ^ false ]. - ]. + ]. ^ true. ! diff -r e29bd90f388e -r ff58cd9f1f3c compiler/PPCFSACodeGen.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/PPCFSACodeGen.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/PPCInlinedMethod.st diff -r e29bd90f388e -r ff58cd9f1f3c compiler/PPCInliningVisitor.st diff -r e29bd90f388e -r ff58cd9f1f3c compiler/PPCMappedActionNode.st diff -r e29bd90f388e -r ff58cd9f1f3c compiler/PPCMethod.st --- a/compiler/PPCMethod.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/PPCMethod.st Fri Jul 24 15:37:23 2015 +0100 @@ -3,7 +3,7 @@ "{ NameSpace: Smalltalk }" Object subclass:#PPCMethod - instanceVariableNames:'buffer id variableForReturn category' + instanceVariableNames:'buffer id variableForReturn category profile' classVariableNames:'' poolDictionaries:'' category:'PetitCompiler-Compiler-Codegen' @@ -66,6 +66,14 @@ methodName ^ id +! + +profile + ^ profile +! + +profile: aBoolean + profile := aBoolean ! ! !PPCMethod methodsFor:'as yet unclassified'! @@ -88,14 +96,14 @@ profilingBegin self profile ifTrue: [ - ^ ' context methodInvoked: #', id, '.' + ^ ' context methodInvoked: #', id, '.' ]. ^ '' ! profilingEnd self profile ifTrue: [ - ^ ' context methodFinished: #', id, '.' + ^ ' context methodFinished: #', id, '.' ]. ^ '' ! ! @@ -116,17 +124,14 @@ innerBlock := PPCCodeBlock new. innerBlock indentationLevel: outerBlock indentationLevel + 1. [ - buffer addOnLine:'['; nl; codeIndent. + outerBlock addOnLine:'['. buffer := innerBlock. self code: contents. ] ensure:[ - buffer := outerBlock. - buffer + outerBlock code: (String streamContents:[:s | innerBlock codeOn: s]); - nl; - codeIndent. - - buffer addOnLine:']'. + add:']'. + buffer := outerBlock. ] "Created: / 01-06-2015 / 22:33:21 / Jan Vrany " @@ -156,6 +161,17 @@ !PPCMethod methodsFor:'code generation - variables'! +allocateReturnVariable + + ^ variableForReturn isNil ifTrue:[ + variableForReturn := self allocateTemporaryVariableNamed: 'retval' + ] ifFalse:[ + variableForReturn + ]. + + "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)" diff -r e29bd90f388e -r ff58cd9f1f3c compiler/PPCNilNode.st --- a/compiler/PPCNilNode.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/PPCNilNode.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/PPCNode.st --- a/compiler/PPCNode.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/PPCNode.st Fri Jul 24 15:37:23 2015 +0100 @@ -242,7 +242,7 @@ finite := self. infinite := anotherNode. ] ifFalse: [ - finite := anotherNode. + finite := anotherNode. infinite := self. ]. @@ -525,6 +525,10 @@ !PPCNode methodsFor:'testing'! +canHavePPCId + ^ true +! + isMarkedForInline ^ self propertyAt: #inlined ifAbsent: [ false ]. @@ -551,6 +555,12 @@ ^ self ! +asFsa + | visitor | + visitor := PEGFsaGenerator new. + ^ visitor visit: self +! + replace: node with: anotherNode ! diff -r e29bd90f388e -r ff58cd9f1f3c compiler/PPCProfilingContext.st --- a/compiler/PPCProfilingContext.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/PPCProfilingContext.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/PPCScanner.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/PPCScanner.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/PPCScannerCodeGenerator.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/PPCScannerCodeGenerator.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/PPCSequenceNode.st diff -r e29bd90f388e -r ff58cd9f1f3c compiler/PPCSpecializingVisitor.st diff -r e29bd90f388e -r ff58cd9f1f3c compiler/PPCTokenCodeGenerator.st diff -r e29bd90f388e -r ff58cd9f1f3c compiler/PPCTokenizingCodeGenerator.st --- a/compiler/PPCTokenizingCodeGenerator.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/PPCTokenizingCodeGenerator.st Fri Jul 24 15:37:23 2015 +0100 @@ -9,7 +9,6 @@ category:'PetitCompiler-Visitors' ! - !PPCTokenizingCodeGenerator methodsFor:'accessing'! guards @@ -51,7 +50,7 @@ trueBlock value. compiler dedent. falseBlock isNil ifTrue: [ compiler addOnLine: '].' ] - ifFalse: [ compiler add: ']'. ] + ifFalse: [ compiler add: ']'. ] ]. falseBlock isNil ifFalse: [ compiler addOnLine: ' ifFalse: ['. @@ -130,9 +129,11 @@ ! visitDeterministicChoiceNode: node - | dictionary | + | dictionary isInlined | dictionary := IdentityDictionary new. + isInlined := node isMarkedForInline. + node children do: [ :child | | firstSet | firstSet := child firstSetWithTokens. @@ -148,14 +149,19 @@ compiler add: '(self ', tokenMethodName asString, ')'. compiler addOnLine: ' ifTrue: ['. compiler indent. - compiler codeAssignParsedValueOf:[ self visit:child ] to:self retvalVar. - compiler codeReturn: self retvalVar. + compiler codeReturnParsedValueOf:[ self visit:child ]. compiler dedent. - compiler add: '] ifFalse:[' + isInlined ifTrue:[ + compiler add: '] ifFalse: [' + ] ifFalse:[ + compiler add: '].'. + ] ]. compiler codeError: 'no choice found'. - node children size timesRepeat: [ compiler add: ']' ]. - compiler add: '.'. + isInlined ifTrue:[ + node children size timesRepeat: [ compiler addOnLine: ']' ]. + compiler addOnLine: '.'. + ] "Modified: / 21-05-2015 / 15:31:26 / Jan Vrany " ! @@ -214,10 +220,3 @@ self error: 'shoudl not happend!!' ! ! -!PPCTokenizingCodeGenerator class methodsFor:'documentation'! - -version_HG - - ^ '$Changeset: $' -! ! - diff -r e29bd90f388e -r ff58cd9f1f3c compiler/PPCTokenizingVisitor.st diff -r e29bd90f388e -r ff58cd9f1f3c compiler/PPMappedActionParser.st --- a/compiler/PPMappedActionParser.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/PPMappedActionParser.st Fri Jul 24 15:37:23 2015 +0100 @@ -6,7 +6,7 @@ instanceVariableNames:'' classVariableNames:'' poolDictionaries:'' - category:'PetitParser-Parsers' + category:'PetitCompiler-Parsers' ! !PPMappedActionParser methodsFor:'converting'! diff -r e29bd90f388e -r ff58cd9f1f3c compiler/PPTokenizingCompiledParser.st --- a/compiler/PPTokenizingCompiledParser.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/PPTokenizingCompiledParser.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/abbrev.stc --- a/compiler/abbrev.stc Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/abbrev.stc Fri Jul 24 15:37:23 2015 +0100 @@ -1,9 +1,18 @@ # 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 PPCCodeBlock PPCCodeBlock stx:goodies/petitparser/compiler 'PetitCompiler-Compiler-Codegen' 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 @@ -18,10 +27,14 @@ 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 'PetitParser-Parsers' 0 +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 @@ -30,6 +43,8 @@ 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-Compiler-Codegen' 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 @@ -88,6 +103,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 'PetitParser-Parsers' 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 e29bd90f388e -r ff58cd9f1f3c compiler/bc.mak --- a/compiler/bc.mak Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/bc.mak Fri Jul 24 15:37:23 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\goodies\refactoryBrowser\parser -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2 -I$(INCLUDE_TOP)\stx\libwidg -I$(INCLUDE_TOP)\stx\libwidg2 +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) @@ -77,9 +77,18 @@ # 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)PPCCodeBlock.$(O) PPCCodeBlock.$(H): PPCCodeBlock.st $(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,10 +103,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) @@ -105,6 +118,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) diff -r e29bd90f388e -r ff58cd9f1f3c compiler/benchmarks/Make.proto diff -r e29bd90f388e -r ff58cd9f1f3c compiler/benchmarks/PPCBenchmark.st --- a/compiler/benchmarks/PPCBenchmark.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/benchmarks/PPCBenchmark.st Fri Jul 24 15:37:23 2015 +0100 @@ -30,7 +30,7 @@ ]. ^ (benchmarkSuiteClass class:self) run - " + " PPCBenchmark run. " ! @@ -712,6 +712,28 @@ "Created: / 16-05-2015 / 09:44:46 / Jan Vrany " ! +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. " diff -r e29bd90f388e -r ff58cd9f1f3c compiler/benchmarks/PPCSmalltalkNoopParser.st --- a/compiler/benchmarks/PPCSmalltalkNoopParser.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/benchmarks/PPCSmalltalkNoopParser.st Fri Jul 24 15:37:23 2015 +0100 @@ -12,21 +12,21 @@ !PPCSmalltalkNoopParser methodsFor:'accessing'! startExpression - "Make the sequence node has a method node as its parent and that the source is set." + "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 ] ] + ^ ([ :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 ] + "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'! @@ -100,7 +100,7 @@ ! blockArgument - ^ super blockArgument ==> #second + ^ super blockArgument ==> #second ! blockBody @@ -213,107 +213,107 @@ !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 + 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 ] ] + ^ 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 ] + | 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 ] ] ] + ^ (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 + | 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 + ^ 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 + 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: '''' + (aString isEmpty or: [ aString first ~= $' or: [ aString last ~= $' ] ]) + ifTrue: [ ^ aString ]. + ^ (aString + copyFrom: 2 + to: aString size - 1) + copyReplaceAll: '''''' + with: '''' ! ! !PPCSmalltalkNoopParser methodsFor:'token'! diff -r e29bd90f388e -r ff58cd9f1f3c compiler/benchmarks/bc.mak diff -r e29bd90f388e -r ff58cd9f1f3c compiler/benchmarks/bmake.bat --- a/compiler/benchmarks/bmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/benchmarks/bmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/benchmarks/mingwmake.bat --- a/compiler/benchmarks/mingwmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/benchmarks/mingwmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/benchmarks/stx_goodies_petitparser_compiler_benchmarks.st diff -r e29bd90f388e -r ff58cd9f1f3c compiler/benchmarks/vcmake.bat --- a/compiler/benchmarks/vcmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/benchmarks/vcmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/bmake.bat --- a/compiler/bmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/bmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/extensions.st --- a/compiler/extensions.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/extensions.st Fri Jul 24 15:37:23 2015 +0100 @@ -8,6 +8,12 @@ !Object methodsFor:'*petitcompiler'! +canHavePPCId + ^ false +! ! + +!Object methodsFor:'*petitcompiler'! + isInlinedMethod ^ false ! ! @@ -638,7 +644,7 @@ !PPSmalltalkGrammar methodsFor:'*petitcompiler'! comment - ^ $" asParser, $" asParser negate star, $" asParser. + ^ $" asParser, $" asParser negate star, $" asParser. ! ! !PPSmalltalkGrammar methodsFor:'*petitcompiler'! diff -r e29bd90f388e -r ff58cd9f1f3c compiler/libInit.cc --- a/compiler/libInit.cc Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/libInit.cc Fri Jul 24 15:37:23 2015 +0100 @@ -27,9 +27,18 @@ 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); _PPCCodeBlock_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); @@ -44,10 +53,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); @@ -55,6 +68,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); diff -r e29bd90f388e -r ff58cd9f1f3c compiler/mingwmake.bat --- a/compiler/mingwmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/mingwmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/stx_goodies_petitparser_compiler.st --- a/compiler/stx_goodies_petitparser_compiler.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/stx_goodies_petitparser_compiler.st Fri Jul 24 15:37:23 2015 +0100 @@ -76,8 +76,9 @@ ^ #( #'stx:goodies/petitparser/analyzer' "PPSentinel - referenced by PPCompiledParser class>>referringParser" #'stx:goodies/refactoryBrowser/parser' "RBAssignmentNode - referenced by PPCCodeGenerator>>visitActionNode:" - #'stx:libbasic2' "Stack - referenced by PPCCompiler>>initializeForCompiledClassName:" + #'stx:libbasic2' "IdentityBag - referenced by PEGFsa>>checkTransitionsIdentity" #'stx:libwidg' "ScrollableView - referenced by PPCNode>>inspector2TabTree" + #'stx:libview' "Color - referenced by PEGFsa>>viewGraphOn:" #'stx:libwidg2' "HierarchicalListView - referenced by PPCNode>>inspector2TabTree" ) ! @@ -110,9 +111,18 @@ ^ #( " or ( attributes...) in load order" + PEGFsa + PEGFsaFailure + PEGFsaInterpret + PEGFsaPair + PEGFsaState + PEGFsaTransition PPCArguments PPCBridge PPCCodeBlock + PPCClassBuilder + PPCCodeBlock + PPCCodeGen PPCCompiledMethod PPCCompiler PPCCompilerTokenErrorStrategy @@ -127,10 +137,14 @@ PPCNode PPCNodeVisitor PPCPluggableConfiguration + PPCScanner + PPCScannerCodeGenerator PPCTokenGuard PPCompiledParser PPMappedActionParser #'stx_goodies_petitparser_compiler' + FooScanner + PEGFsaGenerator PPCAbstractLiteralNode PPCAbstractPredicateNode PPCAnyNode @@ -138,6 +152,7 @@ PPCCodeGenerator PPCDelegateNode PPCEndOfFileNode + PPCFSACodeGen PPCInlinedMethod PPCInliningVisitor PPCListNode @@ -316,6 +331,9 @@ PPParser compileTokenizing PPCompositeParser asCompilerNode PPSequenceParser map: + Object canHavePPCId + PPCompositeParser asCompilerNode + PPSequenceParser map: ) ! ! diff -r e29bd90f388e -r ff58cd9f1f3c compiler/tests/FooScannerTest.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/FooScannerTest.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/Make.proto --- a/compiler/tests/Make.proto Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/Make.proto Fri Jul 24 15:37:23 2015 +0100 @@ -127,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) @@ -143,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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/Make.spec --- a/compiler/tests/Make.spec Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/Make.spec Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/PEGFsaDeterminizationTest.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/PEGFsaDeterminizationTest.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/PEGFsaGeneratorTest.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/PEGFsaGeneratorTest.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/PEGFsaInterpretTest.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/PEGFsaInterpretTest.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/PEGFsaScannerIntegrationTest.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/PEGFsaScannerIntegrationTest.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/PEGFsaStateTest.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/PEGFsaStateTest.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/PEGFsaTest.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/PEGFsaTest.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/PEGFsaTransitionTest.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/PEGFsaTransitionTest.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/PPCClassBuilderTest.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/PPCClassBuilderTest.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/PPCCodeGeneratorTest.st --- a/compiler/tests/PPCCodeGeneratorTest.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/PPCCodeGeneratorTest.st Fri Jul 24 15:37:23 2015 +0100 @@ -437,21 +437,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 @@ -917,6 +917,48 @@ "Created: / 22-05-2015 / 11:47:09 / Jan Vrany " ! +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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/PPCScannerCodeGeneratorTest.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/tests/PPCScannerCodeGeneratorTest.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/abbrev.stc --- a/compiler/tests/abbrev.stc Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/abbrev.stc Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/bc.mak --- a/compiler/tests/bc.mak Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/bc.mak Fri Jul 24 15:37:23 2015 +0100 @@ -74,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) @@ -90,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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/bmake.bat --- a/compiler/tests/bmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/bmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/extras/Make.proto diff -r e29bd90f388e -r ff58cd9f1f3c compiler/tests/extras/PPCExpressionsVerificationTest.st --- a/compiler/tests/extras/PPCExpressionsVerificationTest.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/extras/PPCExpressionsVerificationTest.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/extras/PPCompiledExpressionGrammarResource.st --- a/compiler/tests/extras/PPCompiledExpressionGrammarResource.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/extras/PPCompiledExpressionGrammarResource.st Fri Jul 24 15:37:23 2015 +0100 @@ -15,7 +15,7 @@ setUp | time configuration | configuration := PPCConfiguration universal. - configuration arguments name: #PPCompiledExpressionGrammar. + configuration arguments parserName: #PPCompiledExpressionGrammar. time := Time millisecondsToRun: [ diff -r e29bd90f388e -r ff58cd9f1f3c compiler/tests/extras/PPCompiledJavaResource.st --- a/compiler/tests/extras/PPCompiledJavaResource.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/extras/PPCompiledJavaResource.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/extras/PPCompiledJavaSyntaxTest.st --- a/compiler/tests/extras/PPCompiledJavaSyntaxTest.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/extras/PPCompiledJavaSyntaxTest.st Fri Jul 24 15:37:23 2015 +0100 @@ -107,9 +107,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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/extras/PPCompiledSmalltalkGrammarResource.st --- a/compiler/tests/extras/PPCompiledSmalltalkGrammarResource.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/extras/PPCompiledSmalltalkGrammarResource.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c 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:37:23 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 e29bd90f388e -r ff58cd9f1f3c 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:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/extras/PPLL1ExpressionGrammar.st --- a/compiler/tests/extras/PPLL1ExpressionGrammar.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/extras/PPLL1ExpressionGrammar.st Fri Jul 24 15:37:23 2015 +0100 @@ -14,14 +14,14 @@ add ^ prod, addPrime optional - map: [ :_prod :_addPrime | - _addPrime isNil - ifTrue: [ _prod ] - ifFalse: [ (Array with: _prod) , _addPrime ] - - ] + map: [ :_prod :_addPrime | + _addPrime isNil + ifTrue: [ _prod ] + ifFalse: [ (Array with: _prod) , _addPrime ] + + ] - "Modified (format): / 26-05-2015 / 07:23:34 / Jan Vrany " + "Modified (format): / 26-05-2015 / 07:23:34 / Jan Vrany " ! addPrime @@ -30,14 +30,14 @@ mul ^ prim, mulPrime optional - map: [ :_prim :_mulPrime | - _mulPrime isNil - ifTrue: [ _prim ] - ifFalse: [ (Array with: _prim) , _mulPrime ] - - ] + map: [ :_prim :_mulPrime | + _mulPrime isNil + ifTrue: [ _prim ] + ifFalse: [ (Array with: _prim) , _mulPrime ] + + ] - "Modified (format): / 26-05-2015 / 07:23:51 / Jan Vrany " + "Modified (format): / 26-05-2015 / 07:23:51 / Jan Vrany " ! mulPrime diff -r e29bd90f388e -r ff58cd9f1f3c compiler/tests/extras/PPTokenizedExpressionGrammarResource.st --- a/compiler/tests/extras/PPTokenizedExpressionGrammarResource.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/extras/PPTokenizedExpressionGrammarResource.st Fri Jul 24 15:37:23 2015 +0100 @@ -15,7 +15,7 @@ setUp | time configuration | configuration := PPCTokenizingConfiguration new. - configuration arguments name:#PPTokenizedExpressionGrammar. + configuration arguments parserName:#PPTokenizedExpressionGrammar. time := Time millisecondsToRun: [ diff -r e29bd90f388e -r ff58cd9f1f3c compiler/tests/extras/PPTokenizedLL1ExpressionGrammarResource.st --- a/compiler/tests/extras/PPTokenizedLL1ExpressionGrammarResource.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/extras/PPTokenizedLL1ExpressionGrammarResource.st Fri Jul 24 15:37:23 2015 +0100 @@ -14,7 +14,7 @@ setUp | time configuration | configuration := PPCTokenizingConfiguration new. - configuration arguments name:#PPTokenizedLL1ExpressionGrammar. + configuration arguments parserName:#PPTokenizedLL1ExpressionGrammar. time := Time millisecondsToRun: [ diff -r e29bd90f388e -r ff58cd9f1f3c compiler/tests/extras/PPTokenizedSmalltalkGrammarResource.st --- a/compiler/tests/extras/PPTokenizedSmalltalkGrammarResource.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/extras/PPTokenizedSmalltalkGrammarResource.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c 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:37:23 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 e29bd90f388e -r ff58cd9f1f3c 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:37:23 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 e29bd90f388e -r ff58cd9f1f3c 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:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/extras/abbrev.stc --- a/compiler/tests/extras/abbrev.stc Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/extras/abbrev.stc Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/extras/bc.mak diff -r e29bd90f388e -r ff58cd9f1f3c compiler/tests/extras/bmake.bat --- a/compiler/tests/extras/bmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/extras/bmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/extras/mingwmake.bat --- a/compiler/tests/extras/mingwmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/extras/mingwmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/extras/stx_goodies_petitparser_compiler_tests_extras.st --- a/compiler/tests/extras/stx_goodies_petitparser_compiler_tests_extras.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/extras/stx_goodies_petitparser_compiler_tests_extras.st Fri Jul 24 15:37:23 2015 +0100 @@ -139,6 +139,8 @@ (PPCompiledJavaSyntaxTest autoload) PPCompiledSmalltalkGrammarResource PPCompiledSmalltalkGrammarTests + (PPCompiledSmalltalkParserResource autoload) + (PPCompiledSmalltalkParserTests autoload) PPExpressionGrammar PPExpressionGrammarTest PPLL1ExpressionGrammar @@ -149,11 +151,14 @@ PPTokenizedLL1ExpressionGrammarTest PPTokenizedSmalltalkGrammarResource PPTokenizedSmalltalkGrammarTests + (PPTokenizedSmalltalkParserResource autoload) + (PPTokenizedSmalltalkParserTests autoload) #'stx_goodies_petitparser_compiler_tests_extras' PPCompiledExpressionsVerificationTest PPCompiledSmalltalkVerificationTest PPTokenizedExpressionsVerificationTest PPTokenizedSmalltalkVerificationTest + (PPTokenizedSmalltalkParserVerificationTest autoload) ) ! diff -r e29bd90f388e -r ff58cd9f1f3c compiler/tests/extras/vcmake.bat --- a/compiler/tests/extras/vcmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/extras/vcmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/libInit.cc --- a/compiler/tests/libInit.cc Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/libInit.cc Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/mingwmake.bat --- a/compiler/tests/mingwmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/mingwmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/stx_goodies_petitparser_compiler_tests.st --- a/compiler/tests/stx_goodies_petitparser_compiler_tests.st Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/stx_goodies_petitparser_compiler_tests.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/tests/vcmake.bat --- a/compiler/tests/vcmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/tests/vcmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c compiler/vcmake.bat --- a/compiler/vcmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/compiler/vcmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c islands/bmake.bat --- a/islands/bmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/islands/bmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c islands/mingwmake.bat --- a/islands/mingwmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/islands/mingwmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c islands/tests/bmake.bat --- a/islands/tests/bmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/islands/tests/bmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c islands/tests/mingwmake.bat --- a/islands/tests/mingwmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/islands/tests/mingwmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c islands/tests/vcmake.bat --- a/islands/tests/vcmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/islands/tests/vcmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c islands/vcmake.bat --- a/islands/vcmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/islands/vcmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c mingwmake.bat --- a/mingwmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/mingwmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c tests/PPArithmeticParser.st --- a/tests/PPArithmeticParser.st Fri Jun 19 08:13:39 2015 +0100 +++ b/tests/PPArithmeticParser.st Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c tests/bmake.bat --- a/tests/bmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/tests/bmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c tests/mingwmake.bat --- a/tests/mingwmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/tests/mingwmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c tests/vcmake.bat --- a/tests/vcmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/tests/vcmake.bat Fri Jul 24 15:37:23 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 e29bd90f388e -r ff58cd9f1f3c vcmake.bat --- a/vcmake.bat Fri Jun 19 08:13:39 2015 +0100 +++ b/vcmake.bat Fri Jul 24 15:37:23 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 "***********************************"