Updated to PetitCompiler-JanKurs.160, PetitCompiler-Tests-JanKurs.112, PetitCompiler-Extras-Tests-JanKurs.25, PetitCompiler-Benchmarks-JanKurs.17
Name: PetitCompiler-JanKurs.160
Author: JanKurs
Time: 17-08-2015, 09:52:26.291 AM
UUID: 3b4bfc98-8098-4951-af83-a59e2585b121
Name: PetitCompiler-Tests-JanKurs.112
Author: JanKurs
Time: 16-08-2015, 05:00:32.936 PM
UUID: 85613d47-08f3-406f-9823-9cdab451e805
Name: PetitCompiler-Extras-Tests-JanKurs.25
Author: JanKurs
Time: 16-08-2015, 05:00:10.328 PM
UUID: 09731810-51a1-4151-8d3a-56b636fbd1f7
Name: PetitCompiler-Benchmarks-JanKurs.17
Author: JanKurs
Time: 05-08-2015, 05:29:32.407 PM
UUID: e544b5f1-bcf8-470b-93a6-d2363e4dfc8a
--- a/compiler/FooScanner.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/FooScanner.st Mon Aug 17 12:13:16 2015 +0100
@@ -4,131 +4,146 @@
PPCScanner subclass:#FooScanner
instanceVariableNames:''
- classVariableNames:''
+ classVariableNames:'MaxSymbolNumber Tokens'
poolDictionaries:''
category:'PetitCompiler-Scanner'
!
-!FooScanner methodsFor:'as yet unclassified'!
+!FooScanner class methodsFor:'as yet unclassified'!
+
+initialize
+ super initialize.
+
+ MaxSymbolNumber := 3.
+ Tokens := #(#A1 #A2 #B).
+! !
+
+!FooScanner methodsFor:'distinct'!
nextTokenA
"a"
+ self resetDistinct.
+
self step.
self peek == $a ifFalse: [ ^ self return ].
- self recordMatch: #a.
+ self recordDistinctMatch: #a.
- ^ self return
+ ^ self returnDistinct
!
nextTokenAAorA
"aa / a"
+ self resetDistinct.
+
self step.
- (self peek == $a) ifFalse: [ ^ self return ].
- self recordMatch: #a priority: -1.
+ (self peek == $a) ifFalse: [ ^ self returnDistinct ].
+ self recordDistinctMatch: #a.
self step.
- (self peek == $a) ifFalse: [ ^ self return ].
- self recordMatch: #aa priority: 0.
+ (self peek == $a) ifFalse: [ ^ self returnDistinct ].
+ self recordDistinctMatch: #aa.
- ^ self return.
+ ^ self returnDistinct.
!
nextTokenAAplusA
"(aa)+a"
+ self resetDistinct.
+
self step.
- self peek == $a ifFalse: [ ^ self return ].
+ self peek == $a ifFalse: [ ^ self returnDistinct ].
self step.
- self peek == $a ifFalse: [ ^ self return. ].
+ self peek == $a ifFalse: [ ^ self returnDistinct. ].
[
+ self recordDistinctMatch: nil.
+
self step.
- self peek == $a ifFalse: [ ^ self returnPriority: 0 ].
- self recordMatch: #AAplusA priority: -1.
+ self peek == $a ifFalse: [ ^ self returnDistinct ].
+ self recordDistinctMatch: #AAplusA.
self step.
self peek == $a.
] whileTrue.
- ^ self returnPriority: -1
+ ^ self returnDistinct
!
nextTokenAAstarA
"(aa)*a"
+ self resetDistinct.
+
self step.
- self peek == $a ifFalse: [ ^ self return ].
+ self peek == $a ifFalse: [ ^ self returnDistinct ].
[
- self recordMatch: #AAstarA priority: -1.
+ self recordDistinctMatch: #AAstarA.
self step.
- self peek == $a ifFalse: [ ^ self returnPriority: -1 ].
+ self peek == $a ifFalse: [ ^ self returnDistinct ].
+ self recordDistinctMatch: nil.
+
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.
+ ^ self returnDistinct
!
nextTokenABorBC
"a"
+ self resetDistinct.
+
self step.
(self peek == $a) ifTrue: [
self step.
- self peek == $b ifFalse: [ ^ self return ].
- self recordMatch: #ab.
+ self peek == $b ifFalse: [ ^ self returnDistinct ].
+ self recordDistinctMatch: #ab.
- ^ self return
+ ^ self returnDistinct
].
(self peek == $b) ifTrue: [
self step.
- self peek == $c ifFalse: [ ^ self return ].
- self recordMatch: #bc.
+ self peek == $c ifFalse: [ ^ self returnDistinct ].
+ self recordDistinctMatch: #bc.
- ^ self return
+ ^ self returnDistinct
].
- ^ self return
+ ^ self returnDistinct
!
nextTokenABstarA
"(ab)*a"
+ self resetDistinct.
+
self step.
- self peek == $a ifFalse: [ ^ self return ].
+ self peek == $a ifFalse: [ ^ self returnDistinct ].
[
- self recordMatch: #ABstarA priority: -1.
+ self recordDistinctMatch: #ABstarA.
self step.
- self peek == $b ifFalse: [ ^ self returnPriority: -1 ].
+ self peek == $b ifFalse: [ ^ self returnDistinct ].
+ self recordDistinctMatch: nil.
self step.
self peek == $a.
] whileTrue.
- ^ self returnPriority: 0
+ ^ self returnDistinct
!
nextTokenA_Bstar_A
"ab"
+ self resetDistinct.
+
self step.
- self peek == $a ifFalse: [ ^ self return ].
+ self peek == $a ifFalse: [ ^ self returnDistinct ].
[
self step.
@@ -136,40 +151,44 @@
] whileTrue.
- self peek == $a ifFalse: [ ^ self return ].
- self recordMatch: #A_Bstar_A.
+ self peek == $a ifFalse: [ ^ self returnDistinct ].
+ self recordDistinctMatch: #A_Bstar_A.
- ^ self return.
+ ^ self returnDistinct.
!
nextTokenAorAA
"aa / a"
+ self resetDistinct.
+
self step.
(self peek == $a) ifTrue: [
- self recordMatch: #a priority: 0.
- ^ self return
+ self recordDistinctMatch: #a.
+ ^ self returnDistinct
].
self step.
(self peek == $a) ifTrue: [
- self recordMatch: #aa priority: -1.
- ^ self return
+ self recordDistinctMatch: #aa.
+ ^ self returnDistinct
].
!
nextTokenAorB
"a"
+ self resetDistinct.
+
self step.
(self peek == $a) ifTrue: [
- self recordMatch: #a.
- ^ self return
+ self recordDistinctMatch: #a.
+ ^ self returnDistinct
].
(self peek == $b) ifTrue: [
- self recordMatch: #b.
- ^ self return
+ self recordDistinctMatch: #b.
+ ^ self returnDistinct
].
- ^ self return
+ ^ self returnDistinct
!
nextTokenAstarA
@@ -179,32 +198,71 @@
self peek == $a.
] whileTrue.
- self peek == $a ifFalse: [ ^ self return ].
- self recordMatch: #AstarA.
- ^ self return
+ self peek == $a ifFalse: [ ^ self returnDistinct ].
+ self recordDistinctMatch: #AstarA.
+ ^ self returnDistinct
!
nextTokenAstarB
"a*b"
+ self resetDistinct.
+
[
self step.
self peek == $a.
] whileTrue.
- self peek == $b ifFalse: [ ^ self return ].
- self recordMatch: #AstarB.
- ^ self return
+ self peek == $b ifFalse: [ ^ self returnDistinct ].
+ self recordDistinctMatch: #AstarB.
+ ^ self returnDistinct
+! !
+
+!FooScanner methodsFor:'initialization'!
+
+initialize
+ super initialize.
+! !
+
+!FooScanner methodsFor:'mutlivalue'!
+
+nextMultiTokenA
+ "a|a"
+ self reset.
+
+ self step.
+ self peek == $a ifFalse: [ ^ self ].
+
+ self recordMatch: 1. "A1 in matches"
+ self recordMatch: 2. "A2 in matches"
+!
+
+nextTokenAB
+ "ab"
+ self reset.
+
+ self step.
+ self peek == $a ifFalse: [ ^ self ].
+
+ self step.
+ self peek == $b ifFalse: [ ^ self ].
+ self recordMatch: 3. "ID of #B"
+
+ ^ self
!
nextTokenAuorA
"a | a"
+ self reset.
+
self step.
(self peek == $a) ifTrue: [
- self recordMatch: #a1.
- self recordMatch: #a2.
- ^ self return
+ self recordMatch: 1.
+ self recordMatch: 2.
+ ^ self
].
- ^ self return
+ ^ self
! !
+
+FooScanner initialize!
--- a/compiler/Make.proto Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/Make.proto Mon Aug 17 12:13:16 2015 +0100
@@ -131,16 +131,23 @@
# 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)PEGFsaAbstractDeterminizator.$(O) PEGFsaAbstractDeterminizator.$(H): PEGFsaAbstractDeterminizator.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)PEGFsaInterpretRecord.$(O) PEGFsaInterpretRecord.$(H): PEGFsaInterpretRecord.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaMinimizator.$(O) PEGFsaMinimizator.$(H): PEGFsaMinimizator.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)PEGFsaStateInfo.$(O) PEGFsaStateInfo.$(H): PEGFsaStateInfo.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PEGFsaTransition.$(O) PEGFsaTransition.$(H): PEGFsaTransition.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCASTUtilities.$(O) PPCASTUtilities.$(H): PPCASTUtilities.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)PPCCompilationError.$(O) PPCCompilationError.$(H): PPCCompilationError.st $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCCompilationWarning.$(O) PPCCompilationWarning.$(H): PPCCompilationWarning.st $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Notification.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/UserNotification.$(H) $(INCLUDE_TOP)/stx/libbasic/Warning.$(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)
@@ -151,24 +158,34 @@
$(OUTDIR)PPCContext.$(O) PPCContext.$(H): PPCContext.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/PeekableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/PositionableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/ReadStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(STCHDR)
$(OUTDIR)PPCContextMemento.$(O) PPCContextMemento.$(H): PPCContextMemento.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCGuard.$(O) PPCGuard.$(H): PPCGuard.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCIdGenerator.$(O) PPCIdGenerator.$(H): PPCIdGenerator.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCMethod.$(O) PPCMethod.$(H): PPCMethod.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(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)PPCScannerResultStrategy.$(O) PPCScannerResultStrategy.$(H): PPCScannerResultStrategy.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)PEGFsaCharacterTransition.$(O) PEGFsaCharacterTransition.$(H): PEGFsaCharacterTransition.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PEGFsaTransition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaChoiceDeterminizator.$(O) PEGFsaChoiceDeterminizator.$(H): PEGFsaChoiceDeterminizator.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PEGFsaAbstractDeterminizator.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaDeterminizator.$(O) PEGFsaDeterminizator.$(H): PEGFsaDeterminizator.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PEGFsaAbstractDeterminizator.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaEpsilonTransition.$(O) PEGFsaEpsilonTransition.$(H): PEGFsaEpsilonTransition.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PEGFsaTransition.$(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)PEGFsaPredicateTransition.$(O) PEGFsaPredicateTransition.$(H): PEGFsaPredicateTransition.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PEGFsaTransition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaSequenceDeterminizator.$(O) PEGFsaSequenceDeterminizator.$(H): PEGFsaSequenceDeterminizator.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PEGFsaAbstractDeterminizator.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaUncopiableState.$(O) PEGFsaUncopiableState.$(H): PEGFsaUncopiableState.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PEGFsaState.$(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)
$(OUTDIR)PPCCharacterNode.$(O) PPCCharacterNode.$(H): PPCCharacterNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(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)PPCDistinctResultStrategy.$(O) PPCDistinctResultStrategy.$(H): PPCDistinctResultStrategy.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCScannerResultStrategy.$(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)
@@ -178,11 +195,15 @@
$(OUTDIR)PPCPluggableNode.$(O) PPCPluggableNode.$(H): PPCPluggableNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCProfilingContext.$(O) PPCProfilingContext.$(H): PPCProfilingContext.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPStream.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCContext.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/PeekableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/PositionableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/ReadStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(STCHDR)
$(OUTDIR)PPCRewritingVisitor.$(O) PPCRewritingVisitor.$(H): PPCRewritingVisitor.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNodeVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCTokenCodeGenerator.$(O) PPCTokenCodeGenerator.$(H): PPCTokenCodeGenerator.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNodeVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCTokenizingCodeGen.$(O) PPCTokenizingCodeGen.$(H): PPCTokenizingCodeGen.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCCodeGen.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenizingCompiler.$(O) PPCTokenizingCompiler.$(H): PPCTokenizingCompiler.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCCompiler.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenizingConfiguration.$(O) PPCTokenizingConfiguration.$(H): PPCTokenizingConfiguration.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCConfiguration.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCUniversalConfiguration.$(O) PPCUniversalConfiguration.$(H): PPCUniversalConfiguration.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCConfiguration.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCUniversalResultStrategy.$(O) PPCUniversalResultStrategy.$(H): PPCUniversalResultStrategy.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCScannerResultStrategy.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCUnknownNode.$(O) PPCUnknownNode.$(H): PPCUnknownNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPTokenizingCompiledParser.$(O) PPTokenizingCompiledParser.$(H): PPTokenizingCompiledParser.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCompiledParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaEOFTransition.$(O) PEGFsaEOFTransition.$(H): PEGFsaEOFTransition.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PEGFsaPredicateTransition.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PEGFsaTransition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCAbstractActionNode.$(O) PPCAbstractActionNode.$(H): PPCAbstractActionNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCDelegateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCAndNode.$(O) PPCAndNode.$(H): PPCAndNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCDelegateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCCharSetPredicateNode.$(O) PPCCharSetPredicateNode.$(H): PPCCharSetPredicateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractPredicateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
@@ -210,7 +231,6 @@
$(OUTDIR)PPCSequenceNode.$(O) PPCSequenceNode.$(H): PPCSequenceNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCListNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCSpecializingVisitor.$(O) PPCSpecializingVisitor.$(H): PPCSpecializingVisitor.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNodeVisitor.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCRewritingVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCStarNode.$(O) PPCStarNode.$(H): PPCStarNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCDelegateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCTokenCodeGenerator.$(O) PPCTokenCodeGenerator.$(H): PPCTokenCodeGenerator.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCCodeGenerator.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNodeVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenConsumeNode.$(O) PPCTokenConsumeNode.$(H): PPCTokenConsumeNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCDelegateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenDetector.$(O) PPCTokenDetector.$(H): PPCTokenDetector.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNodeVisitor.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCRewritingVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenNode.$(O) PPCTokenNode.$(H): PPCTokenNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCDelegateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
@@ -233,7 +253,7 @@
$(OUTDIR)PPCMappedActionNode.$(O) PPCMappedActionNode.$(H): PPCMappedActionNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractActionNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCActionNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCDelegateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenStarMessagePredicateNode.$(O) PPCTokenStarMessagePredicateNode.$(H): PPCTokenStarMessagePredicateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCDelegateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCStarMessagePredicateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCStarNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenStarSeparatorNode.$(O) PPCTokenStarSeparatorNode.$(H): PPCTokenStarSeparatorNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCDelegateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCStarMessagePredicateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCStarNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCTokenStarMessagePredicateNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPActionParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPAndParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPCharSetPredicate.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPChoiceParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPCompositeParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPContext.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPEndOfInputParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPEpsilonParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPFailure.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPFlattenParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPListParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPLiteralObjectParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPLiteralParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPLiteralSequenceParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPNotParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPOptionalParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPPluggableParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPPossessiveRepeatingParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPPredicateObjectParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPPredicateParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPRepeatingParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPSequenceParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPStream.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPToken.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPTokenParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPTrimmingParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/parsers/java/PPJavaWhitespaceParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk/PPSmalltalkGrammar.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk/PPSmalltalkTokenParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk/PPSmalltalkWhitespaceParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Character.$(H) $(INCLUDE_TOP)/stx/libbasic/Magnitude.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/PeekableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/PositionableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/ReadStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(INCLUDE_TOP)/stx/libbasic/UndefinedObject.$(H) $(STCHDR)
+$(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPActionParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPAndParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPCharSetPredicate.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPChoiceParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPCompositeParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPContext.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPEndOfFileParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPEndOfInputParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPEpsilonParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPFailure.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPFlattenParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPListParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPLiteralObjectParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPLiteralParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPLiteralSequenceParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPNotParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPOptionalParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPPluggableParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPPossessiveRepeatingParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPPredicateObjectParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPPredicateParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPRepeatingParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPSequenceParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPStream.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPToken.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPTokenParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPTrimmingParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/parsers/java/PPJavaWhitespaceParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk/PPSmalltalkGrammar.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk/PPSmalltalkTokenParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk/PPSmalltalkWhitespaceParser.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBLiteralNode.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBLiteralValueNode.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBProgramNode.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBStatementNode.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBValueNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Character.$(H) $(INCLUDE_TOP)/stx/libbasic/Magnitude.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/PeekableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/PositionableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/ReadStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(INCLUDE_TOP)/stx/libbasic/UndefinedObject.$(H) $(STCHDR)
# ENDMAKEDEPEND --- do not remove this line
--- a/compiler/Make.spec Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/Make.spec Mon Aug 17 12:13:16 2015 +0100
@@ -52,16 +52,23 @@
COMMON_CLASSES= \
PEGFsa \
+ PEGFsaAbstractDeterminizator \
PEGFsaFailure \
PEGFsaInterpret \
+ PEGFsaInterpretRecord \
+ PEGFsaMinimizator \
PEGFsaPair \
PEGFsaState \
+ PEGFsaStateInfo \
PEGFsaTransition \
+ PPCASTUtilities \
PPCArguments \
PPCBridge \
PPCClassBuilder \
PPCCodeBlock \
PPCCodeGen \
+ PPCCompilationError \
+ PPCCompilationWarning \
PPCCompiledMethod \
PPCCompiler \
PPCCompilerTokenErrorStrategy \
@@ -72,24 +79,34 @@
PPCContext \
PPCContextMemento \
PPCGuard \
+ PPCIdGenerator \
PPCMethod \
PPCNode \
PPCNodeVisitor \
PPCPluggableConfiguration \
PPCScanner \
PPCScannerCodeGenerator \
+ PPCScannerResultStrategy \
PPCTokenGuard \
PPCompiledParser \
PPMappedActionParser \
stx_goodies_petitparser_compiler \
FooScanner \
+ PEGFsaCharacterTransition \
+ PEGFsaChoiceDeterminizator \
+ PEGFsaDeterminizator \
+ PEGFsaEpsilonTransition \
PEGFsaGenerator \
+ PEGFsaPredicateTransition \
+ PEGFsaSequenceDeterminizator \
+ PEGFsaUncopiableState \
PPCAbstractLiteralNode \
PPCAbstractPredicateNode \
PPCAnyNode \
PPCCharacterNode \
PPCCodeGenerator \
PPCDelegateNode \
+ PPCDistinctResultStrategy \
PPCEndOfFileNode \
PPCFSACodeGen \
PPCInlinedMethod \
@@ -99,11 +116,15 @@
PPCPluggableNode \
PPCProfilingContext \
PPCRewritingVisitor \
+ PPCTokenCodeGenerator \
+ PPCTokenizingCodeGen \
PPCTokenizingCompiler \
PPCTokenizingConfiguration \
PPCUniversalConfiguration \
+ PPCUniversalResultStrategy \
PPCUnknownNode \
PPTokenizingCompiledParser \
+ PEGFsaEOFTransition \
PPCAbstractActionNode \
PPCAndNode \
PPCCharSetPredicateNode \
@@ -131,7 +152,6 @@
PPCSequenceNode \
PPCSpecializingVisitor \
PPCStarNode \
- PPCTokenCodeGenerator \
PPCTokenConsumeNode \
PPCTokenDetector \
PPCTokenNode \
@@ -160,16 +180,23 @@
COMMON_OBJS= \
$(OUTDIR_SLASH)PEGFsa.$(O) \
+ $(OUTDIR_SLASH)PEGFsaAbstractDeterminizator.$(O) \
$(OUTDIR_SLASH)PEGFsaFailure.$(O) \
$(OUTDIR_SLASH)PEGFsaInterpret.$(O) \
+ $(OUTDIR_SLASH)PEGFsaInterpretRecord.$(O) \
+ $(OUTDIR_SLASH)PEGFsaMinimizator.$(O) \
$(OUTDIR_SLASH)PEGFsaPair.$(O) \
$(OUTDIR_SLASH)PEGFsaState.$(O) \
+ $(OUTDIR_SLASH)PEGFsaStateInfo.$(O) \
$(OUTDIR_SLASH)PEGFsaTransition.$(O) \
+ $(OUTDIR_SLASH)PPCASTUtilities.$(O) \
$(OUTDIR_SLASH)PPCArguments.$(O) \
$(OUTDIR_SLASH)PPCBridge.$(O) \
$(OUTDIR_SLASH)PPCClassBuilder.$(O) \
$(OUTDIR_SLASH)PPCCodeBlock.$(O) \
$(OUTDIR_SLASH)PPCCodeGen.$(O) \
+ $(OUTDIR_SLASH)PPCCompilationError.$(O) \
+ $(OUTDIR_SLASH)PPCCompilationWarning.$(O) \
$(OUTDIR_SLASH)PPCCompiledMethod.$(O) \
$(OUTDIR_SLASH)PPCCompiler.$(O) \
$(OUTDIR_SLASH)PPCCompilerTokenErrorStrategy.$(O) \
@@ -180,24 +207,34 @@
$(OUTDIR_SLASH)PPCContext.$(O) \
$(OUTDIR_SLASH)PPCContextMemento.$(O) \
$(OUTDIR_SLASH)PPCGuard.$(O) \
+ $(OUTDIR_SLASH)PPCIdGenerator.$(O) \
$(OUTDIR_SLASH)PPCMethod.$(O) \
$(OUTDIR_SLASH)PPCNode.$(O) \
$(OUTDIR_SLASH)PPCNodeVisitor.$(O) \
$(OUTDIR_SLASH)PPCPluggableConfiguration.$(O) \
$(OUTDIR_SLASH)PPCScanner.$(O) \
$(OUTDIR_SLASH)PPCScannerCodeGenerator.$(O) \
+ $(OUTDIR_SLASH)PPCScannerResultStrategy.$(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)PEGFsaCharacterTransition.$(O) \
+ $(OUTDIR_SLASH)PEGFsaChoiceDeterminizator.$(O) \
+ $(OUTDIR_SLASH)PEGFsaDeterminizator.$(O) \
+ $(OUTDIR_SLASH)PEGFsaEpsilonTransition.$(O) \
$(OUTDIR_SLASH)PEGFsaGenerator.$(O) \
+ $(OUTDIR_SLASH)PEGFsaPredicateTransition.$(O) \
+ $(OUTDIR_SLASH)PEGFsaSequenceDeterminizator.$(O) \
+ $(OUTDIR_SLASH)PEGFsaUncopiableState.$(O) \
$(OUTDIR_SLASH)PPCAbstractLiteralNode.$(O) \
$(OUTDIR_SLASH)PPCAbstractPredicateNode.$(O) \
$(OUTDIR_SLASH)PPCAnyNode.$(O) \
$(OUTDIR_SLASH)PPCCharacterNode.$(O) \
$(OUTDIR_SLASH)PPCCodeGenerator.$(O) \
$(OUTDIR_SLASH)PPCDelegateNode.$(O) \
+ $(OUTDIR_SLASH)PPCDistinctResultStrategy.$(O) \
$(OUTDIR_SLASH)PPCEndOfFileNode.$(O) \
$(OUTDIR_SLASH)PPCFSACodeGen.$(O) \
$(OUTDIR_SLASH)PPCInlinedMethod.$(O) \
@@ -207,11 +244,15 @@
$(OUTDIR_SLASH)PPCPluggableNode.$(O) \
$(OUTDIR_SLASH)PPCProfilingContext.$(O) \
$(OUTDIR_SLASH)PPCRewritingVisitor.$(O) \
+ $(OUTDIR_SLASH)PPCTokenCodeGenerator.$(O) \
+ $(OUTDIR_SLASH)PPCTokenizingCodeGen.$(O) \
$(OUTDIR_SLASH)PPCTokenizingCompiler.$(O) \
$(OUTDIR_SLASH)PPCTokenizingConfiguration.$(O) \
$(OUTDIR_SLASH)PPCUniversalConfiguration.$(O) \
+ $(OUTDIR_SLASH)PPCUniversalResultStrategy.$(O) \
$(OUTDIR_SLASH)PPCUnknownNode.$(O) \
$(OUTDIR_SLASH)PPTokenizingCompiledParser.$(O) \
+ $(OUTDIR_SLASH)PEGFsaEOFTransition.$(O) \
$(OUTDIR_SLASH)PPCAbstractActionNode.$(O) \
$(OUTDIR_SLASH)PPCAndNode.$(O) \
$(OUTDIR_SLASH)PPCCharSetPredicateNode.$(O) \
@@ -239,7 +280,6 @@
$(OUTDIR_SLASH)PPCSequenceNode.$(O) \
$(OUTDIR_SLASH)PPCSpecializingVisitor.$(O) \
$(OUTDIR_SLASH)PPCStarNode.$(O) \
- $(OUTDIR_SLASH)PPCTokenCodeGenerator.$(O) \
$(OUTDIR_SLASH)PPCTokenConsumeNode.$(O) \
$(OUTDIR_SLASH)PPCTokenDetector.$(O) \
$(OUTDIR_SLASH)PPCTokenNode.$(O) \
--- a/compiler/PEGFsa.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PEGFsa.st Mon Aug 17 12:13:16 2015 +0100
@@ -9,6 +9,14 @@
category:'PetitCompiler-FSA'
!
+!PEGFsa class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
+! !
+
!PEGFsa methodsFor:'accessing'!
allTransitions
@@ -27,8 +35,15 @@
!
minPriority
- "this is the worst estimate"
- ^ (self states size) negated
+ | priority |
+" defaultPriority := self states size negated.
+ self finalStates isEmpty ifTrue: [ ^ defaultPriority ].
+
+ ^ (self finalStates collect: [ :e | e priorityIfNone: defaultPriority ]) min
+"
+ priority := -1.
+ self allTransitions do: [ :t | t isEpsilon ifTrue: [ priority := priority + t priority ] ].
+ ^ priority
!
name
@@ -40,11 +55,12 @@
name := anObject
!
-prefix
- ^ 'fsa_'
+retvals
+ ^ (self finalStates flatCollect: [ :e | e retvals collect: #value ]) asIdentitySet
!
startState
+ self assert: (states includes: startState).
^ startState
!
@@ -56,8 +72,8 @@
^ states
!
-suffix
- ^ ''
+states: whatever
+ states := whatever
!
transitionFrom: from to: to
@@ -164,7 +180,27 @@
!
finalStates
- ^ self reachableStates select: [ :s | s isFinal ]
+ ^ self states select: [ :s | s isFinal ]
+!
+
+hasDistinctRetvals
+ | finalStates retvals |
+ finalStates := self finalStates.
+
+ (finalStates anySatisfy: [ :s | s isMultivalue ]) ifTrue: [ ^ false ].
+ retvals := finalStates collect: [:s | s retval].
+
+
+ (finalStates size == 1) ifTrue: [ ^ true ].
+
+
+ (retvals asSet size == 1) ifTrue: [ ^ true ].
+ "final states leads only to final states with the same retval"
+ (finalStates allSatisfy: [ :s |
+ (self statesReachableFrom: s) allSatisfy: [ :rs | rs retval value isNil or: [ rs retval value == s retval value ] ]
+ ]) ifTrue: [ ^ true ].
+
+ ^ false
!
is: state furtherThan: anotherState
@@ -176,6 +212,14 @@
^ self backTransitions includes: t
!
+isWithoutPriorities
+ ^ self states allSatisfy: [ :s |
+ s hasPriority not or: [
+ s stateInfos allSatisfy: [ :i | i priority == 0 ]
+ ]
+ ].
+!
+
joinPoints
^ self joinTransitions collect: [ :t | t destination ]
!
@@ -214,7 +258,7 @@
statePairs
| pairs ordered |
pairs := OrderedCollection new.
- ordered := self topologicalOrder.
+ ordered := self states asOrderedCollection.
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))
@@ -258,7 +302,7 @@
= anotherFsa
"
- Please note what the compare does. IMO nothing useful for no.
+ Please note what the compare does. IMO nothing useful for now.
For comparing if two FSA's are equivalent, use isIsomorphicTo:
"
@@ -328,7 +372,7 @@
!PEGFsa methodsFor:'gt'!
gtGraphViewIn: composite
- <gtInspectorPresentationOrder: 41>
+ <gtInspectorPresentationOrder: 0>
composite roassal2
title: 'Graph';
initializeView: [ RTMondrian new ];
@@ -378,6 +422,24 @@
^ b
! !
+!PEGFsa methodsFor:'ids'!
+
+defaultName
+ ^ #fsa
+!
+
+hasName
+ ^ name isNil not
+!
+
+prefix
+ ^ nil
+!
+
+suffix
+ ^ nil
+! !
+
!PEGFsa methodsFor:'initialization'!
initialize
@@ -392,7 +454,16 @@
!
addTransitionFrom: fromState to: toState
- ^ self addTransitionFrom: fromState to: toState priority: 0
+ | transition |
+ self assert: (states includes: fromState).
+ self assert: (states includes: toState).
+
+ transition := PEGFsaEpsilonTransition new
+ destination: toState;
+ priority: 0;
+ yourself.
+
+ fromState addTransition: transition.
!
addTransitionFrom: fromState to: toState on: character
@@ -401,7 +472,7 @@
addTransitionFrom: fromState to: toState on: character priority: priority
| transition |
- transition := PEGFsaTransition new
+ transition := PEGFsaCharacterTransition new
addCharacter: character;
destination: toState;
priority: priority;
@@ -416,7 +487,7 @@
addTransitionFrom: fromState to: toState onCharacterSet: characterSet priority: priority
| transition |
- transition := PEGFsaTransition new
+ transition := PEGFsaCharacterTransition new
characterSet: characterSet;
destination: toState;
priority: priority;
@@ -425,12 +496,29 @@
fromState addTransition: transition
!
+addTransitionFrom: fromState to: toState onPredicate: block
+ self addTransitionFrom: fromState to: toState onPredicate: block priority: 0
+!
+
+addTransitionFrom: fromState to: toState onPredicate: block priority: priority
+ | transition |
+ transition := PEGFsaPredicateTransition new
+ predicate: block;
+ destination: toState;
+ priority: priority;
+ yourself.
+
+ fromState addTransition: transition
+!
+
addTransitionFrom: fromState to: toState priority: priority
| transition |
+ "should not use minus priority epsilons any more"
+ self assert: (priority == 0).
self assert: (states includes: fromState).
self assert: (states includes: toState).
- transition := PEGFsaTransition new
+ transition := PEGFsaEpsilonTransition new
destination: toState;
priority: priority;
yourself.
@@ -442,9 +530,24 @@
states addAll: fsa reachableStates.
!
+decreasePriority
+ ^ self decreasePriorityBy: 1
+!
+
+decreasePriorityBy: value
+ self states select: [ :s | s hasPriority ] thenDo: [ :s |
+ s decreasePriorityBy: value.
+ ].
+
+ self allTransitions do: [ :t |
+ t decreasePriorityBy: value
+ ]
+!
+
finalState: state
self assert: state isFinal not.
state final: true.
+ state priority: 0.
!
fixFinalStatePriorities
@@ -453,6 +556,20 @@
]
!
+minimize
+ ^ PEGFsaMinimizator new minimize: self
+!
+
+removePriorities
+ self states select: [ :s| s hasPriority ] thenDo: [ :s |
+ s priority: 0
+ ].
+
+ self allTransitions do: [ :t |
+ t priority: 0
+ ]
+!
+
removeState: state
self assert: (states includes: state).
states remove: state.
@@ -460,8 +577,8 @@
replace: state with: anotherState
| transitions |
- self assert: (state class == PEGFsaState).
- self assert: (anotherState class == PEGFsaState).
+ self assert: (state isKindOf: PEGFsaState).
+ self assert: (anotherState isKindOf: PEGFsaState).
transitions := self allTransitions.
@@ -470,7 +587,17 @@
t destination: anotherState.
]
].
- states := startState reachableStates.
+
+ state == startState ifTrue: [ startState := anotherState ].
+ states remove: state.
+ states add: anotherState.
+!
+
+retval: returnValue
+ self finalStates do: [ :s |
+ self assert: s retval isNil.
+ s retval: returnValue
+ ]
!
startState: state
@@ -479,6 +606,142 @@
startState := state
! !
+!PEGFsa methodsFor:'modifications - determinization'!
+
+determinize
+ ^ PEGFsaSequenceDeterminizator new determinize: self.
+!
+
+determinize: joinDictionary
+ self error: 'deprecated'.
+
+ self removeEpsilons.
+ self removeUnreachableStates.
+ self removeLowPriorityTransitions.
+ self mergeTransitions.
+
+
+ states := self topologicalOrder asOrderedCollection.
+
+ states do: [ :state |
+ state determinize: joinDictionary.
+ ].
+
+ states := startState reachableStates.
+
+ self removeUnreachableStates.
+ self removeLowPriorityTransitions.
+ self mergeTransitions.
+
+!
+
+determinizeChoice
+ ^ PEGFsaChoiceDeterminizator new determinize: self.
+!
+
+determinizeStandard
+ ^ PEGFsaDeterminizator new determinize: self.
+! !
+
+!PEGFsa methodsFor:'modifications - epsilons'!
+
+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
+ ].
+
+ self assert: transition isEpsilon.
+ self assert: transition priority = 0.
+
+ (destination transitions) do: [ :t |
+ source addTransition: (t copy)
+ ].
+
+ source mergeInfo: destination into: source.
+
+ destination isFinal ifTrue: [
+ source final: true.
+ source retval: destination retval.
+ ].
+
+ source removeTransition: transition.
+!
+
+removeEpsilons
+ "First, remove the negative values from epsilons"
+ self removeNegativeEpsilons.
+
+ states do: [ :state |
+ self removeEpsilonsFor: state
+ ]
+!
+
+removeEpsilonsFor: state
+ (self transitionsFor: state) copy do: [ :t |
+ (t isEpsilon and: [ t destination isStub not ]) ifTrue: [
+ self removeEpsilonTransition: t source: state
+ ]
+ ]
+!
+
+removeNegativeEpsilonTransition: transition source: state
+ ^ self removeNegativeEpsilonTransition: transition source: state openSet: IdentitySet new
+!
+
+removeNegativeEpsilonTransition: 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 removeNegativeEpsilonTransition: t source: destination openSet: openSet
+ ].
+
+ "JK: Problem alert: if two different epsilons point to the same state,
+ it will decreas the state priority two times!! I don't know how to handle
+ this situation properly and I make sure during FSA generation that there
+ are no two paths to one state (except for loops).
+ "
+ (self statesReachableFrom: destination) do: [ :s |
+ s decreasePriorityBy: transition priority abs.
+ s transitions do: [ :t | t decreasePriorityBy: transition priority abs ]
+ ].
+
+ transition priority: 0.
+!
+
+removeNegativeEpsilons
+ "
+ This will remove only negative values from epsilons, the epsilons itself will not
+ be removed!!
+ "
+ states do: [ :state |
+ self removeNegativeEpsilonsFor: state
+ ]
+!
+
+removeNegativeEpsilonsFor: state
+ (self transitionsFor: state) copy do: [ :t |
+ t isEpsilon ifTrue: [
+ self removeNegativeEpsilonTransition: t source: state
+ ]
+ ]
+! !
+
!PEGFsa methodsFor:'printing'!
asString
@@ -525,6 +788,7 @@
checkSanity
self checkConsistency.
self checkTransitionsIdentity.
+ self checkTransitionsPriority.
self checkFinalStatesPriorities.
!
@@ -538,6 +802,14 @@
self assert: bag size == set size.
!
+checkTransitionsPriority
+ self finalStates do: [ :fs |
+ fs isMultivalue ifFalse: [
+ fs transitions allSatisfy: [ :t | fs priority >= t priority ]
+ ]
+ ]
+!
+
isDeterministic
self reachableStates do: [ :state |
state transitionPairs do: [ :pair |
@@ -569,115 +841,13 @@
!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.
-
+ self error: 'deprecated?'
!
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
- ]
+ state mergeTransitions.
]
!
@@ -688,10 +858,14 @@
!
removeLowPriorityTransitionsFor: state
+ | transitions |
state hasPriority ifFalse: [ ^ self ].
state isFinal ifFalse: [ ^ self ].
-
- state transitions do: [ :t |
+ "TODO JK: I can probably cut some transitions from multivalu as well"
+ state isMultivalue ifTrue: [ ^ self ].
+
+ transitions := state transitions copy.
+ transitions do: [ :t |
(t priority < state priority) ifTrue: [
state removeTransition: t
]
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaAbstractDeterminizator.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,163 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PEGFsaAbstractDeterminizator
+ instanceVariableNames:'fsa joinDictionary'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-FSA'
+!
+
+!PEGFsaAbstractDeterminizator class methodsFor:'as yet unclassified'!
+
+new
+ ^ self basicNew initialize
+! !
+
+!PEGFsaAbstractDeterminizator methodsFor:'accessing - keys'!
+
+joinKey: key with: anotherKey
+ ^ Set new
+ addAll: key;
+ addAll: anotherKey;
+ yourself.
+!
+
+keyFor: state
+ ^ joinDictionary keyAtIdentityValue: state ifAbsent: [ Set with: state ]
+!
+
+keyFor: state and: anotherState
+ | key anotherKey |
+ key := self keyFor: state.
+ anotherKey := self keyFor: anotherState.
+
+ ^ self joinKey: key with: anotherKey
+! !
+
+!PEGFsaAbstractDeterminizator methodsFor:'determinization'!
+
+determinize
+ | states |
+" fsa checkSanity."
+ fsa removeEpsilons.
+ fsa removeUnreachableStates.
+ fsa mergeTransitions.
+
+ states := fsa topologicalOrder asOrderedCollection.
+ states do: [ :state |
+ self determinizeState: state
+ ].
+
+ fsa states: fsa startState reachableStates.
+
+ fsa removeUnreachableStates.
+ fsa mergeTransitions.
+!
+
+determinize: anFsa
+ fsa := anFsa.
+ joinDictionary := Dictionary new.
+
+ self determinize.
+ ^ fsa
+!
+
+determinizeOverlap: t1 second: t2 state: state
+ | t1Prime t2Prime tIntersection |
+ self assert: (state transitions includes: t1).
+ self assert: (state transitions includes: t2).
+
+ tIntersection := self joinTransition: t1 with: t2.
+
+ t1Prime := PEGFsaCharacterTransition new
+ destination: t1 destination;
+ characterSet: (t1 complement: t2);
+ yourself.
+ t2Prime := PEGFsaCharacterTransition new
+ destination: t2 destination;
+ characterSet: (t2 complement: t1);
+ yourself.
+
+
+ state removeTransition: t1.
+ state removeTransition: t2.
+
+ tIntersection isEmpty ifFalse: [ state addTransition: tIntersection ].
+ t1Prime isEmpty ifFalse: [ state addTransition: t1Prime ].
+ t2Prime isEmpty ifFalse: [ state addTransition: t2Prime ].
+!
+
+determinizeState: state
+ | pairs |
+
+ pairs := state transitionPairs asOrderedCollection.
+
+ [pairs isEmpty] whileFalse: [
+ | pair |
+
+ (joinDictionary size > 100) ifTrue: [ self error: 'Oh man, this is really big FSA. Are you sure you want to continue?' ].
+
+ pair := pairs removeFirst.
+ self assert:((pair first destination = pair second destination) not
+ or: [pair first isPredicateTransition not
+ or: [pair second isPredicateTransition not ] ]).
+
+ self assert: (pair contains: #isEpsilon) not.
+
+ (pair first overlapsWith: pair second) ifTrue: [
+ self determinizeOverlap: pair first second: pair second state: state.
+ "recompute pairs after the determinization"
+ pairs := state transitionPairs asOrderedCollection.
+ ]
+ ].
+! !
+
+!PEGFsaAbstractDeterminizator methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ joinDictionary := Dictionary new
+! !
+
+!PEGFsaAbstractDeterminizator methodsFor:'joining'!
+
+joinName: state with: anotherState into: newState
+ newState name: state name asString, '_', anotherState name asString.
+!
+
+joinState: state with: anotherState
+ | key newState |
+ key := self keyFor: state and: anotherState.
+ (joinDictionary includesKey: key) ifTrue: [ ^ joinDictionary at: key ].
+
+ newState := PEGFsaState new.
+ joinDictionary at: key put: newState.
+
+ self joinRetval: state with: anotherState into: newState.
+ self joinInfo: state with: anotherState into: newState.
+ self joinName: state with: anotherState into: newState.
+ self joinTransitions: state with: anotherState into: newState.
+
+ self determinizeState: newState.
+
+ self assert: ((joinDictionary at: key) == newState).
+ ^ newState
+!
+
+joinTransition: t1 with: t2
+ | newDestination newTransition |
+ self assert: t1 isCharacterTransition.
+ self assert: t2 isCharacterTransition.
+
+ newDestination := self joinState: t1 destination with: t2 destination.
+
+ newTransition := PEGFsaCharacterTransition new.
+ newTransition destination: newDestination.
+ newTransition characterSet: (t1 intersection: t2).
+ newTransition priority: (t1 priority max: t2 priority).
+
+ ^ newTransition
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaCharacterTransition.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,326 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PEGFsaTransition subclass:#PEGFsaCharacterTransition
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-FSA'
+!
+
+!PEGFsaCharacterTransition methodsFor:'accessing'!
+
+acceptsCodePoint: codePoint
+ self assert: codePoint isInteger.
+ (codePoint < 1) ifTrue: [ ^ false ].
+ ^ characterSet at: codePoint
+!
+
+beginOfRange
+ characterSet withIndexDo: [ :e :index |
+ e ifTrue: [ ^ index ]
+ ].
+ self error: 'should not happend'
+!
+
+character
+ self assert: (self isSingleCharacter).
+ characterSet withIndexDo: [ :e :index | e ifTrue: [ ^ Character codePoint: index ] ].
+ self error: 'should not happen'.
+!
+
+characterSet
+ ^ characterSet
+!
+
+characterSet: anObject
+ characterSet := anObject
+!
+
+endOfRange
+ | change |
+ change := false.
+ characterSet withIndexDo: [ :e :index |
+ e ifTrue: [ change := true ].
+ (e not and: [ change ]) ifTrue: [ ^ index - 1]
+ ].
+ ^ characterSet size
+!
+
+notCharacter
+ self assert: self isNotSingleCharacter.
+ characterSet withIndexDo: [ :value :index | value ifFalse: [ ^ Character codePoint: index ] ].
+ ^ self error: 'should not happen'
+! !
+
+!PEGFsaCharacterTransition 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 :)
+ "
+ super = anotherTransition ifFalse: [ ^ false ].
+ (characterSet = anotherTransition characterSet) ifFalse: [ ^ false ].
+
+ ^ true
+!
+
+canBeIsomorphicTo: anotherTransition
+ (super canBeIsomorphicTo: anotherTransition) ifFalse: [ ^ false ].
+ (characterSet = anotherTransition characterSet) ifFalse: [ ^ false ].
+
+ ^ true
+!
+
+equals: anotherTransition
+ (super equals: anotherTransition) ifFalse: [ ^ false ].
+ (characterSet = anotherTransition characterSet) ifFalse: [ ^ false ].
+
+ "JK: If character set and destination are the same, priority does not really matter"
+ ^ true
+!
+
+hash
+ ^ super hash bitXor: characterSet hash
+! !
+
+!PEGFsaCharacterTransition methodsFor:'copying'!
+
+postCopy
+ super postCopy.
+ characterSet := characterSet copy.
+! !
+
+!PEGFsaCharacterTransition methodsFor:'gt'!
+
+gtName
+ | gtName |
+ gtName := self characterSetAsString.
+ priority < 0 ifTrue: [ gtName := gtName, ',', priority asString ].
+ ^ gtName
+! !
+
+!PEGFsaCharacterTransition methodsFor:'initialization'!
+
+initialize
+ super initialize.
+
+ characterSet := Array new: 255 withAll: false.
+! !
+
+!PEGFsaCharacterTransition methodsFor:'modifications'!
+
+addCharacter: character
+ characterSet at: character codePoint put: true
+! !
+
+!PEGFsaCharacterTransition methodsFor:'printing'!
+
+characterSetAsString
+ | stream |
+ stream := WriteStream on: ''.
+ self printCharacterSetOn: stream.
+ ^ stream contents
+!
+
+printCharacterSetOn: stream
+ (self isLetter) ifTrue: [
+ stream nextPutAll: '#letter'.
+ ^ self
+ ].
+
+ (self isWord) ifTrue: [
+ stream nextPutAll: '#word'.
+ ^ self
+ ].
+
+
+ stream nextPut: $[.
+ 32 to: 126 do: [ :index |
+ (characterSet at: index) ifTrue: [
+ ((Character codePoint: index) == $") ifTrue: [
+ stream nextPutAll: '""'.
+ ] ifFalse: [
+ 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: ')'.
+! !
+
+!PEGFsaCharacterTransition 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.
+
+ transition isPredicateTransition ifTrue: [ ^ intersection ].
+ transition isEpsilonTransition ifTrue: [ self error: 'Dont know!!' ].
+
+ 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
+! !
+
+!PEGFsaCharacterTransition methodsFor:'testing'!
+
+accepts: character
+ self assert: character isCharacter.
+ ^ self acceptsCodePoint: character codePoint
+!
+
+isAny
+ ^ characterSet allSatisfy: [ :e | e ]
+!
+
+isCharacterTransition
+ ^ true
+!
+
+isDigit
+ characterSet withIndexDo: [ :value :index |
+ (Character codePoint: index) isDigit == value ifFalse: [ ^ false ]
+ ].
+ ^ true
+!
+
+isEmpty
+ ^ characterSet allSatisfy: [ :e | e not ]
+!
+
+isEpsilon
+ ^ false
+!
+
+isLetter
+ characterSet withIndexDo: [ :value :index |
+ (Character codePoint: index) isLetter == value ifFalse: [ ^ false ]
+ ].
+ ^ true
+!
+
+isNotSingleCharacter
+ ^ (characterSet select: [ :e | e not ]) size == 1
+!
+
+isSingleCharacter
+ ^ (characterSet select: [ :e | e ]) size == 1
+!
+
+isSingleRange
+ | changes previous |
+ changes := 0.
+ previous := false.
+ characterSet do: [ :e |
+ (e == previous) ifFalse: [ changes := changes + 1 ].
+ previous := e.
+ ].
+ ^ changes < 3
+!
+
+isWord
+ characterSet withIndexDo: [ :value :index |
+ (Character codePoint: index) isAlphaNumeric == value ifFalse: [ ^ false ]
+ ].
+ ^ true
+!
+
+overlapsWith: transition
+ transition isCharacterTransition ifFalse: [ ^ false ].
+ self isEpsilon ifTrue: [ ^ true ].
+ transition isEpsilon ifTrue: [ ^ true ].
+
+ ^ (self intersection: transition) anySatisfy: [ :bool | bool ]
+! !
+
+!PEGFsaCharacterTransition 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 := PEGFsaCharacterTransition 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
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaChoiceDeterminizator.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,79 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PEGFsaAbstractDeterminizator subclass:#PEGFsaChoiceDeterminizator
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-FSA'
+!
+
+!PEGFsaChoiceDeterminizator methodsFor:'as yet unclassified'!
+
+determinize
+ super determinize.
+
+ fsa removeLowPriorityTransitions.
+ fsa removeUnreachableStates.
+ fsa removePriorities.
+!
+
+joinInfo: info with: anotherInfo into: newInfo
+ "Merging into the failure"
+ (info isFsaFailure and: [anotherInfo isFsaFailure not]) ifTrue: [
+ newInfo final: anotherInfo isFinal.
+ newInfo priority: anotherInfo priority.
+ newInfo failure: false.
+ ^ self
+ ].
+
+ (anotherInfo isFsaFailure and: [info isFsaFailure not]) ifTrue: [
+ newInfo final: info isFinal.
+ newInfo priority: (anotherInfo priority max: info priority).
+ newInfo failure: false.
+ ^ self
+ ].
+
+ (info hasEqualPriorityTo: anotherInfo) ifTrue: [
+ newInfo final: (info isFinal or: [ anotherInfo isFinal ]).
+ newInfo failure: (info isFsaFailure or: [anotherInfo isFailure]).
+ newInfo priority: info priority.
+ ^ self
+ ].
+
+ (info hasHigherPriorityThan: anotherInfo) ifTrue: [
+ newInfo priority: info priority.
+ newInfo failure: info isFsaFailure.
+ newInfo final: info isFinal.
+ ^ self
+ ].
+
+ newInfo priority: anotherInfo priority.
+ newInfo failure: anotherInfo isFsaFailure.
+ newInfo final: anotherInfo isFinal.
+!
+
+joinState: state with: anotherState
+ self assert: state isMultivalue not.
+ self assert: anotherState isMultivalue not.
+
+ ^ super joinState: state with: anotherState
+!
+
+joinTransitions: state with: anotherState into: newState
+ self assert: newState isMultivalue not.
+
+ newState transitions addAll: (state transitions collect: #copy).
+ newState transitions addAll: (anotherState transitions collect: #copy).
+ newState mergeTransitions.
+! !
+
+!PEGFsaChoiceDeterminizator methodsFor:'joining'!
+
+joinRetval: state with: anotherState into: newState
+ "Different retvals cannot merge their info"
+ self assert: (state hasDifferentRetvalThan: anotherState) not.
+ self assert: state retval == anotherState retval.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaDeterminizator.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,61 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PEGFsaAbstractDeterminizator subclass:#PEGFsaDeterminizator
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-FSA'
+!
+
+!PEGFsaDeterminizator methodsFor:'checking'!
+
+checkPriorities
+ self assert: ((fsa states select: [ :s | s hasPriority ]) allSatisfy: [ :s | s priority == 0 ]).
+ self assert: (fsa allTransitions allSatisfy: [ :s | s priority == 0 ]).
+! !
+
+!PEGFsaDeterminizator methodsFor:'determinization'!
+
+determinize
+ self checkPriorities.
+ super determinize.
+! !
+
+!PEGFsaDeterminizator methodsFor:'joining'!
+
+joinInfo: info with: anotherInfo into: newInfo
+ "nothing to do"
+!
+
+joinRetval: state with: anotherState into: newState
+ "Different retvals cannot merge their info"
+
+ state retvalsAndInfosDo: [:retval :info |
+ retval isNil ifFalse: [
+ newState addInfo: info for: retval.
+ ]
+ ].
+
+ anotherState retvalsAndInfosDo: [:retval :info |
+ retval isNil ifFalse: [
+ self assert: (newState retvals includes: retval) not.
+ newState addInfo: info for: retval.
+ ]
+ ].
+!
+
+joinState: state with: anotherState
+ self assert: state hasZeroPriorityOnly.
+ self assert: anotherState hasZeroPriorityOnly.
+
+ ^ super joinState: state with: anotherState
+!
+
+joinTransitions: state with: anotherState into: newState
+ newState transitions addAll: (state transitions collect: #copy).
+ newState transitions addAll: (anotherState transitions collect: #copy).
+ ^ self
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaEOFTransition.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,17 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PEGFsaPredicateTransition subclass:#PEGFsaEOFTransition
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-FSA'
+!
+
+!PEGFsaEOFTransition methodsFor:'as yet unclassified'!
+
+isEOF
+ ^ true
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaEpsilonTransition.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,49 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PEGFsaTransition subclass:#PEGFsaEpsilonTransition
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-FSA'
+!
+
+!PEGFsaEpsilonTransition methodsFor:'gt'!
+
+gtName
+ | gtName |
+ gtName := '<eps>'.
+ priority < 0 ifTrue: [ gtName := gtName, ',', priority asString ].
+ ^ gtName
+! !
+
+!PEGFsaEpsilonTransition methodsFor:'modifications'!
+
+decreasePriorityBy: value
+ "
+ My value has special semantics, when I have negative priority, all the reachable states and transitions should
+ be decreased by that value.
+
+ In case I am preceded by another epsilon with negative priority, I do not decrease my value, that would multiply
+ the the negative priority effect....
+ "
+ ^ self
+! !
+
+!PEGFsaEpsilonTransition methodsFor:'set operations'!
+
+intersection: anotherState
+ ^ anotherState
+! !
+
+!PEGFsaEpsilonTransition methodsFor:'testing'!
+
+isEpsilon
+ ^ true
+!
+
+isEpsilonTransition
+ ^ true
+! !
+
--- a/compiler/PEGFsaFailure.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PEGFsaFailure.st Mon Aug 17 12:13:16 2015 +0100
@@ -3,9 +3,66 @@
"{ NameSpace: Smalltalk }"
Object subclass:#PEGFsaFailure
- instanceVariableNames:'message'
+ instanceVariableNames:'retval'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-FSA'
!
+PEGFsaFailure class instanceVariableNames:'Instance'
+
+"
+ No other class instance variables are inherited by this class.
+"
+!
+
+!PEGFsaFailure class methodsFor:'as yet unclassified'!
+
+on: retval
+ ^ (self new)
+ retval: retval;
+ yourself
+! !
+
+!PEGFsaFailure methodsFor:'accessing'!
+
+retval
+ ^ retval
+!
+
+retval: anObject
+ retval := anObject
+!
+
+value
+ ^ retval
+! !
+
+!PEGFsaFailure methodsFor:'comparing'!
+
+= anotherFailure
+ (self == anotherFailure) ifTrue: [ ^ true ].
+ self class == anotherFailure class ifFalse: [ ^ false ].
+
+ ^ (self retval == anotherFailure retval)
+!
+
+hash
+ ^ self retval hash
+! !
+
+!PEGFsaFailure methodsFor:'printing'!
+
+printOn: aStream
+ super printOn: aStream.
+ aStream nextPut: $(.
+ retval printOn: aStream.
+ aStream nextPut: $).
+! !
+
+!PEGFsaFailure methodsFor:'testing'!
+
+isFsaFailure
+ ^ true
+! !
+
--- a/compiler/PEGFsaGenerator.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PEGFsaGenerator.st Mon Aug 17 12:13:16 2015 +0100
@@ -9,7 +9,114 @@
category:'PetitCompiler-FSA'
!
-!PEGFsaGenerator methodsFor:'as yet unclassified'!
+!PEGFsaGenerator methodsFor:'hooks'!
+
+afterAccept: node retval: retval
+ retval checkSanity.
+ ^ super afterAccept: node retval: retval
+!
+
+cache: node value: retval
+ (self assert: (retval isKindOf: PEGFsa)).
+
+ (cache includesKey: node) ifTrue: [
+ self assert: (retval isIsomorphicTo: (cache at: node)).
+ ].
+
+ "I put copy of the FSA because FSA can be modified (e.g. concatenated to other FSA)"
+ cache at: node put: retval copy.
+!
+
+openDetected: node
+ "
+ This should be called when there is a recursive definition of a token.
+ The forward node caches the fsa stub with startState in order to reference it
+ "
+ ^ (self cachedValue: node)
+! !
+
+!PEGFsaGenerator methodsFor:'support'!
+
+connect: fsa with: anotherFsa
+ | finals |
+ finals := fsa finalStates reject: [:s | s isFsaFailure ].
+
+ self assert: (finals allSatisfy: [ :s | s priority = 0 ]).
+ self assert: (finals allSatisfy: [:f | fsa states includes: f]).
+
+ finals do: [ :final |
+ | toAdopt |
+ toAdopt := anotherFsa.
+ toAdopt decreasePriority.
+ final final: false.
+
+ fsa adopt: toAdopt.
+ fsa addTransitionFrom: final to: toAdopt startState.
+ ].
+!
+
+connectOverlapping: fsa with: anotherFsa
+ | finals |
+ finals := fsa finalStates reject: [:s | s isFsaFailure ].
+
+ self assert: (finals allSatisfy: [ :s | s priority = 0 ]).
+ self assert: (finals allSatisfy: [:f | fsa states includes: f]).
+
+ finals do: [ :final |
+ | toAdopt |
+ toAdopt := anotherFsa copy.
+ toAdopt decreasePriority.
+ final final: false.
+
+ fsa adopt: toAdopt.
+ fsa addTransitionFrom: final to: toAdopt startState.
+ ].
+!
+
+sequenceOf: fsa and: anotherFsa
+ | newFsa start |
+
+ newFsa := PEGFsa new.
+ start := PEGFsaState new name: 'start'; yourself.
+ newFsa addState: start.
+ newFsa startState: start.
+ newFsa adopt: fsa.
+ newFsa addTransitionFrom: start to: fsa startState.
+
+ (newFsa finalStates size == 1) ifTrue: [
+ self connect: newFsa with: anotherFsa.
+ ] ifFalse: [
+ (newFsa finalStates allSatisfy: [ :s | s transitions isEmpty ]) ifTrue: [
+ self connect: newFsa with: anotherFsa.
+ ] ifFalse: [
+ self connectOverlapping: newFsa with: anotherFsa.
+ ]].
+
+ newFsa determinize.
+ ^ newFsa
+! !
+
+!PEGFsaGenerator methodsFor:'visiting'!
+
+visitAnyNode: node
+ | stop start fsa classification |
+ start := PEGFsaState new.
+ stop := PEGFsaState new.
+
+ classification := Array new: 255 withAll: true.
+
+ fsa := PEGFsa new
+ addState: start;
+ addState: stop;
+
+ startState: start;
+ finalState: stop;
+ yourself.
+
+ fsa addTransitionFrom: start to: stop onCharacterSet: (classification).
+
+ ^ fsa
+!
visitCharSetPredicateNode: node
| stop start fsa |
@@ -48,8 +155,9 @@
visitChoiceNode: node
| priority childrenFsa fsa start |
-
childrenFsa := node children collect: [ :child | child accept: self ].
+ self assert: (childrenFsa allSatisfy: [ :child | child isDeterministic ]).
+
fsa := PEGFsa new.
start := PEGFsaState new.
@@ -58,14 +166,72 @@
priority := 0.
childrenFsa do: [ :childFsa |
+ childFsa decreasePriorityBy: priority.
fsa adopt: childFsa.
- fsa addTransitionFrom: start to: childFsa startState priority: priority.
- priority := priority + childFsa minPriority.
+ fsa addTransitionFrom: start to: childFsa startState.
+ priority := priority + 1.
+
+ fsa determinizeChoice.
].
^ fsa
!
+visitEndOfFileNode: node
+ | stop start fsa transition |
+ start := PEGFsaState new.
+ stop := PEGFsaState new.
+ stop name: 'EOF'.
+
+ fsa := PEGFsa new
+ addState: start;
+ addState: stop;
+
+ startState: start;
+ finalState: stop;
+
+ yourself.
+
+ transition := PEGFsaEOFTransition new
+ predicate: [ :cp | cp == 0 ];
+ destination: stop;
+ yourself.
+
+ start addTransition: transition.
+ ^ fsa
+!
+
+visitForwardNode: node
+ | fsa childFsa startState startStubState |
+
+ fsa := PEGFsa new.
+ startStubState := PEGFsaUncopiableState new.
+ startState := PEGFsaState new.
+
+ fsa addState: startStubState.
+ fsa startState: startStubState.
+
+
+ " cache the incomplete fsa in order to allow for
+ recursive back references...
+ "
+ self cache: node value: fsa.
+
+ childFsa := self visit: node child.
+
+ cache removeKey: node.
+
+ fsa adopt: childFsa.
+ fsa replace: startStubState with: startState.
+
+
+ fsa addTransitionFrom: startState to: childFsa startState.
+ fsa startState: startState.
+
+ fsa name: self name.
+ ^ fsa
+!
+
visitLiteralNode: node
| states fsa |
@@ -92,10 +258,20 @@
^ fsa
!
+visitMessagePredicateNode: node
+ ^ self visitPredicateNode: node
+!
+
visitNode: node
self error: 'node not supported'
!
+visitNotCharacterNode: node
+ self assert: (node child isKindOf: PPCCharacterNode).
+
+ ^ self visitNotNode: node
+!
+
visitNotNode: node
| fsa finalState |
fsa := node child accept: self.
@@ -104,63 +280,49 @@
yourself.
fsa finalStates do: [ :fs |
- fs retval: PEGFsaFailure new.
+ fs failure: true.
].
- fsa addState: finalState.
- fsa finalState: finalState.
-
- fsa addTransitionFrom: fsa startState to: finalState priority: -1.
+ fsa finalState: fsa startState.
+
^ fsa
!
visitOptionalNode: node
- | fsa startState finalState |
+ | fsa |
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 finalState: fsa startState.
^ fsa
!
visitPlusNode: node
- | fsa finalState |
+ | fsa |
- finalState := PEGFsaState new.
+" finalState := PEGFsaState new."
fsa := node child accept: self.
- fsa addState: finalState.
+" 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.
+" fsa addTransitionFrom: state to: finalState priority: fsa minPriority."
+" state hasPriority ifFalse: [ state priority: 0 ].
state final: false.
- ].
+" ].
- fsa finalState: finalState.
+" fsa finalState: finalState. "
^ fsa
!
visitPredicateNode: node
- | stop start fsa |
+ | stop start fsa classification |
start := PEGFsaState new.
stop := PEGFsaState new.
+ classification := (1 to: 255) collect: [:codePoint | node predicate value: (Character codePoint: codePoint) ].
+
fsa := PEGFsa new
addState: start;
addState: stop;
@@ -169,61 +331,55 @@
finalState: stop;
yourself.
- fsa addTransitionFrom: start to: stop onCharacterSet: (node predicate classification).
-
+ fsa addTransitionFrom: start to: stop onCharacterSet: (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.
+ | fsa childrenFsa previousFsa |
+ childrenFsa := node children collect: [ :child | self visit: child ].
+ self assert: (childrenFsa allSatisfy: [ :child | child isDeterministic ]).
- 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.
+ previousFsa := childrenFsa first.
+ childrenFsa allButFirst do: [ :nextFsa |
+ fsa := self sequenceOf: previousFsa and: nextFsa.
+ previousFsa := fsa.
].
+
^ fsa
!
visitStarNode: node
- | fsa finalState |
+ | fsa |
- finalState := PEGFsaState new.
- fsa := node child accept: self.
- fsa addState: 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 hasPriority ifFalse: [ state priority: 0 ].
state final: false.
- ].
+" ].
- fsa addTransitionFrom: fsa startState to: finalState priority: -1.
- fsa finalState: finalState.
+" fsa addTransitionFrom: fsa startState to: finalState priority: -1."
+ fsa finalState: fsa startState.
^ fsa
+!
+
+visitTokenNode: node
+ ^ self visit: node child
+!
+
+visitTrimmingTokenCharacterNode: node
+ "I do not care about trimming (so far), it should be handled by TokenCodeGenerator"
+ ^ self visit: node child
+!
+
+visitTrimmingTokenNode: node
+ "I do not care about trimming (so far), it should be handled by TokenCodeGenerator"
+ ^ self visit: node child
! !
--- a/compiler/PEGFsaInterpret.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PEGFsaInterpret.st Mon Aug 17 12:13:16 2015 +0100
@@ -3,12 +3,20 @@
"{ NameSpace: Smalltalk }"
Object subclass:#PEGFsaInterpret
- instanceVariableNames:'fsa debug retvals stream maxPriority'
+ instanceVariableNames:'fsa debug retvals stream'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-FSA'
!
+!PEGFsaInterpret class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
+! !
+
!PEGFsaInterpret methodsFor:'accessing'!
debug
@@ -21,6 +29,10 @@
fsa
^ fsa
+!
+
+recordFor: retval
+ ^ retvals at: retval ifAbsentPut: [ PEGFsaInterpretRecord new ]
! !
!PEGFsaInterpret methodsFor:'debugging'!
@@ -54,7 +66,6 @@
interpret
| states newStates character run |
- maxPriority := SmallInteger minVal.
newStates := IdentitySet with: fsa startState.
retvals := IdentityDictionary new.
@@ -63,12 +74,12 @@
self reportStart.
self reportFsa: fsa.
- run := stream atEnd not.
+ run := "stream atEnd not" true.
[run] whileTrue: [
states := newStates.
newStates := IdentitySet new.
- character := stream peek.
+ character := stream peek codePoint.
self reportStates: states.
@@ -77,10 +88,9 @@
].
newStates isEmpty ifFalse: [ stream next ].
- run := stream atEnd not and: [ newStates isEmpty not ].
+ run := "stream atEnd not and: [ "newStates isEmpty not" ]".
].
-
- ^ self return: newStates
+ ^ self return: states
!
interpret: anFsa on: aStream
@@ -104,36 +114,24 @@
^ 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.
- ].
+expand: state on: codePoint into: newStates
+ state transitions do: [ :t |
+ 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.
- ]
- ]
- ]
+ "Descent into the next state"
+ self expand: t destination
+ on: codePoint
+ into: newStates.
+ ] ifFalse: [
+ (t acceptsCodePoint: codePoint) ifTrue: [
+ newStates add: t destination.
+ self recordNewState: t destination.
+ ]
+ ]
]
!
@@ -142,35 +140,38 @@
!
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.
+ | currentRecord |
+ (state isFinal) ifFalse: [
+ ^ self
].
+ (state isFinal) ifFalse: [ self error: 'should not happen' ].
+ self assert: state hasPriority description: 'final state must have priority'.
- state retvalAsCollection do: [ :r |
- retvals at: r put: position
+ state retvalsAndInfosDo: [ :retval :info |
+ currentRecord := self recordFor: retval.
+ info isFsaFailure ifTrue: [
+ "JK: hack, nil refers to failure!! :( Refactor!!"
+ currentRecord position: nil
+ ] ifFalse: [
+ currentRecord position: position
+ ]
].
!
return: states
- | priority priorities |
- priorities := (states select: #hasPriority thenCollect: #priority).
- priorities isEmpty ifTrue: [
- ^ retvals keysAndValuesRemove: [ :key :value | key class == PEGFsaFailure ]
+ | return |
+ return := IdentityDictionary new.
+ retvals keysAndValuesRemove: [ :key :record | record position isNil ].
+
+ retvals keysAndValuesDo: [ :key :value |
+ return at: key put: value position
].
-
- priority := priorities max.
-
- (maxPriority < priority) ifTrue: [ ^ IdentityDictionary new ].
- ^ retvals keysAndValuesRemove: [ :key :value | key class == PEGFsaFailure ]
+ ^ return
!
sortedTransitionsFor: state
+ self error: 'deprecated!!'.
^ (fsa transitionsFor: state) asOrderedCollection
"Dear future me, enjoy this:"
" sort: [ :e1 :e2 | (e1 isEpsilon not and: [e2 isEpsilon]) not ])"
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaInterpretRecord.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,36 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PEGFsaInterpretRecord
+ instanceVariableNames:'maxPriority position'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-FSA'
+!
+
+!PEGFsaInterpretRecord methodsFor:'accessing'!
+
+maxPriority
+ ^ maxPriority
+!
+
+maxPriority: anObject
+ maxPriority := anObject
+!
+
+position
+ ^ position
+!
+
+position: anObject
+ position := anObject
+! !
+
+!PEGFsaInterpretRecord methodsFor:'initialize'!
+
+initialize
+ super initialize.
+ maxPriority := SmallInteger minVal.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaMinimizator.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,105 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PEGFsaMinimizator
+ instanceVariableNames:'fsa joinDictionary'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-FSA'
+!
+
+!PEGFsaMinimizator methodsFor:'comparison'!
+
+info: info equals: anotherInfo
+ (info == anotherInfo) ifTrue: [ ^ true ].
+ (info class == anotherInfo class) ifFalse: [ ^ false ].
+
+ "
+ I suppose I don't if someone does not have the priority set.
+ Please note that equals is used for minimization, so I try to
+ be as liberal as possible to get as small automaton as possible.
+ "
+ (info hasPriority and: [anotherInfo hasPriority]) ifTrue: [
+ (info priority == anotherInfo priority) ifFalse: [ ^ false ].
+ ].
+
+ (info isFinal == anotherInfo isFinal) ifFalse: [ ^ false ].
+ (info isFsaFailure == anotherInfo isFsaFailure) ifFalse: [ ^ false ].
+
+ ^ true
+!
+
+state: state equals: anotherState
+ (state == anotherState) ifTrue: [ ^ true ].
+ (state class == anotherState class) ifFalse: [ ^ false ].
+
+ (state isFinal = anotherState isFinal) ifFalse: [ ^ false ].
+
+ (state stateInfos size == anotherState stateInfos size) ifFalse: [ ^ false ].
+ state retvals do: [:retval |
+ (self info: (state infoFor: retval) equals: (anotherState infoFor: retval ifAbsent: [ ^ false ])) ifFalse: [ ^ false ]
+ ].
+
+
+ (state transitions size == anotherState transitions size) ifFalse: [ ^ false ].
+ anotherState transitions do: [ :anotherStateT |
+ (state transitions contains: [ :stateT |
+ (anotherStateT equals: stateT) or: [
+ "this is condition for self reference"
+ (anotherStateT destination == anotherState) and: [ stateT destination == state ]
+ ] ] ) ifFalse: [ ^ false ]
+ ].
+
+ ^ true
+! !
+
+!PEGFsaMinimizator methodsFor:'joining'!
+
+joinInfo: state with: anotherState
+ self assert: state stateInfos size == anotherState stateInfos size.
+
+ state stateInfos do: [ :si1 |
+ self assert: (anotherState stateInfos contains: [ :si2 |
+ si1 isFinal == si2 isFinal and: [ si1 isFsaFailure == si2 isFsaFailure ]
+ ])
+ ]
+!
+
+joinName: state with: anotherState
+ state name: state name asString, '+', anotherState name asString.
+!
+
+joinState: state with: anotherState
+ self assert: state hasZeroPriorityOnly.
+ self assert: anotherState hasZeroPriorityOnly.
+
+ self joinName: state with: anotherState.
+ self joinInfo: state with: anotherState.
+
+! !
+
+!PEGFsaMinimizator methodsFor:'minimization'!
+
+minimize
+ | pair |
+ pair := fsa statePairs detect: [ :p | self state: p first equals: p second ] ifNone: [ nil ].
+
+ [ pair isNil not ] whileTrue: [
+ "Join priorities, because equivalency of priorities does not follow from the `equals:` of states"
+ self joinState: pair first with: pair second.
+ fsa replace: pair second with: pair first.
+ fsa mergeTransitions.
+
+ pair := fsa statePairs detect: [ :p | self state: p first equals: p second ] ifNone: [ nil ].
+ ].
+!
+
+minimize: anFsa
+ fsa := anFsa.
+
+ self minimize.
+ fsa checkSanity.
+ ^ fsa
+! !
+
--- a/compiler/PEGFsaPair.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PEGFsaPair.st Mon Aug 17 12:13:16 2015 +0100
@@ -52,3 +52,22 @@
^ first hash bitXor: second hash
! !
+!PEGFsaPair methodsFor:'enumerating'!
+
+detect: block
+ (block value: self first) ifTrue: [ ^ self first ].
+ (block value: self second) ifTrue: [ ^ self second ].
+
+ self error: 'not found!!'
+! !
+
+!PEGFsaPair methodsFor:'testing'!
+
+contains: block
+ ^ (block value: self first) or: [ block value: self second ]
+!
+
+includes: anObject
+ ^ self first == anObject or: [ self second == anObject ]
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaPredicateTransition.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,75 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PEGFsaTransition subclass:#PEGFsaPredicateTransition
+ instanceVariableNames:'predicate'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-FSA'
+!
+
+!PEGFsaPredicateTransition methodsFor:'accessing'!
+
+predicate
+ ^ predicate
+!
+
+predicate: anObject
+ predicate := anObject
+! !
+
+!PEGFsaPredicateTransition methodsFor:'comparing'!
+
+equals: anotherTransition
+ (super equals: anotherTransition) ifFalse: [ ^ false ].
+ (predicate asString = anotherTransition predicate asString) ifFalse: [ ^ false ].
+
+ ^ true
+! !
+
+!PEGFsaPredicateTransition methodsFor:'gt'!
+
+gtName
+ | gtName |
+ gtName := self predicate asString.
+ priority < 0 ifTrue: [ gtName := gtName, ',', priority asString ].
+ ^ gtName
+! !
+
+!PEGFsaPredicateTransition methodsFor:'set operations'!
+
+intersection: transition
+ | intersection |
+ intersection := Array new: 255 withAll: false.
+ ^ intersection
+! !
+
+!PEGFsaPredicateTransition methodsFor:'testing'!
+
+accepts: character
+ self assert: character isCharacter.
+ ^ self acceptsCodePoint: character codePoint
+!
+
+acceptsCodePoint: codePoint
+ self assert: codePoint isInteger.
+ ^ predicate value: codePoint
+!
+
+isCharacterTransition
+ ^ false
+!
+
+isEOF
+ ^ false
+!
+
+isPredicateTransition
+ ^ true
+!
+
+overlapsWith: transition
+ ^ false
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaSequenceDeterminizator.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,95 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PEGFsaAbstractDeterminizator subclass:#PEGFsaSequenceDeterminizator
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-FSA'
+!
+
+!PEGFsaSequenceDeterminizator methodsFor:'determinization'!
+
+determinize
+ super determinize.
+
+ self markFailures.
+ fsa removePriorities.
+!
+
+markFailures
+ fsa finalStates do: [ :fs |
+ | priority |
+ priority := fs priority.
+ fs reachableStates do: [ :rs |
+ (rs hasPriority and: [ (rs priority > fs priority) and: [ rs isFinal not ] ]) ifTrue: [
+ rs failure: true.
+ rs final: true.
+ ]
+ ]
+ ]
+! !
+
+!PEGFsaSequenceDeterminizator methodsFor:'joining'!
+
+joinInfo: info with: anotherInfo into: newInfo
+ (info hasEqualPriorityTo: anotherInfo) ifTrue: [
+ newInfo final: (info isFinal or: [ anotherInfo isFinal ]).
+ newInfo priority: info priority.
+ ^ self
+ ].
+
+ (info hasHigherPriorityThan: anotherInfo) ifTrue: [
+ newInfo priority: info priority.
+ newInfo failure: info isFsaFailure.
+ newInfo final: info isFinal.
+ ^ self
+ ].
+
+ newInfo priority: anotherInfo priority.
+ newInfo failure: anotherInfo isFsaFailure.
+ newInfo final: anotherInfo isFinal.
+!
+
+joinRetval: state with: anotherState into: newState
+ "Different retvals cannot merge their info"
+ self assert: (state hasDifferentRetvalThan: anotherState) not.
+ self assert: state retval == anotherState retval.
+
+ newState retval: state retval.
+!
+
+joinState: state with: anotherState
+ self assert: state isMultivalue not.
+ self assert: anotherState isMultivalue not.
+
+ ^ super joinState: state with: anotherState
+!
+
+joinTransitions: state with: anotherState into: newState
+ self assert: newState isMultivalue not.
+
+ newState hasPriority ifFalse: [
+ newState transitions addAll: (state transitions collect: #copy).
+ newState transitions addAll: (anotherState transitions collect: #copy).
+ ^ self
+ ].
+
+ self assert: newState hasPriority.
+ "This is a part when low priority branches are cut-out"
+ (state priority == newState priority) ifTrue: [
+ newState transitions addAll: (state transitions collect: #copy).
+ ] ifFalse: [
+ newState transitions addAll: (state transitions select: [ :t | t priority > newState priority ] thenCollect: #copy)
+ ].
+
+ (anotherState priority == newState priority) ifTrue: [
+ newState transitions addAll: (anotherState transitions collect: #copy).
+ ] ifFalse: [
+ newState transitions addAll: (anotherState transitions select: [ :t | t priority > newState priority ] thenCollect: #copy)
+ ].
+
+ newState mergeTransitions.
+! !
+
--- a/compiler/PEGFsaState.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PEGFsaState.st Mon Aug 17 12:13:16 2015 +0100
@@ -3,12 +3,28 @@
"{ NameSpace: Smalltalk }"
Object subclass:#PEGFsaState
- instanceVariableNames:'name retval priority transitions final multivalue'
+ instanceVariableNames:'name infos transitions'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-FSA'
!
+!PEGFsaState class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
+! !
+
+!PEGFsaState class methodsFor:'as yet unclassified'!
+
+named: aName
+ ^ self new
+ name: aName;
+ yourself
+! !
+
!PEGFsaState methodsFor:'accessing'!
destination
@@ -20,20 +36,42 @@
^ (transitions collect: #destination) asIdentitySet
!
+failure: boolean
+ self info failure: boolean
+!
+
final
- ^ final
+ ^ self info final
!
-final: anObject
- final := anObject
+final: boolean
+ self info final: boolean
+!
+
+infoFor: retval
+ ^ infos at: retval
+!
+
+infoFor: retval ifAbsent: block
+ ^ infos at: retval ifAbsent: block
+!
+
+isFsaFailure
+ ^ self isFinal and: [ self info isFsaFailure ]
!
multivalue
- ^ multivalue
+ <resource: #obsolete>
+ ^ self isMultivalue
+
+ "Modified: / 17-08-2015 / 12:03:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
multivalue: anObject
- multivalue := anObject
+ self flag: 'JK: Obsolete?'.
+ "multivalue := anObject"
+
+ "Modified: / 17-08-2015 / 12:03:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
name
@@ -44,16 +82,16 @@
name := anObject asString
!
-prefix
- ^ 'state'
-!
-
priority
- ^ priority
+ ^ self info priority
!
priority: anObject
- priority := anObject
+ self info priority: anObject
+!
+
+priorityFor: retval
+ ^ (self infoFor: retval) priority
!
priorityIfNone: value
@@ -61,23 +99,31 @@
!
retval
- ^ retval
+ self assert: self isMultivalue not.
+ ^ infos keys anyOne
!
retval: anObject
- retval := anObject
+ | info |
+ info := self info.
+ infos removeAll.
+ infos at: anObject put: info.
!
retvalAsCollection
- ^ self isMultivalue ifTrue: [
- self retval
- ] ifFalse: [
- Array with: self retval
- ]
+ ^ infos keys
+!
+
+retvals
+ ^ infos keys
!
-suffix
- ^ ''
+retvalsAndInfosDo: twoArgBlock
+ infos keysAndValuesDo: twoArgBlock
+!
+
+stateInfos
+ ^ infos values
!
transitions
@@ -86,6 +132,35 @@
!PEGFsaState methodsFor:'analysis'!
+collectNonEpsilonTransitionsOf: state to: collection
+ state transitions do: [ :t |
+ t isEpsilon ifTrue: [
+ self collectNonEpsilonTransitionsOf: t destination to: collection
+ ] ifFalse: [
+ collection add: t
+ ]
+ ].
+ ^ collection
+!
+
+nonEpsilonTransitionPairs
+ | size pairs collection |
+ pairs := OrderedCollection new.
+
+ collection := OrderedCollection new.
+ self collectNonEpsilonTransitionsOf: self to: collection.
+ size := collection size.
+
+ 1 to: (size - 1) do: [ :index1 |
+ (index1 + 1 to: size) do: [ :index2 |
+ pairs add: (PEGFsaPair
+ with: (collection at: index1)
+ with: (collection at: index2)).
+ ]
+ ].
+ ^ pairs
+!
+
reachableStates
| openSet |
openSet := IdentitySet new.
@@ -109,16 +184,15 @@
transitionPairs
| size pairs collection |
size := transitions size.
- pairs := OrderedCollection new: (size - 1) * size / 2.
+ pairs := OrderedCollection new.
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 add: (PEGFsaPair
+ with: (collection at: index1)
+ with: (collection at: index2)).
]
].
^ pairs
@@ -128,13 +202,14 @@
= anotherState
(self == anotherState) ifTrue: [ ^ true ].
- (self class == anotherState class) ifFalse: [ ^ true ].
+ (self class == anotherState class) ifFalse: [ ^ false ].
(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 ].
+
+ (self stateInfos size == anotherState stateInfos size) ifFalse: [ ^ false ].
+ self retvals do: [:retval |
+ ((self infoFor: retval) = (anotherState infoFor: retval ifAbsent: [ ^ false ])) ifFalse: [ ^ false ]
+ ].
(transitions size = anotherState transitions size) ifFalse: [ ^ false ].
transitions do: [:t |
@@ -146,25 +221,35 @@
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 ].
+
+ (self stateInfos size == anotherState stateInfos size) ifFalse: [ ^ false ].
+ self retvals do: [:retval |
+ ((self infoFor: retval) = (anotherState infoFor: retval ifAbsent: [ ^ false ])) ifFalse: [ ^ false ]
+ ].
^ true
!
equals: anotherState
+ self error: 'deprecated'.
+ "
+ JK: there is a bit mess between equals, isomorphic and =
+
+ JK: I should clean it, but the idea behind is:
+ - for minimization, I use equals
+ - for comparing, I use canBeIsomorphicTo: (because it can handle nested structures)
+ - I have no idea, why I override = O:)
+ "
+
(self == anotherState) ifTrue: [ ^ true ].
- (anotherState class == PEGFsaState) ifFalse: [ ^ false ].
+ (self class == anotherState class) 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 ].
+ (self stateInfos size == anotherState stateInfos size) ifFalse: [ ^ false ].
+ self retvals do: [:retval |
+ ((self infoFor: retval) equals: (anotherState infoFor: retval ifAbsent: [ ^ false ])) ifFalse: [ ^ false ]
].
(transitions size == anotherState transitions size) ifFalse: [ ^ false ].
@@ -176,22 +261,20 @@
!
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)).
+ "JK: Size is not the best option here, but it one gets infinite loops otherwise"
+ ^ infos hash bitXor: transitions size hash
!
isIsomorphicTo: anotherState resolvedSet: set
+ self error: 'depracated?'.
(self == anotherState) ifTrue: [ ^ true ].
- (name == anotherState name) ifFalse: [ ^ false ].
+" (name == anotherState name) ifFalse: [ ^ false ].
(priority == anotherState priority) ifFalse: [ ^ false ].
- (multivalue == anotherState multivalue) ifFalse: [ ^ false ].
+ (multivalue == anotherState isMultivalue) 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 ].
@@ -203,22 +286,60 @@
!PEGFsaState methodsFor:'copying'!
postCopy
+ | newInfos |
super postCopy.
transitions := (transitions collect: [ :t | t copy ]).
- retval := retval copy.
+
+ newInfos := IdentityDictionary new.
+ infos keysAndValuesDo: [ :key :value |
+ newInfos at: key put: value copy
+ ].
+
+ infos := newInfos.
! !
!PEGFsaState methodsFor:'gt'!
gtName
- | gtName |
- gtName := name.
-
+ | gtStream |
+ gtStream := '' writeStream.
+ self printNameOn: gtStream.
+
self hasPriority ifTrue: [
- gtName := gtName asString, ',', self priority asString.
+ self retvalsAndInfosDo: [ :retval :info |
+ gtStream nextPut: (Character codePoint: 13).
+ gtStream nextPutAll: retval asString.
+ gtStream nextPutAll: '->'.
+ info printOn: gtStream.
+ ].
].
- ^ gtName
+ ^ gtStream contents trim
+! !
+
+!PEGFsaState methodsFor:'ids'!
+
+defaultName
+ ^ #state
+!
+
+hasName
+ ^ name isNil not
+!
+
+prefix
+ ^ nil
+!
+
+suffix
+ ^ nil
+! !
+
+!PEGFsaState methodsFor:'infos'!
+
+info
+ self assert: infos size = 1.
+ ^ infos anyOne
! !
!PEGFsaState methodsFor:'initialization'!
@@ -227,22 +348,59 @@
super initialize.
transitions := OrderedCollection new.
- multivalue := false.
+
+ infos := IdentityDictionary new.
+ infos at: nil put: PEGFsaStateInfo new.
! !
!PEGFsaState methodsFor:'modifications'!
+addInfo: info for: retval
+ infos removeKey: nil ifAbsent: [ "not a big deal" ].
+ infos at: retval put: info
+!
+
addTransition: t
self assert: (transitions identityIncludes: t) not.
transitions add: t
!
decreasePriority
+ self decreasePriorityBy: 1.
+!
+
+decreasePriorityBy: value
(self isFinal and: [ self hasPriority not ]) ifTrue: [
- priority := 0.
+ self error: 'Final States Should have priority!!'
].
- priority isNil ifFalse: [
- priority := priority - 1
+
+ self priority isNil ifFalse: [
+ self priority: self priority - value
+ ]
+!
+
+join: state
+ ^ self join: state joinDictionary: Dictionary new
+!
+
+mergeInfo: state into: newState
+ self info merge: state info into: newState info.
+!
+
+mergeTransitions
+ | toRemove |
+ toRemove := OrderedCollection new.
+ self transitionPairs do:[ :pair |
+ (pair first destination = pair second destination) ifTrue: [
+ (pair first isPredicateTransition not and: [pair second isPredicateTransition not]) ifTrue: [
+ pair first mergeWith: pair second.
+ toRemove add: pair second.
+ ]
+ ]
+ ].
+
+ toRemove do: [ :t |
+ self removeTransition: t
]
!
@@ -251,6 +409,94 @@
transitions remove: t
! !
+!PEGFsaState methodsFor:'modifications - determinization'!
+
+determinize
+ ^ PEGFsaAbstractDeterminizator new determinizeState: self
+!
+
+join: state joinDictionary: dictionary
+ | pair newState |
+ self error: 'deprecated'.
+ pair := PEGFsaPair with: self with: state.
+ (dictionary includesKey: pair) ifTrue: [ ^ dictionary at: pair ].
+
+ newState := PEGFsaState new.
+
+ dictionary at: pair put: newState.
+
+ self joinRetval: state into: newState.
+ self joinName: state into: newState.
+ self joinTransitions: state into: newState.
+
+ newState determinize: dictionary.
+
+ ^ dictionary at: pair put: newState
+!
+
+joinInfo: state into: newState
+ self info join: state info into: newState info.
+!
+
+joinName: state into: newState
+ newState name: self name asString, '_', state name asString.
+!
+
+joinRetval: state into: newState
+ "Different retvals cannot merge their info"
+ (self hasDifferentRetvalThan: state) ifTrue: [
+ newState addInfo: self info for: self retval.
+ newState addInfo: state info for: state retval.
+ ^ self
+ ].
+
+
+ (self hasHigherPriorityThan: state) ifTrue: [
+ newState retval: self retval
+ ].
+
+ (state hasHigherPriorityThan: self) ifTrue: [
+ newState retval: state retval
+ ].
+
+ (state priority == self priority) ifTrue: [
+ self hasRetval ifTrue: [newState retval: self retval].
+ state hasRetval ifTrue: [newState retval: state retval].
+ ].
+
+ self joinInfo: state into: newState.
+!
+
+joinTransitions: state into: newState.
+ newState isMultivalue ifTrue: [
+ newState transitions addAll: (self transitions collect: #copy).
+ newState transitions addAll: (state transitions collect: #copy).
+ ^ self
+ ].
+
+ newState hasPriority ifFalse: [
+ newState transitions addAll: (self transitions collect: #copy).
+ newState transitions addAll: (state transitions collect: #copy).
+ ^ self
+ ].
+
+
+ self assert: newState hasPriority.
+
+ "This is a part when low priority branches are cut"
+ (self priority == newState priority) ifTrue: [
+ newState transitions addAll: (self transitions collect: #copy).
+ ] ifFalse: [
+ newState transitions addAll: (self transitions select: [ :t | t priority > newState priority ] thenCollect: #copy)
+ ].
+
+ (state priority == newState priority) ifTrue: [
+ newState transitions addAll: (state transitions collect: #copy).
+ ] ifFalse: [
+ newState transitions addAll: (state transitions select: [ :t | t priority > newState priority ] thenCollect: #copy)
+ ].
+! !
+
!PEGFsaState methodsFor:'printing'!
printNameOn: aStream
@@ -265,11 +511,14 @@
self printNameOn: aStream.
aStream nextPut: Character space.
aStream nextPutAll: self identityHash asString.
- self isFinal ifTrue: [
- aStream nextPutAll: ' FINAL'.
+
+ self retvalsAndInfosDo: [ :retval :info |
+ retval printOn: aStream.
+ aStream nextPutAll: '->'.
+ info printOn: aStream.
+ aStream nextPutAll: ';'.
].
- aStream nextPut: (Character codePoint: 32).
- aStream nextPutAll: priority asString.
+
aStream nextPut: $)
! !
@@ -279,129 +528,58 @@
^ true
!
+hasDifferentRetvalThan: anotherState
+ "returns true only if both hav retval and both retvals are different"
+ self hasRetval ifFalse: [ ^ false ].
+ anotherState hasRetval ifFalse: [ ^ false ].
+
+ "`retval value` is called in order to obtain retval from FsaFailure (if any)"
+ ^ (self retval value == anotherState retval value) not
+!
+
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
+ ^ self info hasEqualPriorityTo: state info
!
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
+ ^ self info hasHigherPriorityThan: state info
!
hasPriority
- ^ priority isNil not
+ ^ self stateInfos anySatisfy: [ :info | info hasPriority ]
+!
+
+hasRetval
+ ^ self retval isNil not
+!
+
+hasZeroPriorityOnly
+ ^ self stateInfos allSatisfy: [ :si | si hasPriority not or: [ si priority == 0 ] ].
!
isFailure
+ self error: 'Obsolete?'.
+ "
^ self isFinal and: [ retval class == PEGFsaFailure ]
+ "
+
+ "Modified: / 17-08-2015 / 12:01:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isFinal
- final isNil ifTrue: [ ^ false ].
-
- final ifTrue: [
-" self assert: self hasPriority. "
- ^ true
- ].
-
- ^ false
+ ^ self stateInfos anySatisfy: [ :info | info isFinal ].
!
isMultivalue
- ^ multivalue
+ ^ infos size > 1
+!
+
+isStub
+ ^ false
! !
!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 ]).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaStateInfo.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,212 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PEGFsaStateInfo
+ instanceVariableNames:'priority final failure'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-FSA'
+!
+
+!PEGFsaStateInfo methodsFor:'accessing'!
+
+failure
+ ^ failure
+!
+
+failure: anObject
+ failure := anObject
+!
+
+final
+ ^ final
+!
+
+final: anObject
+ final := anObject
+!
+
+priority
+ ^ priority
+!
+
+priority: anObject
+ priority := anObject
+! !
+
+!PEGFsaStateInfo methodsFor:'comparing'!
+
+= anotherInfo
+ (self == anotherInfo) ifTrue: [ ^ true ].
+ (self class == anotherInfo class) ifFalse: [ ^ false ].
+
+ (priority == anotherInfo priority) ifFalse: [ ^ false ].
+
+ (self isFinal == anotherInfo isFinal) ifFalse: [ ^ false ].
+
+ ^ true
+!
+
+equals: anotherInfo
+ self error: 'deprecated'.
+ (self == anotherInfo) ifTrue: [ ^ true ].
+ (self class == anotherInfo class) ifFalse: [ ^ false ].
+
+ "
+ I suppose I don't if someone does not have the priority set.
+ Please note that equals is used for minimization, so I try to
+ be as liberal as possible to get as small automaton as possible.
+ "
+ (self hasPriority and: [anotherInfo hasPriority]) ifTrue: [
+ (priority == anotherInfo priority) ifFalse: [ ^ false ].
+ ].
+
+ (self isFinal == anotherInfo isFinal) ifFalse: [ ^ false ].
+
+ ^ true
+! !
+
+!PEGFsaStateInfo methodsFor:'modifications - determinization'!
+
+join: info into: newInfo
+ self error: 'deprecated'.
+ "
+ The diff between JOIN and Merge:
+ - join is used while determinizing the FSA
+ - merge is used when removing epsilons
+ "
+
+ (self hasEqualPriorityTo: info) ifTrue: [
+ newInfo final: (self isFinal or: [ info isFinal ]).
+ newInfo priority: self priority.
+ ^ self
+ ].
+
+ (self hasHigherPriorityThan: info) ifTrue: [
+ newInfo priority: self priority.
+ newInfo final: self isFinal.
+ ^ self
+ ].
+
+ newInfo priority: info priority.
+ newInfo final: info isFinal.
+! !
+
+!PEGFsaStateInfo methodsFor:'printing'!
+
+printOn: aStream
+ priority isNil ifFalse: [
+ priority printOn: aStream.
+ aStream nextPutAll: ', '
+ ].
+
+ self isFinal ifTrue: [
+ aStream nextPutAll: 'FINAL'.
+ aStream nextPutAll: ', '
+ ].
+
+ self isFsaFailure ifTrue: [
+ aStream nextPutAll: 'FAILURE'
+ ].
+! !
+
+!PEGFsaStateInfo methodsFor:'testing'!
+
+hasEqualPriorityTo: stateInfo
+ "nil - nil"
+ (self hasPriority not and: [stateInfo hasPriority not]) ifTrue: [ ^ true ].
+
+ "nil - priority"
+ (self hasPriority) ifFalse: [ ^ false ].
+
+ "priority - nil"
+ stateInfo hasPriority ifFalse: [ ^ false ].
+
+ "priority - priority"
+ ^ self priority = stateInfo priority
+!
+
+hasHigherPriorityThan: stateInfo
+ "nil - nil"
+ (self hasPriority not and: [stateInfo hasPriority not]) ifTrue: [ ^ true ].
+
+ "nil - priority"
+ (self hasPriority) ifFalse: [ ^ false ].
+
+ "priority - nil"
+ stateInfo hasPriority ifFalse: [ ^ true ].
+
+ "priority - priority"
+ ^ self priority > stateInfo priority
+!
+
+hasPriority
+ ^ self priority isNil not
+!
+
+isBlank
+ ^ self hasPriority not and: [ self isFinal not ]
+!
+
+isFinal
+ final isNil ifTrue: [ ^ false ].
+ ^ final
+!
+
+isFsaFailure
+ failure isNil ifTrue: [ ^ false ].
+ ^ failure
+! !
+
+!PEGFsaStateInfo methodsFor:'transformation'!
+
+merge: info into: newInfo
+ "
+ The diff between JOIN and Merge:
+ - join is used while determinizing the FSA
+ - merge is used when removing epsilons
+ "
+
+ "final - final"
+ (self isFinal and: [info isFinal]) ifTrue: [
+ newInfo final: true.
+ (self hasHigherPriorityThan: info) ifTrue: [
+ newInfo priority: self priority.
+ ] ifFalse: [
+ newInfo priority: info priority.
+ ].
+ "
+ This has its reason: when moving from failure to non-failure
+ using the epsilon, just keep the latter:
+ "
+ newInfo failure: info isFsaFailure.
+ ^ self
+ ].
+
+ "final - non final"
+ (self isFinal) ifTrue: [
+ newInfo final: true.
+ newInfo priority: self priority.
+ newInfo failure: self isFsaFailure.
+ ^ self
+ ].
+
+ "non final - final"
+ (info isFinal) ifTrue: [
+ newInfo final: true.
+ newInfo priority: info priority.
+ newInfo failure: info isFsaFailure.
+ ^ self
+ ].
+
+ "non final - non final"
+ newInfo priority: self priority.
+ (self hasHigherPriorityThan: info) ifTrue: [
+ newInfo priority: self priority.
+ ] ifFalse: [
+ newInfo priority: info priority.
+ ].
+ newInfo failure: info isFsaFailure.
+! !
+
--- a/compiler/PEGFsaTransition.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PEGFsaTransition.st Mon Aug 17 12:13:16 2015 +0100
@@ -3,12 +3,20 @@
"{ NameSpace: Smalltalk }"
Object subclass:#PEGFsaTransition
- instanceVariableNames:'characterSet destination priority'
+ instanceVariableNames:'destination priority characterSet'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-FSA'
!
+!PEGFsaTransition class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
+! !
+
!PEGFsaTransition methodsFor:'accessing'!
characterSet
@@ -49,14 +57,13 @@
(destination == anotherTransition destination) ifFalse: [ ^ false ].
(priority == anotherTransition priority) ifFalse: [ ^ false ].
- (characterSet = anotherTransition characterSet) ifFalse: [ ^ false ].
^ true
!
canBeIsomorphicTo: anotherTransition
+ (self class == anotherTransition class) ifFalse: [ ^ false ].
(priority == anotherTransition priority) ifFalse: [ ^ false ].
- (characterSet = anotherTransition characterSet) ifFalse: [ ^ false ].
^ true
!
@@ -65,32 +72,16 @@
"this method is used for minimization of the FSA"
(self == anotherTransition) ifTrue: [ ^ true ].
+ (self class == anotherTransition class) ifFalse: [ ^ false ].
(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
+ ^ destination hash bitXor: priority hash
! !
!PEGFsaTransition methodsFor:'copying'!
@@ -113,7 +104,6 @@
initialize
super initialize.
- characterSet := Array new: 255 withAll: false.
priority := 0.
! !
@@ -124,43 +114,11 @@
!
decreasePriority
- priority := priority - 1
-! !
-
-!PEGFsaTransition methodsFor:'printing'!
-
-characterSetAsString
- | stream |
- stream := WriteStream on: ''.
- self printCharacterSetOn: stream.
- ^ stream contents
+ self decreasePriorityBy: 1
!
-printCharacterSetOn: stream
- self isEpsilon ifTrue: [
- stream nextPutAll: '<epsilon>'.
- ^ self
- ].
-
- stream nextPut: $[.
- 32 to: 127 do: [ :index |
- (characterSet at: index) ifTrue: [
- stream nextPut: (Character codePoint: index)
- ]
- ].
- stream nextPut: $].
-!
-
-printOn: stream
- self printCharacterSetOn: stream.
- stream nextPutAll: ' ('.
- priority printOn: stream.
- stream nextPutAll: ')'.
- stream nextPutAll: '-->'.
- destination printOn: stream.
- stream nextPutAll: '(ID: '.
- stream nextPutAll: self identityHash asString.
- stream nextPutAll: ')'.
+decreasePriorityBy: value
+ priority := priority - value
! !
!PEGFsaTransition methodsFor:'set operations'!
@@ -223,8 +181,20 @@
^ characterSet at: character codePoint
!
+isCharacterTransition
+ ^ false
+!
+
isEpsilon
- ^ characterSet allSatisfy: [ :e | e not ]
+ ^ self isEpsilonTransition
+!
+
+isEpsilonTransition
+ ^ false
+!
+
+isPredicateTransition
+ ^ false
!
overlapsWith: transition
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaUncopiableState.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,35 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PEGFsaState subclass:#PEGFsaUncopiableState
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-FSA'
+!
+
+!PEGFsaUncopiableState methodsFor:'as yet unclassified'!
+
+addTransition: t
+ self error: 'should not happen'
+!
+
+copy
+ ^ self
+!
+
+final: value
+ self error: 'should not happen'
+!
+
+priority: anObject
+ self error: 'should not happen'
+! !
+
+!PEGFsaUncopiableState methodsFor:'testing'!
+
+isStub
+ ^ true
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCASTUtilities.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,146 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCASTUtilities
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Support'
+!
+
+!PPCASTUtilities methodsFor:'checks'!
+
+checkNodeIsFunctional: anRBBlockNode inClass: aClaas
+ "Check whether the given node is purely functional or not.
+ If no, raise an erorr. If not, this method is noop.
+
+ A block is purely functional if and only if:
+ (i) it does not refer to any instance or class variable or non-local variable
+ (ii) all self-sends within the block are to 'purely-functional' methods
+ (transitively)
+ (iiI) contains no super-sends.
+ "
+ | allDefinedVarNames allInstVarNames allClassVarNames cls |
+
+ allDefinedVarNames := anRBBlockNode allDefinedVariables.
+ allInstVarNames := Set new.
+ allClassVarNames := Set new.
+ cls := aClaas.
+ [ cls notNil ] whileTrue:[
+ | instanceVariables classVariables |
+
+ instanceVariables := cls instanceVariables.
+ classVariables := cls classVariables.
+ instanceVariables notNil ifTrue:[
+ allInstVarNames addAll: instanceVariables.
+ ].
+ classVariables notNil ifTrue:[
+ allClassVarNames addAll: classVariables.
+ ].
+ cls := cls superclass.
+ ].
+
+ self withAllVariableNodesOf: anRBBlockNode do: [ :node |
+ (allDefinedVarNames includes: node name) ifFalse:[
+ (allInstVarNames includes: node name) ifTrue:[
+ PPCCompilationError new signalWith: 'code refers to an instance variable named `',node name,'`'.
+ ^ self.
+ ].
+ (allClassVarNames includes: node name) ifTrue:[
+ PPCCompilationError new signalWith: 'code refers to a class variable named `',node name,'`'.
+ ^ self.
+ ].
+ (Smalltalk includesKey: node name asSymbol) ifFalse:[
+ PPCCompilationError new signalWith: 'code refers to an unknown variable named `',node name,'`'.
+ ^ self.
+ ].
+ ]
+ ].
+ self withAllMessageNodesOf: anRBBlockNode sentToSelfDo:[:node |
+ | method |
+
+ method := aClaas lookupSelector: node selector.
+ method isNil ifTrue:[
+ PPCCompilationError new signalWith: 'code contains self-send to non-existent method'.
+ ^ self
+ ].
+ self checkNodeIsFunctional: method parseTree inClass: method methodClass.
+ ].
+ self withAllSuperNodesOf: anRBBlockNode do: [ :node |
+ PPCCompilationError new signalWith: 'code contains a super-send'.
+ ^ self
+ ].
+
+ "Created: / 27-07-2015 / 12:15:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-07-2015 / 14:43:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCASTUtilities methodsFor:'enumerating'!
+
+withAllMessageNodesOf: anRBProgramNode do: aBlock
+ "Enumerate all chilren of `anRBProgramNode` (including itself)
+ and evaluate `aBlock` for each message node."
+
+ self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isMessage ] do: aBlock.
+
+ "Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 27-07-2015 / 11:26:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+withAllMessageNodesOf: anRBProgramNode sentToSelfDo: aBlock
+ "Enumerate all chilren of `anRBProgramNode` (including itself)
+ and evaluate `aBlock` for each message node which sends a message
+ to self (i.e., for self-sends)."
+
+ self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isMessage and:[node receiver isSelf ] ] do: aBlock.
+
+ "Created: / 27-07-2015 / 14:41:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+withAllNodesOf: node suchThat: predicate do: action
+ "Enumerate all chilren of `node` (including itself)
+ and evaluate `aBlock` for each node for which `predicate` returns true."
+
+ (predicate value: node) ifTrue:[
+ action value: node.
+ ].
+ node children do:[:each |
+ self withAllNodesOf: each suchThat: predicate do: action
+ ].
+
+ "Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 27-07-2015 / 11:26:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+withAllSelfNodesOf: anRBProgramNode do: aBlock
+ "Enumerate all chilren of `anRBProgramNode` (including itself)
+ and evaluate `aBlock` for each `self` node."
+
+ self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isSelf ] do: aBlock.
+
+ "Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 27-07-2015 / 11:26:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+withAllSuperNodesOf: anRBProgramNode do: aBlock
+ "Enumerate all chilren of `anRBProgramNode` (including itself)
+ and evaluate `aBlock` for each `super` node."
+
+ self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isSuper ] do: aBlock.
+
+ "Created: / 27-07-2015 / 14:42:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+withAllVariableNodesOf: anRBProgramNode do: aBlock
+ "Enumerate all chilren of `anRBProgramNode` (including itself)
+ and evaluate `aBlock` for each variable node.
+ This is a replacement for Smalltalk/X's RBProgramNode>>variableNodesDo:
+ which is not present in Pharo"
+
+ self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isVariable and:[node isSelf not and:[node isSuper not]]] do: aBlock.
+
+ "Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 27-07-2015 / 11:27:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- a/compiler/PPCAbstractActionNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCAbstractActionNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -22,7 +22,7 @@
block := anObject
!
-prefix
+defaultName
^ #action
! !
--- a/compiler/PPCAbstractLiteralNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCAbstractLiteralNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -11,6 +11,10 @@
!PPCAbstractLiteralNode methodsFor:'accessing'!
+defaultName
+ ^ #lit
+!
+
literal
^ literal
@@ -19,10 +23,6 @@
literal: anObject
literal := anObject
-!
-
-prefix
- ^ #lit
! !
!PPCAbstractLiteralNode methodsFor:'analysis'!
--- a/compiler/PPCAbstractPredicateNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCAbstractPredicateNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -9,8 +9,13 @@
category:'PetitCompiler-Nodes'
!
+
!PPCAbstractPredicateNode methodsFor:'accessing'!
+defaultName
+ ^ #predicate
+!
+
predicate
^ predicate
@@ -19,10 +24,6 @@
predicate: anObject
predicate := anObject
-!
-
-prefix
- ^ #predicate
! !
!PPCAbstractPredicateNode methodsFor:'analysis'!
@@ -65,3 +66,10 @@
^ (classification asOrderedCollection addLast: false; yourself) asArray
! !
+!PPCAbstractPredicateNode class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/compiler/PPCAndNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCAndNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -11,7 +11,7 @@
!PPCAndNode methodsFor:'accessing'!
-prefix
+defaultName
^ #and
! !
--- a/compiler/PPCAnyNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCAnyNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -12,7 +12,7 @@
!PPCAnyNode methodsFor:'accessing'!
-prefix
+defaultName
^ #any
! !
@@ -23,7 +23,8 @@
!
firstCharSet
- ^ PPCharSetPredicate on: [:e | true ]
+ self flag: 'JK: hack alert, 3 is EOF'.
+ ^ PPCharSetPredicate on: [:e | (e == 3) not ]
! !
!PPCAnyNode methodsFor:'visiting'!
--- a/compiler/PPCCharacterNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCCharacterNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -19,7 +19,7 @@
character := char
!
-prefix
+defaultName
^ #char
! !
@@ -59,7 +59,7 @@
^ self
].
- aStream nextPutAll: ', not('; print: character; nextPutAll: ')'
+ aStream nextPutAll: ', '; print: character.
! !
!PPCCharacterNode methodsFor:'visiting'!
--- a/compiler/PPCChoiceNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCChoiceNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -12,7 +12,7 @@
!PPCChoiceNode methodsFor:'accessing'!
-prefix
+defaultName
^ #ch
! !
--- a/compiler/PPCClassBuilder.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCClassBuilder.st Mon Aug 17 12:13:16 2015 +0100
@@ -10,6 +10,14 @@
category:'PetitCompiler-Core'
!
+!PPCClassBuilder class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
+! !
+
!PPCClassBuilder methodsFor:'accessing'!
compiledClass
@@ -66,6 +74,16 @@
!
cleanGeneratedMethods
+ (compiledClass methodDictionary size == 0) ifTrue: [ ^ self ].
+
+ "this is hack, but might help the performance..."
+ (compiledClass methods allSatisfy: [:m | m category beginsWith: 'generated']) ifTrue: [
+ compiledClass removeFromSystem.
+ compiledClass := nil.
+ ^ self
+ ].
+
+
((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
compiledClass methodsDo: [ :mthd |
(mthd category beginsWith: 'generated') ifTrue:[
@@ -73,10 +91,17 @@
]
]
] ifFalse: [
+" compiledClass methodsDo: [ :mthd |
+ (mthd category beginsWith: 'generated') ifTrue:[
+ compiledClass removeSelector: mthd selector.
+ ]
+ ]
+"
+" Too slow, but more stable :("
(compiledClass allProtocolsUpTo: compiledClass) do: [ :protocol |
(protocol beginsWith: 'generated') ifTrue: [
compiledClass removeProtocol: protocol.
- ]
+ ]
]
]
! !
@@ -96,7 +121,7 @@
installMethods
methodDictionary values do: [ :method |
(compiledClass methodDictionary includesKey: method methodName) ifFalse: [
- compiledClass compileSilently: method code classified: method category.
+ compiledClass compileSilently: method source classified: method category.
]
]
!
--- a/compiler/PPCCodeBlock.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCCodeBlock.st Mon Aug 17 12:13:16 2015 +0100
@@ -38,16 +38,9 @@
!PPCCodeBlock methodsFor:'code generation'!
code: aStringOrBlockOrRBParseNode
- aStringOrBlockOrRBParseNode isString ifTrue:[
- self emitCodeAsString: aStringOrBlockOrRBParseNode
- ] ifFalse:[
- (aStringOrBlockOrRBParseNode isKindOf: RBProgramNode) ifTrue:[
- self emitCodeAsRBNode: aStringOrBlockOrRBParseNode.
- ] ifFalse:[
- self emitCodeAsBlock: aStringOrBlockOrRBParseNode
- ].
- ].
-
+ self codeNl.
+ self codeOnLine: aStringOrBlockOrRBParseNode
+
"Created: / 01-06-2015 / 21:07:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 03-06-2015 / 05:52:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -66,6 +59,22 @@
].
"Created: / 01-06-2015 / 22:58:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeNl
+ self add: ''.
+!
+
+codeOnLine: aStringOrBlockOrRBParseNode
+ aStringOrBlockOrRBParseNode isString ifTrue:[
+ self emitCodeAsString: aStringOrBlockOrRBParseNode
+ ] ifFalse:[
+ (aStringOrBlockOrRBParseNode isKindOf: RBProgramNode) ifTrue:[
+ self emitCodeAsRBNode: aStringOrBlockOrRBParseNode.
+ ] ifFalse:[
+ self emitCodeAsBlock: aStringOrBlockOrRBParseNode
+ ].
+ ].
! !
!PPCCodeBlock methodsFor:'code generation - variables'!
@@ -144,6 +153,38 @@
aStream nextPutAll: buffer contents
"Created: / 01-06-2015 / 21:26:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+sourceOn:aStream
+ "Dumps generated code on given stream"
+
+ temporaries notEmpty ifTrue:[
+ ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
+ indentation * 4 timesRepeat:[
+ aStream nextPut:Character space
+ ].
+ ] ifFalse:[
+ indentation timesRepeat:[
+ aStream nextPut:Character tab
+ ].
+ ].
+ aStream nextPut:$|.
+ temporaries do:[:e |
+ aStream
+ space;
+ nextPutAll:e
+ ].
+ aStream space.
+ aStream nextPut:$|.
+ self nl.
+ "In Smalltalk/X, there should be a blank line after temporaries"
+ ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
+ self nl.
+ ].
+ ].
+ aStream nextPutAll:buffer contents
+
+ "Created: / 01-06-2015 / 21:26:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCCodeBlock methodsFor:'private'!
@@ -170,7 +211,7 @@
!
emitCodeAsString: aString
- buffer nextPutAll: aString
+ self addOnLine: aString
!
formatRBNode: anRBNode
--- a/compiler/PPCCodeGen.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCCodeGen.st Mon Aug 17 12:13:16 2015 +0100
@@ -4,7 +4,7 @@
Object subclass:#PPCCodeGen
instanceVariableNames:'compilerStack compiledParser methodCache currentMethod constants
- returnVariable arguments idCache'
+ returnVariable arguments idGen'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Compiler-Codegen'
@@ -52,8 +52,16 @@
^ currentMethod returnVariable
!
+idGen
+ ^ idGen
+!
+
+idGen: anObject
+ idGen := anObject
+!
+
ids
- ^ idCache keys
+ ^ idGen ids
!
methodCategory
@@ -144,6 +152,10 @@
"Created: / 01-06-2015 / 23:49:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+codeAssert: aCode
+ self add: 'self assert: (', aCode, ').'.
+!
+
codeAssign: code to: variable
self assert: variable isNil not.
@@ -164,6 +176,7 @@
method := [
aBlock value
] ensure:[ returnVariable := tmpVarirable ].
+ self assert: (method isKindOf: PPCMethod).
method isInline ifTrue:[
self callOnLine:method
] ifFalse:[
@@ -179,6 +192,11 @@
"Created: / 01-06-2015 / 22:35:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+codeCall: aMethod
+ self assert: (aMethod isKindOf: PPCMethod).
+ self add: aMethod call.
+!
+
codeClearError
self add: 'self clearError.'.
!
@@ -212,9 +230,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
]
!
@@ -227,7 +245,7 @@
self add: variable ,' := ', argument.
] ifTrue: [
"In case an argument has a side effect"
- self add: argument.
+ self add: argument.
]
!
@@ -254,16 +272,16 @@
codeIf: condition then: then else: else
currentMethod
add: '(';
- code: condition;
+ codeOnLine: condition;
addOnLine: ')'.
then notNil ifTrue:[
currentMethod
- addOnLine:' ifTrue:';
+ addOnLine:' ifTrue: ';
codeBlock: then.
].
else notNil ifTrue:[
currentMethod
- addOnLine:' ifFalse:';
+ addOnLine:' ifFalse: ';
codeBlock: else.
].
self codeDot.
@@ -291,6 +309,27 @@
"Modified: / 23-04-2015 / 20:51:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+codeOnLIne:aStringOrBlockOrRBParseNode
+ currentMethod codeOnLine: aStringOrBlockOrRBParseNode
+
+ "Created: / 01-06-2015 / 23:49:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeParsedValueOf: aBlock
+ | tmpVarirable method |
+
+ self assert: aBlock isBlock.
+ tmpVarirable := returnVariable.
+ returnVariable := #whatever.
+ method := [
+ aBlock value
+ ] ensure:[ returnVariable := tmpVarirable ].
+ self assert: returnVariable == tmpVarirable.
+ self assert: (method isKindOf: PPCMethod).
+
+ self codeCall: method.
+!
+
codeProfileStart
self add: 'context methodInvoked: #', currentMethod methodName, '.'
@@ -305,16 +344,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 <jan.vrany@fit.cvut.cz>"
- "Modified: / 01-06-2015 / 21:49:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 01-06-2015 / 21:49:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
codeReturn: code
@@ -333,6 +372,25 @@
"Modified: / 01-06-2015 / 21:48:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+codeReturnParsedValueOf: aBlock
+ | tmpVarirable method |
+
+ self assert:aBlock isBlock.
+ tmpVarirable := returnVariable.
+ method := aBlock value.
+ self assert: returnVariable == tmpVarirable.
+ self assert: (method isKindOf: PPCMethod).
+ method isInline ifTrue:[
+ self callOnLine:method.
+ self codeReturn: returnVariable.
+ ] ifFalse:[
+ self codeReturn: method call.
+
+ ]
+
+ "Created: / 23-04-2015 / 18:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
codeStoreValueOf: aBlock intoVariable: aString
| tmpVarirable method |
self assert: aBlock isBlock.
@@ -394,9 +452,12 @@
"Modified: / 10-05-2015 / 07:29:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-idFor: object
- self assert: (object canHavePPCId).
- ^ self idFor: object prefixed: object prefix suffixed: object suffix
+idFor: anObject
+ ^ idGen idFor: anObject
+!
+
+idFor: anObject defaultName: defaultName
+ ^ idGen idFor: anObject defaultName: defaultName
!
idFor: object prefixed: prefix
@@ -404,14 +465,16 @@
!
idFor: object prefixed: prefix suffixed: suffix
+ self error: 'Should no longer be used'.
+ "
| name id |
^ idCache at: object ifAbsentPut: [
((object canHavePPCId) and: [object name isNotNil]) ifTrue: [
- "Do not use prefix, if there is a name"
+ ""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!!"
+ ""Make sure, that the generated ID is uniqe!!""
(idCache includes: id) ifTrue: [
(id, '_', idCache size asString) asSymbol
] ifFalse: [
@@ -421,11 +484,18 @@
(prefix, '_', (idCache size asString), suffix) asSymbol
]
]
+ "
+
+ "Modified: / 17-08-2015 / 12:00:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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
+!
+
+numberIdFor: object
+ ^ idGen numericIdFor: object
! !
!PPCCodeGen methodsFor:'initialization'!
@@ -441,7 +511,7 @@
compilerStack := Stack new.
methodCache := IdentityDictionary new.
constants := Dictionary new.
- idCache := IdentityDictionary new.
+ idGen := PPCIdGenerator new.
! !
!PPCCodeGen methodsFor:'profiling'!
@@ -468,8 +538,7 @@
checkCache: id
| method |
-
- "self halt: 'deprecated?'."
+ self flag: 'deprecated?'.
"Check if method is hand written"
method := compiledParser ifNotNil: [ compiledParser compiledMethodAt: id ifAbsent: [ nil ] ].
@@ -535,7 +604,6 @@
stopMethod
self cache: currentMethod methodName as: currentMethod.
-
"arguments profile ifTrue: [ Transcript show: currentMethod code; cr. ]."
^ self pop.
--- a/compiler/PPCCodeGenerator.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCCodeGenerator.st Mon Aug 17 12:13:16 2015 +0100
@@ -131,7 +131,7 @@
compiler addOnLine: '].'.
]."
- guard id: (compiler idFor: guard prefixed: #guard).
+ guard id: (compiler idFor: guard defaultName: #guard).
guard compileGuard: compiler.
trueBlock isNil ifFalse: [
@@ -191,6 +191,61 @@
!PPCCodeGenerator methodsFor:'private'!
+checkBlockIsInlinable: block
+ "Check whether the given block could be inlined. If not,
+ throw an error. If yes, this method is noop.
+
+ A block is inlineable if and only if it's a purely functional
+ (see PPCASTUtilities>>checkBlockIsPurelyFunctional:inClass: for
+ details)
+
+ As a side-effect, copy all self-sent methods from the block
+ to the target class.
+ "
+ | blockNode |
+
+ blockNode := block sourceNode.
+ "In Smalltalk implementation which use cheap-block optimization (Smalltalk/X) it may
+ happen that home context of the block is nil (in case of cheap blocks)"
+ block home notNil ifTrue:[
+ | blockClass |
+
+ blockClass := block home receiver class.
+ PPCASTUtilities new checkNodeIsFunctional: blockNode inClass: blockClass.
+ "The above code should raise an error when block is not functional (i.e., when not
+ inlineable, so if the control flow reach this point, block is OK and we can safely
+ copy self-sent methods."
+ self copySelfSentMethodsOf: blockNode inClass: blockClass
+ ].
+
+ "Created: / 27-07-2015 / 14:40:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-07-2015 / 15:52:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+copySelfSentMethodsOf: anRBProgramNode inClass: aClass
+ PPCASTUtilities new withAllMessageNodesOf: anRBProgramNode sentToSelfDo: [ :node|
+ | method source |
+
+ method := aClass lookupSelector: node selector.
+ method isNil ifTrue:[
+ PPCCompilationError new signalWith: 'oops, no method found (internal error)!!'.
+ ].
+ source := method source.
+ source isNil ifTrue:[
+ PPCCompilationError new signalWith: 'unavailable source for method ', method printString ,'!!'.
+ ].
+ "Following actually copies the method to the target class,
+ though the APU is not nice. This has to be cleaned up"
+ (compiler cachedValue: node selector) isNil ifTrue:[
+ compiler cache: node selector as: (PPCMethod new id: node selector; source: source; yourself).
+ "Now compile self-sends of the just copied method"
+ self copySelfSentMethodsOf: method parseTree inClass: aClass
+ ].
+ ]
+
+ "Created: / 27-07-2015 / 14:50:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
withAllVariableNodesOf: anRBProgramNode do: aBlock
"Enumerate all chilren of `anRBProgramNode` (including itself)
and evaluate `aBlock` for each variable node.
@@ -225,7 +280,7 @@
| classificationId classification |
self error: 'deprecated.'.
classification := node extendClassification: node predicate classification.
- classificationId := (compiler idFor: classification prefixed: #classification).
+ classificationId := (compiler idFor: classification defaultName: #classification).
compiler addConstant: classification as: classificationId.
compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.
@@ -266,11 +321,11 @@
startMethodForNode:node
node isMarkedForInline ifTrue:[
compiler startInline: (compiler idFor: node).
- compiler addComment: 'BEGIN inlined code of ' , node printString.
+ compiler codeComment: 'BEGIN inlined code of ' , node printString.
compiler indent.
] ifFalse:[
compiler startMethod: (compiler idFor: node).
- compiler addComment: 'GENERATED by ' , node printString.
+ compiler codeComment: 'GENERATED by ' , node printString.
compiler allocateReturnVariable.
].
@@ -311,6 +366,7 @@
visitActionNode: node
| blockNode blockBody blockNodesVar blockNeedsCollection blockMatches childValueVars |
+ self checkBlockIsInlinable: node block.
blockNode := node block sourceNode copy.
self assert: blockNode arguments size == 1.
blockNodesVar := blockNode arguments first .
@@ -335,7 +391,7 @@
blockNeedsCollection := false.
blockMatches := IdentityDictionary new."Must use IDENTITY dict as nodes have overwritten their #=!!!!!!"
childValueVars := node child preferredChildrenVariableNames.
- self withAllVariableNodesOf: blockBody do:[:variableNode|
+ PPCASTUtilities new withAllVariableNodesOf: blockBody do:[:variableNode|
variableNode name = blockNodesVar name ifTrue:[
"Check if variable node matches..."
variableNode parent isMessage ifTrue:[
@@ -366,7 +422,7 @@
blockNeedsCollection ifTrue:[
"Bad, we have to use the collection.
Replace all references to blockNodeVar to retvalVar..."
- self withAllVariableNodesOf: blockBody do:[:variableNode|
+ PPCASTUtilities new withAllVariableNodesOf: blockBody do:[:variableNode|
variableNode name = blockNodesVar name ifTrue:[
variableNode name: self retvalVar.
].
@@ -404,7 +460,7 @@
compiler code: blockBody.
]
- "Modified: / 19-06-2015 / 07:05:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-07-2015 / 15:49:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitAndNode: node
@@ -434,7 +490,7 @@
| classification classificationId |
classification := node extendClassification: node predicate classification.
- classificationId := compiler idFor: classification prefixed: #classification.
+ classificationId := compiler idFor: classification defaultName: #classification.
compiler addConstant: classification as: classificationId.
compiler add: '(', classificationId, ' at: context peek asInteger)'.
@@ -452,7 +508,7 @@
node character ppcPrintable ifTrue: [
chid := node character storeString
] ifFalse: [
- chid := compiler idFor: node character prefixed: #char.
+ chid := compiler idFor: node character defaultName: #char.
compiler addConstant: (Character value: node character asInteger) as: chid .
].
@@ -536,6 +592,7 @@
visitMappedActionNode: node
| child blockNode blockBody |
+ self checkBlockIsInlinable: node block.
child := node child.
blockNode := node block sourceNode copy.
blockBody := blockNode body.
@@ -569,7 +626,7 @@
| blockArg |
blockArg := blockNode arguments first.
- self withAllVariableNodesOf: blockBody do:[:variableNode|
+ PPCASTUtilities new withAllVariableNodesOf: blockBody do:[:variableNode|
variableNode name = blockArg name ifTrue:[
variableNode name: self retvalVar.
].
@@ -595,7 +652,7 @@
]
"Created: / 02-06-2015 / 17:28:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 19-06-2015 / 07:06:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-07-2015 / 15:49:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitMessagePredicateNode: node
@@ -616,7 +673,7 @@
visitNotCharSetPredicateNode: node
| classificationId classification |
classification := node extendClassification: node predicate classification.
- classificationId := (compiler idFor: classification prefixed: #classification).
+ classificationId := (compiler idFor: classification defaultName: #classification).
compiler addConstant: classification as: classificationId.
compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.
@@ -634,7 +691,7 @@
node character ppcPrintable ifTrue: [
chid := node character storeString
] ifFalse: [
- chid := compiler idFor: node character prefixed: #char.
+ chid := compiler idFor: node character defaultName: #char.
compiler addConstant: (Character value: node character asInteger) as: chid .
].
@@ -707,7 +764,7 @@
visitPluggableNode: node
| blockId |
- blockId := compiler idFor: node block prefixed: #block.
+ blockId := compiler idFor: node block defaultName: #pluggableBlock.
compiler addConstant: node block as: blockId.
compiler codeReturn: blockId, ' value: context.'.
@@ -753,7 +810,7 @@
visitPredicateNode: node
| pid |
- pid := (compiler idFor: node predicate prefixed: #predicate).
+ pid := (compiler idFor: node predicate defaultName: #predicate).
compiler addConstant: node predicate as: pid.
@@ -844,7 +901,7 @@
classification := node extendClassification: node predicate classification.
- classificationId := compiler idFor: classification prefixed: #classification.
+ classificationId := compiler idFor: classification defaultName: #classification.
compiler addConstant: classification as: classificationId.
compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
@@ -876,8 +933,15 @@
self addGuard: node child ifTrue: nil ifFalse: [ compiler codeReturn: '#()' ].
- compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
compiler codeAssignParsedValueOf:[ self visit:node child ] to:elementVar.
+ compiler codeIf: 'error'
+ then: [
+ compiler codeClearError.
+ compiler codeReturn: '#()'.
+ ] else: [
+ compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
+ ].
+
compiler add: '[ error ] whileFalse: ['.
compiler indent.
compiler add: self retvalVar, ' add: ', elementVar, '.'.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCCompilationError.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,23 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Error subclass:#PPCCompilationError
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Exceptions'
+!
+
+!PPCCompilationError class methodsFor:'error signalling'!
+
+signalWith: message
+ ^ self signal: message
+! !
+
+!PPCCompilationError methodsFor:'signaling'!
+
+signalWith: message
+ self signal: message
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCCompilationWarning.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,11 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Warning subclass:#PPCCompilationWarning
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Exceptions'
+!
+
--- a/compiler/PPCCompiler.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCCompiler.st Mon Aug 17 12:13:16 2015 +0100
@@ -141,6 +141,10 @@
currentMethod addOnLine: anotherMethod call.
!
+codeComment: string
+ currentMethod add: '"', string, '"'.
+!
+
dedent
currentMethod dedent
!
@@ -244,9 +248,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
]
!
@@ -259,7 +263,7 @@
self add: variable ,' := ', argument.
] ifTrue: [
"In case an argument has a side effect"
- self add: argument.
+ self add: argument.
]
!
@@ -337,16 +341,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 <jan.vrany@fit.cvut.cz>"
- "Modified: / 01-06-2015 / 21:49:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 01-06-2015 / 21:49:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
codeReturn: code
@@ -565,11 +569,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 <jan.vrany@fit.cvut.cz>"
+ "Modified: / 01-06-2015 / 21:38:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
top
@@ -624,8 +628,10 @@
installMethods
cache keysAndValuesDo: [ :key :method |
- compiledParser compileSilently: method code classified: method category.
+ compiledParser compileSilently: method source classified: method category.
]
+
+ "Modified: / 24-07-2015 / 19:45:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
installVariables
--- a/compiler/PPCCompilerTokenErrorStrategy.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCCompilerTokenErrorStrategy.st Mon Aug 17 12:13:16 2015 +0100
@@ -6,7 +6,7 @@
instanceVariableNames:'compiler'
classVariableNames:''
poolDictionaries:''
- category:'PetitCompiler-Compiler'
+ category:'PetitCompiler-Compiler-Codegen-Straregies'
!
!PPCCompilerTokenErrorStrategy class methodsFor:'as yet unclassified'!
--- a/compiler/PPCCompilerTokenRememberStrategy.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCCompilerTokenRememberStrategy.st Mon Aug 17 12:13:16 2015 +0100
@@ -6,7 +6,7 @@
instanceVariableNames:'compiler'
classVariableNames:''
poolDictionaries:''
- category:'PetitCompiler-Compiler'
+ category:'PetitCompiler-Compiler-Codegen-Straregies'
!
!PPCCompilerTokenRememberStrategy class methodsFor:'instance creation'!
@@ -26,6 +26,7 @@
!PPCCompilerTokenRememberStrategy methodsFor:'as yet unclassified'!
smartRemember: parser to: variableName
+ self error: 'deprecated?'.
parser isContextFree ifTrue: [
compiler codeAssign: 'context lwRemember.'
to: variableName.
--- a/compiler/PPCCompilerTokenizingErrorStrategy.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCCompilerTokenizingErrorStrategy.st Mon Aug 17 12:13:16 2015 +0100
@@ -6,7 +6,7 @@
instanceVariableNames:'compiler'
classVariableNames:''
poolDictionaries:''
- category:'PetitCompiler-Compiler'
+ category:'PetitCompiler-Compiler-Codegen-Straregies'
!
!PPCCompilerTokenizingErrorStrategy class methodsFor:'as yet unclassified'!
--- a/compiler/PPCCompilerTokenizingRememberStrategy.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCCompilerTokenizingRememberStrategy.st Mon Aug 17 12:13:16 2015 +0100
@@ -6,7 +6,7 @@
instanceVariableNames:'compiler'
classVariableNames:''
poolDictionaries:''
- category:'PetitCompiler-Compiler'
+ category:'PetitCompiler-Compiler-Codegen-Straregies'
!
@@ -27,27 +27,50 @@
!PPCCompilerTokenizingRememberStrategy methodsFor:'as yet unclassified'!
smartRemember: parser to: variableName
+ compiler allocateTemporaryVariableNamed: '__position'.
+ compiler allocateTemporaryVariableNamed: '__tokenType'.
+ compiler allocateTemporaryVariableNamed: '__tokenValue'.
+
+ compiler codeAssign: 'context position.' to: '__position'.
+ compiler codeAssign: 'currentTokenType.' to: '__tokenType'.
+ compiler codeAssign: 'currentTokenValue.' to: '__tokenValue'.
+
+false ifFalse: [
parser isContextFree ifTrue: [
- compiler codeAssign: '{ context lwRemember. currentTokenType . currentTokenValue }.'
-" compiler codeAssign: 'context lwRemember.' "
+" compiler codeAssign: '{ context lwRemember. currentTokenType . currentTokenValue }.' "
+ compiler codeAssign: 'scanner position.'
to: variableName.
] ifFalse: [
compiler codeAssign: '{ context remember. currentTokenType . currentTokenValue }.'
to: variableName.
]
+]
!
smartRestore: parser from: mementoName
+ compiler add: 'context lwRestore: __position.'.
+ compiler codeAssign: '__tokenType.' to: 'currentTokenType'.
+ compiler codeAssign: '__tokenValue.' to: 'currentTokenValue'.
+
+
+false ifTrue: [
parser isContextFree ifTrue: [
- compiler add: 'context lwRestore: (', mementoName, ' at: 1).'.
-" compiler add: 'context lwRestore: ', mementoName, '.'."
+" compiler add: 'context lwRestore: (', mementoName, ' at: 1).'."
+ compiler add: 'context lwRestore: ', mementoName, '.'.
] ifFalse: [
compiler add: 'context restore: (', mementoName, ' at: 1).'.
].
+ compiler codeAssign: 'nil.' to: 'currentTokenType'.
+"
compiler codeAssign: '(', mementoName, ' at: 2).' to: 'currentTokenType'.
compiler codeAssign: '(', mementoName, ' at: 3).' to: 'currentTokenValue'.
+"
+"
+ compiler code: 'scanner backtrack.'.
+"
+]
! !
!PPCCompilerTokenizingRememberStrategy class methodsFor:'documentation'!
--- a/compiler/PPCConfiguration.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCConfiguration.st Mon Aug 17 12:13:16 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
@@ -98,7 +98,7 @@
cacheFollowSetWithTokens
"Creates a PPCNodes from a PPParser"
| followSets |
- followSets := ir firstSetsSuchThat: [:e | e isTerminal or: [ e isTokenNode ] ].
+ followSets := ir followSetsSuchThat: [:e | e isTerminal or: [ e isTokenNode ] ].
ir allNodesDo: [ :node |
node followSetWithTokens: (followSets at: node)
]
@@ -106,9 +106,17 @@
!PPCConfiguration methodsFor:'compiling'!
+buildClass: compiler
+ self subclassResponsibility
+!
+
compile: whatever
+ | time |
self input: whatever.
- self invokePhases.
+
+ time := [ self invokePhases ] timeToRun asMilliSeconds.
+ self reportTime: time.
+
^ ir
!
@@ -130,8 +138,12 @@
!PPCConfiguration methodsFor:'hooks'!
+codeCompiler
+ ^ PPCCodeGen on: arguments
+!
+
codeCompilerOn: args
- ^ PPCCompiler on: args
+ ^ PPCCodeGen on: args
!
codeGeneratorVisitorOn: compiler
@@ -178,18 +190,18 @@
!
generate
- | compiler rootMethod compiledParser |
+ | compiler rootMethod compiledParser |
arguments generate ifFalse: [ ^ self ].
- compiler := self codeCompilerOn: arguments.
+ compiler := self codeCompiler.
rootMethod := (self codeGeneratorVisitorOn: compiler)
arguments: arguments;
visit: ir.
- compiler compileParser.
- compiler compiledParser startSymbol: rootMethod methodName.
- compiledParser := compiler compiledParser new.
+ compiledParser := self buildClass: compiler.
+ compiledParser startSymbol: rootMethod methodName.
+ compiledParser := compiledParser new.
ir := compiledParser.
!
@@ -234,3 +246,11 @@
self remember: #ppcNodes
! !
+!PPCConfiguration methodsFor:'reporting'!
+
+reportTime: timeInMs
+ arguments profile ifTrue: [
+ Transcript show: 'Time to compile: ', timeInMs asString, ' ms'; cr.
+ ]
+! !
+
--- a/compiler/PPCDelegateNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCDelegateNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -17,6 +17,7 @@
!
child: whatever
+ self assert: (whatever == self) not.
child := whatever
!
@@ -45,6 +46,7 @@
!PPCDelegateNode methodsFor:'transformation'!
replace: node with: anotherNode
+ self assert: (anotherNode == self) not.
child == node ifTrue: [ child := anotherNode ]
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCDistinctResultStrategy.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,47 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCScannerResultStrategy subclass:#PPCDistinctResultStrategy
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Scanner'
+!
+
+!PPCDistinctResultStrategy methodsFor:'as yet unclassified'!
+
+recordFailure: retval
+ ^ self recordFailure: retval offset: 0
+!
+
+recordFailure: retval offset: offset
+ offset == 0 ifTrue: [
+ codeGen codeRecordDistinctMatch: nil.
+ ^ self
+ ].
+ codeGen codeRecordDistinctMatch: nil offset: offset
+!
+
+recordMatch: retval
+ ^ self recordMatch: retval offset: 0
+!
+
+recordMatch: retval offset: offset
+ offset == 0 ifTrue: [
+ codeGen codeRecordDistinctMatch: retval.
+ ^ self
+ ].
+
+ codeGen codeRecordDistinctMatch: retval offset: offset
+!
+
+reset
+ ^ codeGen code: 'self resetDistinct.'.
+!
+
+returnResult: state
+ codeGen codeNl.
+ codeGen codeReturnDistinct.
+! !
+
--- a/compiler/PPCEndOfFileNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCEndOfFileNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -9,9 +9,26 @@
category:'PetitCompiler-Nodes'
!
+PPCEndOfFileNode class instanceVariableNames:'Instance'
+
+"
+ No other class instance variables are inherited by this class.
+"
+!
+
+!PPCEndOfFileNode class methodsFor:'as yet unclassified'!
+
+instance
+ Instance isNil ifTrue: [
+ Instance := self new.
+ ].
+
+ ^ Instance
+! !
+
!PPCEndOfFileNode methodsFor:'accessing'!
-prefix
+defaultName
^ #eof
! !
--- a/compiler/PPCEndOfInputNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCEndOfInputNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -9,13 +9,29 @@
category:'PetitCompiler-Nodes'
!
-!PPCEndOfInputNode methodsFor:'as yet unclassified'!
+!PPCEndOfInputNode methodsFor:'accessing'!
+
+defaultName
+ ^ #endOfInput
+! !
+
+!PPCEndOfInputNode methodsFor:'analysis'!
+
+acceptsEpsilon
+ ^ false
+!
+
+acceptsEpsilonOpenSet: set
+ ^ false
+!
+
+firstCharSet
+ ^ PPCharSetPredicate on: [:e | true ]
+! !
+
+!PPCEndOfInputNode methodsFor:'visiting'!
accept: visitor
^ visitor visitEndOfInputNode: self
-!
-
-prefix
- ^ #endOfInput
! !
--- a/compiler/PPCFSACodeGen.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCFSACodeGen.st Mon Aug 17 12:13:16 2015 +0100
@@ -3,7 +3,7 @@
"{ NameSpace: Smalltalk }"
PPCCodeGen subclass:#PPCFSACodeGen
- instanceVariableNames:'fsa backlinkStates'
+ instanceVariableNames:'fsa backlinkStates compiler'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Scanner'
@@ -15,88 +15,86 @@
^ '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 |
+codeAssertPeek: t
+ | id |
+ self assert: (t isKindOf: PEGFsaTransition).
+
+ (t isPredicateTransition and: [t isEOF]) ifTrue: [
+ self addOnLine: 'currentChar isNil'.
+ ^ self
+ ].
+
- (self isSingleCharacter: characterSet) ifTrue: [
- character := self character: characterSet.
- self addOnLine: 'self peek == ', character storeString.
+ (t isPredicateTransition) ifTrue: [
+ self addOnLine: t predicate asString, ' value: currentChar codePoint'.
+ ^ self
+ ].
+
+ (t isAny) ifTrue: [
+ self addOnLine: 'true'.
^ self
].
- (self isLetter: characterSet) ifTrue: [
- self addOnLine: 'self peek isLetter'.
+
+ (t isSingleCharacter) ifTrue: [
+ self addOnLine: 'currentChar == ', t character storeString.
+ ^ self
+ ].
+
+ (t isNotSingleCharacter) ifTrue: [
+ self addOnLine: 'currentChar ~~ ', t notCharacter storeString.
^ self
].
- (self isSingleRange: characterSet) ifTrue: [
+ (t isLetter) ifTrue: [
+ self addOnLine: 'currentChar isLetter'.
+ ^ self
+ ].
+
+ (t isWord) ifTrue: [
+ self addOnLine: 'currentChar isAlphaNumeric'.
+ ^ self
+ ].
+
+ (t isDigit) ifTrue: [
+ self addOnLine: 'currentChar isDigit'.
+ ^ self
+ ].
+
+ (t isSingleRange) ifTrue: [
| begin end |
- begin := self beginOfRange: characterSet.
- end := self endOfRange: characterSet.
+ begin := t beginOfRange.
+ end := t endOfRange.
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'.
+ id := idGen cachedSuchThat: [ :e | e = t characterSet ]
+ ifNone: [ self idFor: t characterSet defaultName: 'characterSet' ].
+
+ self addConstant: t characterSet as: id.
+ self addOnLine: '(currentChar isNotNil) and: [', id, ' at: currentChar codePoint ]'.
!
-codeAssertPeek: characterSet ifTrue: block
+codeAssertPeek: transition ifFalse: falseBlock
+ self add: '('.
+ self codeAssertPeek: transition.
+ self addOnLine: ') ifFalse: [ '.
+ falseBlock value.
+ self addOnLine: ']'.
+ self codeDot.
+!
+
+codeAssertPeek: t ifTrue: block
self addOnLine: '('.
- self codeAssertPeek: characterSet.
+ self codeAssertPeek: t.
self addOnLine: ') ifTrue: ['.
self indent.
self code: block.
@@ -104,18 +102,19 @@
self add: ']'.
!
-codeAssertPeek: characterSet orReturn: priority
+codeAssertPeek: transition orReturn: priority
+ self error: 'deprecated'.
self add: '('.
- self codeAssertPeek: characterSet.
+ self codeAssertPeek: transition.
self addOnLine: ') ifFalse: [ '.
self codeReturnResult: priority.
self addOnLine: ']'.
self codeDot.
!
-codeAssertPeek: characterSet whileTrue: block
+codeAssertPeek: transition whileTrue: block
self add: '['.
- self codeAssertPeek: characterSet.
+ self codeAssertPeek: transition.
self addOnLine: '] whileTrue: ['.
self indent.
self code: block.
@@ -162,8 +161,8 @@
self add: '^ self returnPriority: ', priority asString, '.'
!
-codeRecordMatch: state
- self add: 'self recordMatch: ', state storeString, '.'
+codeRecordDistinctMatch: retval offset: value
+ self add: 'self recordDistinctMatch: ', retval storeString, ' offset: ', value storeString, '.'
!
codeRecordMatch: state priority: priority
@@ -191,21 +190,39 @@
self indent.
! !
-!PPCFSACodeGen methodsFor:'helpers'!
+!PPCFSACodeGen methodsFor:'coding - results'!
+
+codeRecordDistinctMatch: retval
+ self add: 'self recordDistinctMatch: ', retval storeString, '.'
+!
+
+codeRecordFailure: index
+ self assert: index isInteger.
+ self add: 'self recordFailure: ', index asString, '.'
+!
-character: characterSet
- self assert: (self isSingleCharacter: characterSet).
- characterSet withIndexDo: [ :e :index | e ifTrue: [ ^ Character codePoint: index ] ].
-
- self error: 'should not happen'
+codeRecordMatch: retval
+ self add: 'self recordMatch: ', retval storeString, '.'
+!
+
+codeRecordMatch: retval offset: offset
+ self add: 'self recordMatch: ', retval storeString, ' offset: ', offset storeString, '.'
+!
+
+codeReturn
+ self addOnLine: '^ self'
+!
+
+codeReturnDistinct
+ self addOnLine: '^ self returnDistinct.'
! !
!PPCFSACodeGen methodsFor:'intitialization'!
initialize
super initialize.
+
+ compiler := PPCCodeGen new.
backlinkStates := IdentityDictionary new.
-
- "Modified: / 24-07-2015 / 15:03:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
--- a/compiler/PPCForwardNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCForwardNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -11,7 +11,12 @@
!PPCForwardNode methodsFor:'accessing'!
-prefix
+child: node
+ "(node name asString beginsWith: 'symbol') ifTrue: [ self halt. ]."
+ ^ super child: node
+!
+
+defaultName
^ #fw
! !
--- a/compiler/PPCGuard.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCGuard.st Mon Aug 17 12:13:16 2015 +0100
@@ -71,7 +71,7 @@
(index > 32 and: [ index < 127 ]) ifTrue: [
compiler add: '(context peek == ', (Character value: index) storeString, ')'
] ifFalse: [
- id := compiler idFor: (Character value: index) prefixed: #character.
+ id := compiler idFor: (Character value: index) defaultName: #character.
compiler addConstant: (Character value: index) as: id.
compiler add: '(context peek = ', id, ')'.
]
@@ -92,12 +92,12 @@
!
testMessage: selector
- classification keysAndValuesDo: [:index :element |
- (element = ((Character value: index) perform: selector)) ifFalse: [
- ^ false
- ]
- ].
- ^ true
+ classification keysAndValuesDo: [:index :element |
+ (element = ((Character value: index) perform: selector)) ifFalse: [
+ ^ false
+ ]
+ ].
+ ^ true
!
testSingleCharacter
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCIdGenerator.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,145 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCIdGenerator
+ instanceVariableNames:'idCache numericIdCache'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Compiler-Codegen'
+!
+
+!PPCIdGenerator class methodsFor:'as yet unclassified'!
+
+new
+ ^ self basicNew initialize
+! !
+
+!PPCIdGenerator methodsFor:'accessing'!
+
+ids
+ ^ idCache keys
+!
+
+numericIdCache
+ ^ numericIdCache
+!
+
+numericIds
+ ^ numericIdCache keys
+! !
+
+!PPCIdGenerator methodsFor:'as yet unclassified'!
+
+asSelector: string
+ "e.g. '234znak 43 ) 2' asLegalSelector = #v234znak432"
+
+ | toUse |
+
+ toUse := string select: [:char | char isAlphaNumeric or: [ char = $_ ] ].
+ (toUse isEmpty or: [ toUse first isLetter not ])
+ ifTrue: [ toUse := 'v', toUse ].
+ toUse first isUppercase ifFalse:[
+ toUse := toUse copy.
+ toUse at: 1 put: toUse first asLowercase
+ ].
+ ^toUse
+
+ "Modified: / 10-05-2015 / 07:29:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+cachedSuchThat: block ifNone: noneBlock
+ | key |
+ key := idCache keys detect: block ifNone: [ nil ].
+ key isNil ifTrue: [ ^ noneBlock value ].
+
+ ^ idCache at: key
+!
+
+generateIdFor: object defaultName: defaultName prefix: prefix suffix: suffix
+ | name count |
+ object canHavePPCId ifTrue: [
+ name := object hasName ifTrue: [ object name ] ifFalse: [ object defaultName ].
+ name := self asSelector: name asString.
+
+ "JK: I am not sure, if prefix and suffix should be applied to the name or not..."
+ suffix isNil ifFalse: [
+ name := name, '_', suffix.
+ ].
+
+ prefix isNil ifFalse: [
+ name := prefix , '_', name.
+ ].
+
+ "(idCache contains: [ :e | e = name ]) ifTrue: [ self error: 'Duplicit names?' ]."
+ ] ifFalse: [
+ name := defaultName.
+
+ prefix isNil ifFalse: [
+ name := prefix , '_', name.
+ ].
+
+ suffix isNil ifFalse: [
+ name := name, '_', suffix.
+ ].
+
+ name := self asSelector: name asString.
+
+ ].
+
+ (idCache contains: [ :e | e = name ]) ifTrue: [
+ count := 2.
+
+ [ | tmpName |
+ tmpName := (name, '_', count asString).
+ idCache contains: [:e | e = tmpName ]
+ ] whileTrue: [ count := count + 1 ].
+
+ name := name, '_', count asString
+ ].
+
+ ^ name asSymbol
+!
+
+idFor: object
+ self assert: object canHavePPCId.
+ ^ self idFor: object defaultName: object defaultName prefix: object prefix suffix: object suffix
+!
+
+idFor: object defaultName: defaultName
+ ^ self idFor: object defaultName: defaultName prefix: nil suffix: nil
+!
+
+idFor: object defaultName: defaultName prefix: prefix
+ ^ self idFor: object defaultName: defaultName prefix: prefix suffix: ''
+!
+
+idFor: object defaultName: defaultName prefix: prefix suffix: suffix
+ ^ idCache at: object ifAbsentPut: [
+ self generateIdFor: object defaultName: defaultName prefix: prefix suffix: suffix
+ ]
+!
+
+isCachedSuchThat: block
+ ^ idCache keys contains: block
+!
+
+isCachedSuchThat: block ifTrue: trueBlock ifFalse: falseBlock
+ ^ (idCache keys contains: block) ifTrue: [trueBlock value] ifFalse: [falseBlock value]
+!
+
+numericIdFor: object
+ self assert: object isSymbol.
+ ^ numericIdCache at: object ifAbsentPut: [
+ numericIdCache at: object put: (numericIdCache size) + 1
+ ]
+! !
+
+!PPCIdGenerator methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ idCache := IdentityDictionary new.
+ numericIdCache := IdentityDictionary new.
+! !
+
--- a/compiler/PPCInlinedMethod.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCInlinedMethod.st Mon Aug 17 12:13:16 2015 +0100
@@ -12,17 +12,35 @@
!PPCInlinedMethod methodsFor:'as yet unclassified'!
call
+ ^ self source
+
+ "Modified: / 24-07-2015 / 19:45:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+callOn: receiver
+ self error: 'are you sure you want to inline code from different receiver? If so, remove me!!'.
^ self code
!
code
- ^ (String streamContents:[:s | buffer codeOn:s ]) trimRight
+ self error: 'deprecated?'.
+ ^ (String streamContents:[:s |" buffer codeOn:s "]) trimRight
"Modified (format): / 01-06-2015 / 21:44:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isInline
^ true
+!
+
+source
+ ^ source isString ifTrue:[
+ source
+ ] ifFalse:[
+ (String streamContents:[:s | source sourceOn:s ]) trimRight
+ ].
+
+ "Created: / 24-07-2015 / 19:46:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCInlinedMethod methodsFor:'code generation - variables'!
--- a/compiler/PPCInliningVisitor.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCInliningVisitor.st Mon Aug 17 12:13:16 2015 +0100
@@ -38,10 +38,16 @@
!
visitActionNode: node
- node child markForInline.
+ "Only mark unnamed sequence nodes for inlining.
+ Named nodes should not be inlined as they should make a method.
+ There's little point in inlining non-sequence nodes, so don't
+ enforce inlining on those. Some (JK :-) may prefer them non-inlined
+ (for debugging purposes)"
+ (node child isSequenceNode and:[node child name isNil]) ifTrue: [ node child markForInline ].
^ super visitActionNode: node.
"Created: / 13-05-2015 / 16:25:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 31-07-2015 / 08:20:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitCharSetPredicateNode: node
@@ -97,10 +103,13 @@
!
visitTokenConsumeNode: node
- super visitTokenConsumeNode: node.
+ "super visitTokenConsumeNode: node."
+
node name isNil ifTrue: [
- self markForInline: node
+ self flag: 'temporarily disabled'.
+ "self markForInline: node"
].
+
^ node
!
@@ -119,8 +128,12 @@
!
visitTokenizingParserNode: node
- self visit: node tokenizer.
+ "skip tokens"
+ "skip whitespace"
+ "self visit: node whitespace."
+
self visit: node parser.
+
^ node
! !
--- a/compiler/PPCMethod.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCMethod.st Mon Aug 17 12:13:16 2015 +0100
@@ -3,7 +3,7 @@
"{ NameSpace: Smalltalk }"
Object subclass:#PPCMethod
- instanceVariableNames:'buffer id variableForReturn category profile'
+ instanceVariableNames:'selector source category variableForReturn'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Compiler-Codegen'
@@ -21,7 +21,12 @@
!PPCMethod methodsFor:'accessing'!
body
+ self error: 'Should no longer be used'.
+ "
^ buffer contents
+ "
+
+ "Modified: / 17-08-2015 / 11:58:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
bridge
@@ -42,50 +47,79 @@
code
^ String streamContents: [ :s |
s nextPutAll: self methodName; cr.
- buffer codeOn: s.
+ source codeOn: s.
]
"Modified: / 01-06-2015 / 21:24:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
id: value
- id := value
+ selector := value
!
indentationLevel
- ^ buffer indentationLevel
+ ^ source indentationLevel
"Created: / 01-06-2015 / 21:38:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
indentationLevel: anInteger
- buffer indentationLevel: anInteger
+ source indentationLevel: anInteger
"Created: / 01-06-2015 / 21:38:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
methodName
- ^ id
+ ^ selector
!
profile
+ self error: 'Should no longer be used'.
+ "
^ profile
+ "
+
+ "Modified: / 17-08-2015 / 11:58:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
profile: aBoolean
+ self error: 'Should no longer be used'.
+ "
profile := aBoolean
+ "
+
+ "Modified: / 17-08-2015 / 11:58:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+source
+ ^ source isString ifTrue:[
+ source
+ ] ifFalse:[
+ String streamContents: [ :s |
+ s nextPutAll: self methodName; cr.
+ source sourceOn:s.
+ ]
+ ].
+
+ "Created: / 24-07-2015 / 19:46:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+source: aString
+ source := aString
+
+ "Created: / 24-07-2015 / 19:48:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCMethod methodsFor:'as yet unclassified'!
add: string
- buffer add: string
+ source add: string
"Modified: / 01-06-2015 / 21:09:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
addOnLine: string
- buffer addOnLine: string
+ source addOnLine: string
"Modified: / 01-06-2015 / 21:09:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -94,16 +128,20 @@
^ 'self ', self methodName, '.'.
!
+callOn: receiver
+ ^ receiver, ' ', self methodName.
+!
+
profilingBegin
self profile ifTrue: [
- ^ ' context methodInvoked: #', id, '.'
+ ^ ' context methodInvoked: #', selector, '.'
].
^ ''
!
profilingEnd
self profile ifTrue: [
- ^ ' context methodFinished: #', id, '.'
+ ^ ' context methodFinished: #', selector, '.'
].
^ ''
! !
@@ -111,7 +149,7 @@
!PPCMethod methodsFor:'code generation'!
code: aStringOrBlockOrRBParseNode
- buffer code: aStringOrBlockOrRBParseNode.
+ source code: aStringOrBlockOrRBParseNode.
"Created: / 01-06-2015 / 22:31:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 01-06-2015 / 23:50:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -120,47 +158,66 @@
codeBlock: contents
| outerBlock innerBlock |
- outerBlock := buffer.
+ outerBlock := source.
innerBlock := PPCCodeBlock new.
innerBlock indentationLevel: outerBlock indentationLevel + 1.
[
outerBlock addOnLine:'['.
- buffer := innerBlock.
- self code: contents.
+ source := innerBlock.
+ self codeOnLine: contents.
] ensure:[
outerBlock
- code: (String streamContents:[:s | innerBlock codeOn: s]);
+ code: (String streamContents:[:s | innerBlock sourceOn:s]);
add:']'.
- buffer := outerBlock.
+ source := outerBlock.
]
"Created: / 01-06-2015 / 22:33:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 03-06-2015 / 06:11:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeOnLine: aStringOrBlockOrRBParseNode
+ source codeOnLine: aStringOrBlockOrRBParseNode.
+
+ "Created: / 01-06-2015 / 22:31:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 01-06-2015 / 23:50:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCMethod methodsFor:'code generation - indenting'!
dedent
- buffer dedent
+ source dedent
"Created: / 01-06-2015 / 21:32:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
indent
- buffer indent
+ source indent
"Created: / 01-06-2015 / 21:32:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
nl
- buffer nl
+ source nl
"Created: / 01-06-2015 / 21:52:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCMethod methodsFor:'code generation - variables'!
+addVariable: name
+ self error: 'Should no longer be used'
+ "
+ (variables includes: name) ifTrue:[
+ self error:'Duplicate variable name, must rename'.
+ ].
+ variables add: name.
+ "
+
+ "Modified: / 17-08-2015 / 11:56:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
allocateReturnVariable
^ variableForReturn isNil ifTrue:[
@@ -189,7 +246,7 @@
"Allocate a new variable with (preferably) given name.
Returns a real variable name that should be used."
- ^ buffer allocateTemporaryVariableNamed: preferredName
+ ^ source allocateTemporaryVariableNamed: preferredName
"Created: / 23-04-2015 / 17:37:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-06-2015 / 21:04:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -210,12 +267,21 @@
"Created: / 23-04-2015 / 18:23:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-06-2015 / 18:14:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+variables
+ self error: 'Should no longer be used'.
+ "
+ ^ ' | ', (variables inject: '' into: [ :s :e | s, ' ', e]), ' |'
+ "
+
+ "Modified: / 17-08-2015 / 11:54:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCMethod methodsFor:'initialization'!
initialize
- buffer := PPCCodeBlock new.
+ source := PPCCodeBlock new.
"Modified: / 01-06-2015 / 21:33:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
@@ -227,7 +293,7 @@
super printOn:aStream.
aStream nextPutAll:' id: '.
- id printOn:aStream.
+ selector printOn:aStream.
"Modified: / 23-04-2015 / 12:32:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
--- a/compiler/PPCNegateNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCNegateNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -11,7 +11,7 @@
!PPCNegateNode methodsFor:'accessing'!
-prefix
+defaultName
^ #negate
! !
--- a/compiler/PPCNilNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCNilNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -12,7 +12,7 @@
!PPCNilNode methodsFor:'accessing'!
-prefix
+defaultName
^ #nil
! !
--- a/compiler/PPCNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -33,6 +33,10 @@
^ #()
!
+defaultName
+ ^ 'node'
+!
+
firstFollowCache
^ self propertyAt: #firstFollowCache ifAbsentPut: [ IdentityDictionary new ]
!
@@ -60,10 +64,14 @@
!
name: anObject
-
+" (anObject asString beginsWith: 'symbolLiteral') ifTrue: [ self halt. ]."
name := anObject
!
+nameOrEmptyString
+ ^ self hasName ifTrue: [ self name ] ifFalse: [ '' ]
+!
+
parser
^ self propertyAt: #parser ifAbsent: [ nil ]
!
@@ -73,11 +81,11 @@
!
prefix
- ^ 'node'
+ ^ nil
!
suffix
- ^ self isMarkedForInline ifTrue: [ '_inlined' ] ifFalse: [ '' ]
+ ^ self isMarkedForInline ifTrue: [ 'inlined' ] ifFalse: [ nil ]
!
unmarkForGuard
@@ -241,12 +249,12 @@
finite := self.
infinite := anotherNode.
] ifFalse: [
- finite := anotherNode.
+ finite := anotherNode.
infinite := self.
].
finite recognizedSentences do: [ :sentence |
- (infinite parser matches: sentence) ifTrue: [ ^ true ].
+ (infinite parser matches: sentence) ifTrue: [ ^ true ].
].
^ false
@@ -502,6 +510,10 @@
^ true
!
+hasName
+ ^ (name == nil) not
+!
+
isMarkedForInline
^ self propertyAt: #inlined ifAbsent: [ false ].
@@ -531,7 +543,10 @@
asFsa
| visitor |
visitor := PEGFsaGenerator new.
- ^ visitor visit: self
+ ^ (visitor visit: self)
+ name: self name;
+ yourself
+
!
replace: node with: anotherNode
--- a/compiler/PPCNodeVisitor.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCNodeVisitor.st Mon Aug 17 12:13:16 2015 +0100
@@ -53,7 +53,8 @@
close: node
self assert: (self isOpen: node) description: 'should be opened first!!'.
-
+ openSet size > 500 ifTrue: [ self error: 'This seems to be a bit too much, isnt it?' ].
+
openSet remove: node.
closeSet add: node
!
@@ -68,6 +69,7 @@
open: node
self assert: (self isOpen: node) not description: 'already opened!!'.
+ openSet size > 100 ifTrue: [ self error: 'This seems to be a bit too much, isnt it?' ].
openSet add: node
!
--- a/compiler/PPCNotCharacterNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCNotCharacterNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -11,7 +11,7 @@
!PPCNotCharacterNode methodsFor:'accessing'!
-prefix
+defaultName
^ #notChar
! !
@@ -38,3 +38,17 @@
^ retval
! !
+!PPCNotCharacterNode methodsFor:'printing'!
+
+printNameOn: aStream
+ super printNameOn: aStream.
+
+ character = $" ifTrue: [
+ "this is hack to allow for printing '' in comments..."
+ aStream nextPutAll: ', '; nextPutAll: '$'''''.
+ ^ self
+ ].
+
+ aStream nextPutAll: ', not('; print: character; nextPutAll: ')'
+! !
+
--- a/compiler/PPCNotLiteralNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCNotLiteralNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -11,12 +11,12 @@
!PPCNotLiteralNode methodsFor:'accessing'!
+defaultName
+ ^ #notLit
+!
+
firstCharSet
^ PPCharSetPredicate on: [:e | true ]
-!
-
-prefix
- ^ #notLit
! !
!PPCNotLiteralNode methodsFor:'visiting'!
--- a/compiler/PPCNotNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCNotNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -11,7 +11,7 @@
!PPCNotNode methodsFor:'accessing'!
-prefix
+defaultName
^ #not
! !
--- a/compiler/PPCOptionalNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCOptionalNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -11,7 +11,7 @@
!PPCOptionalNode methodsFor:'accessing'!
-prefix
+defaultName
^ #opt
! !
--- a/compiler/PPCPluggableNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCPluggableNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -22,7 +22,7 @@
block := anObject
!
-prefix
+defaultName
^ #plug
! !
--- a/compiler/PPCPlusNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCPlusNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -18,16 +18,16 @@
!PPCPlusNode methodsFor:'as yet unclassified'!
+defaultName
+ ^ #plus
+!
+
followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet suchThat: aBlock
| first |
super followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet suchThat: aBlock.
first := aFirstDictionary at: self.
(aFollowDictionary at: child) addAll: (first reject: [:each | each isNullable])
-!
-
-prefix
- ^ #plus
! !
!PPCPlusNode methodsFor:'visiting'!
--- a/compiler/PPCProfilingContext.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCProfilingContext.st Mon Aug 17 12:13:16 2015 +0100
@@ -11,6 +11,13 @@
!
+!PPCProfilingContext methodsFor:'accessing'!
+
+position: value
+ self assert: value isInteger.
+ super position: value
+! !
+
!PPCProfilingContext methodsFor:'gt'!
gtReport: composite
--- a/compiler/PPCRecognizerComponentDetector.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCRecognizerComponentDetector.st Mon Aug 17 12:13:16 2015 +0100
@@ -21,6 +21,11 @@
^ node
!
+visitTokenConsumeNode: node
+ "Let the scanner handle this stuff"
+ ^ node
+!
+
visitTokenNode: node
| child newChild |
@@ -32,6 +37,30 @@
^ node
!
+visitTokenWhitespaceNode: node
+ | child newChild |
+ self change.
+ child := node child.
+ newChild := self visitWithRecognizingComponentVisitor: child.
+ node replace: child with: newChild.
+
+ ^ node
+!
+
+visitTokenizingParserNode: node
+ | newWhitespace |
+ self change.
+ newWhitespace := self visitWithRecognizingComponentVisitor: node whitespace.
+ node replace: node whitespace with: newWhitespace.
+
+ "Do not visit tokens, they will be handled by the scanner:"
+ "self visit: node tokens."
+
+ self visitChild: node parser of: node.
+
+ ^ node
+!
+
visitTrimmingTokenNode: node
| child newChild whitespace newWhitespace |
--- a/compiler/PPCRecognizerComponentVisitor.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCRecognizerComponentVisitor.st Mon Aug 17 12:13:16 2015 +0100
@@ -39,7 +39,6 @@
visitSequenceNode: node
self visitChildren: node.
-
self change.
^ PPCRecognizingSequenceNode new
children: node children;
--- a/compiler/PPCRecognizingSequenceNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCRecognizingSequenceNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -12,7 +12,7 @@
!PPCRecognizingSequenceNode methodsFor:'accessing'!
suffix
- ^ super suffix, '_fast'
+ ^ super suffix isNil ifTrue: [ 'fast' ] ifFalse: [ super suffix, '_fast' ]
! !
!PPCRecognizingSequenceNode methodsFor:'visiting'!
--- a/compiler/PPCScanner.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCScanner.st Mon Aug 17 12:13:16 2015 +0100
@@ -3,14 +3,35 @@
"{ NameSpace: Smalltalk }"
Object subclass:#PPCScanner
- instanceVariableNames:'matches stream maxPriority currentChar'
+ instanceVariableNames:'match matchPosition matches tokens stream currentChar
+ maxSymbolNumber position'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Scanner'
!
+!PPCScanner class methodsFor:'as yet unclassified'!
+
+acceptsLoggingOfCompilation
+" ^ self == PPCScanner"
+ ^ true
+! !
+
!PPCScanner methodsFor:'accessing'!
+maxSymbolNumber
+ ^ maxSymbolNumber
+!
+
+maxSymbolNumber: value
+ maxSymbolNumber := value
+!
+
+position
+ "returns the start position before the scan method..."
+ ^ position
+!
+
stream
^ stream
!
@@ -19,49 +40,185 @@
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.
+
+ maxSymbolNumber := self class classVarNamed: #MaxSymbolNumber.
+ tokens := self class classVarNamed: #Tokens.
+
+ matches := Array new: maxSymbolNumber withAll: -2.
+ position := 0.
+!
+
+reset
+ matchPosition := nil. "This flag says that multimode run the last time"
+
+ position := stream position.
+" matches := Array new: maxSymbolNumber."
+!
+
+reset: tokenList
+ "Method should not be used, it is here for debugging and testing purposes"
+ self error: 'deprecated'.
+
+ matchPosition := nil. "This flag says that multimode run the last time"
+
+ tokens := tokenList.
+ matches := Array new: tokens size.
+
+!
+
+resetDistinct
+" matches := IdentityDictionary new. "
+ match := nil.
+ matchPosition := -1. "this is a flag that the distnict mode was running"
+" matches := nil."
+
+ position := stream position.
+
+! !
+
+!PPCScanner methodsFor:'results'!
+
+backtrack
+ matchPosition := nil.
+ match := nil.
+ matches := Array new: maxSymbolNumber withAll: -2.
+ position := 0.
+!
+
+backtrackDistinct
+ matchPosition := nil.
+ match := nil.
+ position := 0.
+!
+
+backtracked
+ ^ position == 0
+!
+
+indexOf: symbol
+ (1 to: tokens size) do: [ :index | (tokens at: index) == symbol ifTrue: [^ index ] ].
+!
+
+match
+" ^ match isNil not."
+ ^ match isNotNil
+" ^ matchPosition isNil not"
+!
+
+match: symbolNumber
+" matches isNil ifTrue: [ ^ false ]."
+
+ "
+ The general idea here is optimization. I cannot initialize
+ the matches before each token, it would be too expensive.
+ "
+ ^ (matches at: symbolNumber) > position
+!
+
+matchSymbol: symbol
+ matches isNil ifTrue: [ ^ false ].
+ (1 to: tokens size) do: [ :index | (tokens at: index) == symbol ifTrue: [
+ ^ (matches at: index) > position
+ ] ].
+!
+
+polyResult
+ | dictionary |
+ "TODO JK: refactor"
+ self isSingleMatch ifFalse: [
+ dictionary := IdentityDictionary new.
+ (1 to: matches size) do: [ :index |
+ (self match: index) ifTrue: [
+ dictionary
+ at: (tokens at: index)
+ put: (matches at: index)
+ ]
+ ].
+ ^ dictionary
+ ].
+
+ dictionary := IdentityDictionary new.
+ match isNil ifFalse: [
+ dictionary at: match put: matchPosition.
+ ].
+
+ ^ dictionary
+!
+
+result
+ ^ match
+!
+
+resultPosition
+ ^ matchPosition
+!
+
+resultPosition: symbolNumber
+ ^ matches at: symbolNumber
+!
+
+resultPositionForSymbol: symbol
+ tokens isNil ifTrue: [ ^ false ].
+ (1 to: tokens size) do: [ :index | (tokens at: index) == symbol ifTrue: [
+ ^ matches at: index
+ ] ].
+! !
+
+!PPCScanner methodsFor:'results - distinct'!
+
+recordDistinctMatch: matchValue
+ match := matchValue.
+ matchPosition := stream position.
+!
+
+recordDistinctMatch: matchValue offset: offset
+ match := matchValue.
+ currentChar isNil ifFalse: [
+ matchPosition := stream position - offset.
+ ] ifTrue: [
+ matchPosition := stream position.
+ ]
+!
+
+returnDistinct
+ ^ match isNotNil
+! !
+
+!PPCScanner methodsFor:'results - universal'!
+
+recordFailure: index
+ matches at: index put: -1.
+!
+
+recordFailure: index offset: offset
+ matches at: index put: -1.
+!
+
+recordMatch: index
+ matches at: index put: stream position.
+!
+
+recordMatch: index offset: offset
+ currentChar isNil ifFalse: [
+ matches at: index put: stream position - offset.
+ ] ifTrue: [
+ matches at: index put: stream position.
+ ].
+
+!
+
+return
+ ^ matches
! !
!PPCScanner methodsFor:'scanning'!
-consumeConditionally: character
- ^ (stream peek == character) ifTrue: [ stream next. true ] ifFalse: [ false ]
-!
-
next
+ self error: 'deprecated?'.
stream next
!
@@ -71,10 +228,16 @@
peekBetween: start and: stop
(currentChar == nil) ifTrue: [ ^ false ].
- ^ start <= currentChar codePoint and: [ currentChar codePoint <= stop ]
+ ^ (start <= currentChar codePoint) and: [ currentChar codePoint <= stop ]
!
step
currentChar := stream next
! !
+!PPCScanner methodsFor:'testing'!
+
+isSingleMatch
+ ^ (matchPosition == nil) not
+! !
+
--- a/compiler/PPCScannerCodeGenerator.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCScannerCodeGenerator.st Mon Aug 17 12:13:16 2015 +0100
@@ -4,7 +4,7 @@
Object subclass:#PPCScannerCodeGenerator
instanceVariableNames:'codeGen fsa backlinkStates backlinkTransitions arguments openSet
- joinPoints incommingTransitions methodCache id'
+ incommingTransitions methodCache id resultStrategy fsaCache'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Scanner'
@@ -18,6 +18,14 @@
arguments: anObject
arguments := anObject
+!
+
+codeGen
+ ^ codeGen
+!
+
+compiler
+ ^ self codeGen
! !
!PPCScannerCodeGenerator methodsFor:'analysis'!
@@ -31,16 +39,17 @@
].
!
-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.
+analyzeDistinctRetvals
+ (fsa hasDistinctRetvals) ifTrue: [
+ resultStrategy := PPCDistinctResultStrategy new
+ codeGen: codeGen;
+ yourself
+ ] ifFalse: [
+ resultStrategy := PPCUniversalResultStrategy new
+ codeGen: codeGen;
+ tokens: fsa retvals asArray;
+ yourself
]
-
!
analyzeTransitions
@@ -58,17 +67,6 @@
^ 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 ]
@@ -93,37 +91,62 @@
^ (self backlinksTo: state) isEmpty not
!
-isJoinPoint: state
- "Please note that joinPoints are removed as the compilaction proceeds"
- ^ joinPoints keys includes: state
+startsSimpleLoop: state
+ | |
+
+ "
+ This accepts more or less something like $a star
+ for now.. might extend later
+ "
+ ((self incommingTransitionsFor: state) size == 2) ifFalse: [ ^ false ].
+ ^ (state transitions select: [ :t | t destination == state ]) size == 1
+
+! !
+
+!PPCScannerCodeGenerator methodsFor:'caching'!
+
+cache: anFsa method: method
+ fsaCache at: anFsa put: method
!
-joinTransitionsTo: joinPoint "state"
- ^ joinPoints at: joinPoint ifAbsent: [ #() ]
+cachedValueForIsomorphicFsa: anFsa
+ | key |
+ key := fsaCache keys detect: [ :e | e isIsomorphicTo: anFsa ].
+ ^ fsaCache at: key
+!
+
+isomorphicIsCached: anFsa
+ ^ fsaCache keys anySatisfy: [ :e | e isIsomorphicTo: anFsa ]
! !
!PPCScannerCodeGenerator methodsFor:'code generation'!
generate
+ | method |
self assert: fsa isDeterministic.
self assert: fsa isWithoutEpsilons.
self assert: fsa checkConsistency.
+ (self isomorphicIsCached: fsa) ifTrue: [
+ ^ self cachedValueForIsomorphicFsa: fsa
+ ].
self analyzeBacklinks.
- self analyzeJoinPoints.
self analyzeTransitions.
+ self analyzeDistinctRetvals.
openSet := IdentitySet new.
-
codeGen startMethod: (codeGen idFor: fsa).
codeGen codeComment: (Character codePoint: 13) asString, fsa asString.
+ resultStrategy reset.
self generateFor: fsa startState.
- codeGen stopMethod.
-
- ^ self compileScannerClass new
+ method := codeGen stopMethod.
+ self cache: fsa method: method.
+
+ ^ method.
+
!
@@ -131,50 +154,66 @@
generate: aPEGFsa
fsa := aPEGFsa.
- fsa compact.
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutPriorities.
+
+ fsa minimize.
fsa checkSanity.
^ self generate
!
+generateAndCompile
+ self generate.
+ ^ self compile
+!
+
+generateAndCompile: aPEGFsa
+ fsa := aPEGFsa.
+
+ fsa minimize.
+ fsa checkSanity.
+
+ ^ self generateAndCompile
+!
+
generateFinalFor: state
- state isFinal ifFalse: [ ^ self ].
+ ^ self generateFinalFor: state offset: 0
+!
- codeGen codeRecordMatch: state retval priority: state priority.
+generateFinalFor: state offset: offset
+ state retvalsAndInfosDo: [:retval :info |
+ info isFinal ifTrue: [
+ info isFsaFailure ifTrue: [
+ resultStrategy recordFailure: retval offset: offset
+ ] ifFalse: [
+ resultStrategy recordMatch: retval offset: offset
+ ]
+ ].
+ ]
!
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 startsSimpleLoop: state) ifTrue: [
+ ^ self generateSimpleLoopFor: state
].
-"
- self generateFinalFor: state.
- self generateNextFor: state.
- self generateTransitionsFor: state.
-
-" (self isBacklinkDestination: state) ifTrue: [
- codeGen codeEndBlockWhileTrue.
- ].
-"
- self generateStopMethod: state.
+
+ ^ self generateStandardFor: state
!
generateForSingleTransition: t from: state.
(self isJoinPoint: t destination) ifTrue: [ self removeJoinTransition: t ].
- codeGen codeAssertPeek: (t characterSet) orReturn: state priority.
+ codeGen codeAssertPeek: t ifFalse: [
+ resultStrategy returnResult: state
+ ].
" (self isBacklink: t) ifTrue: [
codeGen add: 'true'
] ifFalse: [
@@ -184,9 +223,7 @@
self generateFor: t destination
!
-generateForTransition: t from: state
- (self isJoinPoint: t destination) ifTrue: [ self removeJoinTransition: t ].
-
+generateForTransition: t from: state
" (self isBacklink: t) ifTrue: [
codeGen codeAssertPeek: (t characterSet) ifTrue: [
codeGen add: 'true'
@@ -197,7 +234,7 @@
].
].
"
- codeGen codeAssertPeek: (t characterSet) ifTrue: [.
+ codeGen codeAssertPeek: t ifTrue: [.
self generateFor: t destination.
].
codeGen codeIfFalse.
@@ -209,7 +246,33 @@
!
generateReturnFor: state
- codeGen codeNlReturnResult: state priority.
+ codeGen codeNl.
+ resultStrategy returnResult: state.
+!
+
+generateSimpleLoopFor: state
+ | selfTransition |
+ selfTransition := state transitions detect: [ :t | t destination == state ].
+
+ codeGen codeStartBlock.
+ codeGen codeNextChar.
+ codeGen codeNl.
+ codeGen codeAssertPeek: selfTransition.
+ codeGen codeEndBlockWhileTrue.
+
+ "Last transition did not passed the loop, therefore, we have to record succes with offset -1"
+ self generateFinalFor: state offset: 1.
+ self generateTransitions: (state transitions reject: [ :t | t == selfTransition ]) for: state.
+
+!
+
+generateStandardFor: state
+ self generateStartMethod: state.
+ self generateFinalFor: state.
+ self generateNextFor: state.
+ self generateTransitionsFor: state.
+
+ self generateStopMethod: state.
!
generateStartMethod: state.
@@ -234,20 +297,19 @@
codeGen codeComment: 'STOP - Generated from state: ', state asString.
!
-generateTransitionsFor: state
- (state transitions size = 0) ifTrue: [
+generateTransitions: transitions for: state
+ (transitions size = 0) ifTrue: [
self generateReturnFor: state.
^ self
].
- (state transitions size = 1) ifTrue: [
+" (state transitions size = 1) ifTrue: [
self generateForSingleTransition: state transitions anyOne from: state.
^ self
- ].
-
+ ]."
codeGen codeNl.
- state transitions do: [ :t |
+ transitions do: [ :t |
self generateForTransition: t from: state
].
@@ -255,7 +317,7 @@
self generateReturnFor: state.
codeGen dedent.
codeGen codeNl.
- state transitions size timesRepeat: [ codeGen addOnLine: ']' ].
+ transitions size timesRepeat: [ codeGen addOnLine: ']' ].
codeGen addOnLine: '.'.
@@ -268,12 +330,38 @@
self generateFor: jp.
]
"
+!
+
+generateTransitionsFor: state
+ ^ self generateTransitions: state transitions for: state
+!
+
+setMaxNumericId
+ codeGen addConstant: codeGen idGen numericIds size as: #MaxSymbolNumber
+!
+
+setTokens
+ | tokens |
+ tokens := Array new: codeGen idGen numericIdCache size.
+
+ codeGen idGen numericIdCache keysAndValuesDo: [ :key :value |
+ tokens at: value put: key
+ ].
+
+ codeGen addConstant: tokens as: #Tokens
! !
!PPCScannerCodeGenerator methodsFor:'compiling'!
+compile
+ ^ self compileScannerClass new
+!
+
compileScannerClass
| builder |
+ self setMaxNumericId.
+ self setTokens.
+
builder := PPCClassBuilder new.
builder compiledClassName: arguments scannerName.
@@ -291,16 +379,6 @@
codeGen := PPCFSACodeGen new.
arguments := PPCArguments default.
+ fsaCache := IdentityDictionary new.
! !
-!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' ].
-! !
-
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCScannerResultStrategy.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,21 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCScannerResultStrategy
+ instanceVariableNames:'codeGen'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Scanner'
+!
+
+!PPCScannerResultStrategy methodsFor:'accessing'!
+
+codeGen
+ ^ codeGen
+!
+
+codeGen: anObject
+ codeGen := anObject
+! !
+
--- a/compiler/PPCSequenceNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCSequenceNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -11,6 +11,10 @@
!PPCSequenceNode methodsFor:'accessing'!
+defaultName
+ ^ #seq
+!
+
preferredChildrenVariableNames
"Return an array of preferred variable names of variables where to store
particular child's result value."
@@ -49,10 +53,6 @@
"Created: / 04-06-2015 / 23:09:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-prefix
- ^ #seq
-!
-
returnParsedObjectsAsCollection
^ self propertyAt: #returnParsedObjectsAsCollection ifAbsent:[ true ]
@@ -117,7 +117,7 @@
child recognizedSentences do: [ :suffix |
retval do: [ :prefix |
set add: prefix, suffix.
- ]
+ ]
].
retval := set.
].
--- a/compiler/PPCSpecializingVisitor.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCSpecializingVisitor.st Mon Aug 17 12:13:16 2015 +0100
@@ -181,6 +181,17 @@
^ node
!
+visitTokenConsumeNode: node
+ "Let the Scanner to handle this stuff"
+ ^ node
+!
+
+visitTokenizingParserNode: node
+ self visitChild: node whitespace of: node.
+ self visitChild: node parser of: node.
+ ^ node
+!
+
visitTrimmingTokenNode: node
self visitChildren: node.
--- a/compiler/PPCStarAnyNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCStarAnyNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -11,7 +11,7 @@
!PPCStarAnyNode methodsFor:'as yet unclassified'!
-prefix
+defaultName
^ #starAny
! !
--- a/compiler/PPCStarCharSetPredicateNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCStarCharSetPredicateNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -27,10 +27,6 @@
predicate: anObject
predicate := anObject
-!
-
-prefix
- ^ #starPredicate
! !
!PPCStarCharSetPredicateNode methodsFor:'comparing'!
--- a/compiler/PPCStarMessagePredicateNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCStarMessagePredicateNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -11,6 +11,10 @@
!PPCStarMessagePredicateNode methodsFor:'accessing'!
+defaultName
+ ^ #starPredicate
+!
+
firstCharSet
^ PPCharSetPredicate on: [:char | char perform: message ]
!
@@ -23,10 +27,6 @@
message: anObject
message := anObject
-!
-
-prefix
- ^ #starPredicate
! !
!PPCStarMessagePredicateNode methodsFor:'comparing'!
--- a/compiler/PPCStarNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCStarNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -19,7 +19,7 @@
^ true
!
-prefix
+defaultName
^ #star
! !
--- a/compiler/PPCTokenCodeGenerator.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCTokenCodeGenerator.st Mon Aug 17 12:13:16 2015 +0100
@@ -2,88 +2,281 @@
"{ NameSpace: Smalltalk }"
-PPCCodeGenerator subclass:#PPCTokenCodeGenerator
- instanceVariableNames:''
+PPCNodeVisitor subclass:#PPCTokenCodeGenerator
+ instanceVariableNames:'compiler scannerGenerator fsaCache'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Visitors'
!
-!PPCTokenCodeGenerator methodsFor:'as yet unclassified'!
+!PPCTokenCodeGenerator methodsFor:'accessing'!
+
+arguments: args
+ super arguments: args.
+ scannerGenerator arguments: args
+!
+
+compiler
+ ^ compiler
+!
+
+compiler: anObject
+ compiler := anObject.
+
+ scannerGenerator compiler idGen: compiler idGen.
+! !
+
+!PPCTokenCodeGenerator methodsFor:'code support'!
+
+consumeWhitespace: node
+ self assert: node isTokenNode.
+
+ node isTrimmingTokenNode ifTrue: [
+ compiler code: 'self consumeWhitespace.'
+ ]
+!
-afterAccept: node retval: retval
- | return |
- return := super afterAccept: node retval: retval.
- return category: 'generated - tokens'.
- ^ return
+createTokenInsance: node id: idCode start: startVar end: endVar
+ compiler codeTranscriptShow: 'current token type: ', idCode.
+ compiler codeAssign: idCode, '.' to: 'currentTokenType'.
+ compiler codeAssign: node tokenClass asString, ' on: (context collection)
+ start: ', startVar, '
+ stop: ', endVar, '
+ value: nil.'
+ to: 'currentTokenValue'.
+!
+
+scan: node start: startVar end: endVar
+ node child hasName ifFalse: [
+ node child name: node name
+ ].
+
+ compiler codeAssign: 'context position + 1.' to: startVar.
+ compiler add: ((self generateScan: node child) callOn: 'scanner').
+!
+
+unorderedChoiceFromFollowSet: followSet
+ | followFsas |
+
+ ^ fsaCache at: followSet ifAbsentPut: [
+ followFsas := followSet collect: [ :followNode |
+ (followNode asFsa)
+ name: (compiler idFor: followNode);
+ retval: (compiler idFor: followNode);
+ yourself
+ ].
+ self unorderedChoiceFromFsas: followFsas.
+ ]
+
!
-fromTokenMode
- compiler rememberStrategy: (PPCCompilerTokenizingRememberStrategy on: compiler).
- compiler errorStrategy: (PPCCompilerTokenizingErrorStrategy on: compiler).
+unorderedChoiceFromFsas: fsas
+ | result startState |
+ result := PEGFsa new.
+ startState := PEGFsaState new.
+
+ result addState: startState.
+ result startState: startState.
+
+ fsas do: [ :fsa |
+ result adopt: fsa.
+ result addTransitionFrom: startState to: fsa startState.
+ ].
+
+ result determinizeStandard.
+ ^ result
+! !
+
+!PPCTokenCodeGenerator methodsFor:'compiling support'!
+
+compileScanner
+ ^ scannerGenerator compileScannerClass
+!
+
+retvalVar
+ ^ compiler currentReturnVariable
+!
+
+startMethodForNode:node
+ node isMarkedForInline ifTrue:[
+ compiler startInline: (compiler idFor: node).
+ compiler codeComment: 'BEGIN inlined code of ' , node printString.
+ compiler indent.
+ ] ifFalse:[
+ compiler startMethod: (compiler idFor: node).
+ compiler currentMethod category: 'generated - tokens'.
+ compiler codeComment: 'GENERATED by ' , node printString.
+ compiler allocateReturnVariable.
+ ]
!
-toTokenMode
- compiler rememberStrategy: (PPCCompilerTokenRememberStrategy on: compiler).
- compiler errorStrategy: (PPCCompilerTokenErrorStrategy on: compiler).
+stopMethodForNode:aPPCNode
+ ^ aPPCNode isMarkedForInline ifTrue:[
+ compiler dedent.
+ compiler add: '"END inlined code of ' , aPPCNode printString , '"'.
+ compiler stopInline.
+ ] ifFalse:[
+ compiler stopMethod
+ ].
+! !
+
+!PPCTokenCodeGenerator methodsFor:'initialization'!
+
+initialize
+ super initialize.
+
+ scannerGenerator := PPCScannerCodeGenerator new.
+ scannerGenerator arguments: arguments.
+
+ "for the given set of nodes, remember the unordered choice fsa
+ see `unorderedChoiceFromFollowSet:`
+ "
+ fsaCache := Dictionary new.
+! !
+
+!PPCTokenCodeGenerator methodsFor:'scanning'!
+
+generateNextScan: node
+ | epsilon followSet anFsa |
+ followSet := node followSetWithTokens.
+
+ epsilon := followSet anySatisfy: [ :e | e acceptsEpsilon ].
+ followSet := followSet reject: [ :e | e acceptsEpsilon ].
+ epsilon ifTrue: [ followSet add: PPCEndOfFileNode instance ].
+
+ anFsa := self unorderedChoiceFromFollowSet: followSet.
+
+ anFsa name: 'nextToken_', (compiler idFor: node).
+ node nextFsa: anFsa.
+ ^ scannerGenerator generate: anFsa.
+!
+
+generateScan: node
+ | anFsa |
+ anFsa := node asFsa determinize.
+ anFsa name: (compiler idFor: node).
+ anFsa retval: (compiler idFor: node).
+
+ ^ scannerGenerator generate: anFsa.
! !
!PPCTokenCodeGenerator methodsFor:'visiting'!
-visitOptionalNode: node
- compiler
- codeAssignParsedValueOf:[ self visit:node child ]
- to:self retvalVar.
- compiler codeAssign: 'false.' to: 'error'.
- compiler codeReturn.
-!
+visitToken: tokenNode
+ | id startVar endVar numberId |
+ self startMethodForNode: tokenNode.
-visitTokenNode: node
- | id startVar endVar |
"Tokens cannot be inlined,
- their result is true/false
- the return value is always stored in currentTokenValue
- the current token type is always stored in currentTokenType
"
- self assert: node isMarkedForInline not.
+ self assert: tokenNode isMarkedForInline not.
startVar := compiler allocateTemporaryVariableNamed: 'start'.
- endVar := compiler allocateTemporaryVariableNamed: 'end'.
-
- id := compiler idFor: node.
- self toTokenMode.
-
- compiler add: 'currentTokenType isNil ifFalse: [ ^ currentTokenType == ', id storeString, '].'.
+ endVar := compiler allocateTemporaryVariableNamed: 'end'.
+
+ id := compiler idFor: tokenNode.
+ numberId := compiler numberIdFor: id.
+
+ compiler add: 'currentTokenType isNil ifFalse: [ ^ currentTokenType == ', id storeString, '].'.
+
+" compiler codeComment: 'number for: ', id storeString, ' is: ', numberId storeString.
+ compiler codeIf: 'scanner match: ', numberId storeString then: [
+ compiler codeAssign: '(scanner resultPosition: ', numberId storeString, ').' to: endVar.
+ self createTokenInsance: tokenNode
+ id: id storeString
+ start: '(context position + 1)'
+ end: endVar.
+
+ compiler code: 'context position: ', endVar, '.'.
+
+ self consumeWhitespace: tokenNode.
+ compiler codeReturn: 'true'.
+ ].
+ compiler codeIf: 'scanner backtracked not' then: [
+ compiler codeReturn: 'false'.
+ ].
+ compiler codeComment: 'No match, no fail, scanner does not know about this...'.
+"
compiler profileTokenRead: id.
- node allNodes size > 2 ifTrue: [
- self addGuard: node ifTrue: nil ifFalse: [ compiler addOnLine: '^ false' ].
+" self scan: tokenNode start: startVar end: endVar."
+ " compiler add: 'self assert: scanner isSingleMatch.'."
+" compiler codeIf: 'scanner match ' then: ["
+
+ tokenNode child hasName ifFalse: [
+ tokenNode child name: tokenNode name
].
+ compiler codeAssign: 'context position + 1.' to: startVar.
+ compiler codeIf: [ compiler code: ((self generateScan: tokenNode child) callOn: 'scanner') ] then: [
+ compiler add: 'context position: scanner resultPosition.'.
+ compiler codeAssign: 'context position.' to: endVar.
+ self consumeWhitespace: tokenNode.
+ self createTokenInsance: tokenNode id: id storeString start: startVar end: endVar.
+ compiler codeReturn: 'true'.
+ ] else: [
+ compiler code: 'scanner backtrackDistinct.'.
+ compiler code: 'context position: ', startVar, ' - 1.'.
+ compiler codeReturn: 'false'.
+ ].
- compiler codeAssign: 'context position + 1.' to: startVar.
- compiler codeAssignParsedValueOf:[ self visit:node child ] to:#whatever.
- compiler add: 'error ifTrue: [ ^ error := false ].'.
+ ^ self stopMethodForNode: tokenNode
+!
- compiler codeAssign: 'context position.' to: endVar.
+visitTokenConsumeNode: node
+ | id nextScan |
+ self startMethodForNode: node.
+ id := (compiler idFor: node child).
+
+ compiler add: 'self ', id asString, ' ifTrue: ['.
+ compiler indent.
- compiler codeTranscriptShow: 'current token type: ', id storeString.
- compiler codeAssign: id storeString, '.' to: 'currentTokenType'.
- compiler codeAssign: node tokenClass asString, ' on: (context collection)
- start: ', startVar, '
- stop: ', endVar, '
- value: nil.'
- to: 'currentTokenValue := ', self retvalVar.
-
+ nextScan := self generateNextScan: node.
+
+ node nextFsa hasDistinctRetvals ifTrue: [
+ compiler codeAssign: 'currentTokenValue.' to: self retvalVar.
- compiler codeClearError.
- compiler add: '^ true'.
+ compiler add: (nextScan callOn: 'scanner'), '.'.
+ compiler codeIf: 'scanner match' then: [
+ compiler add: 'context position: scanner resultPosition.'.
+ self createTokenInsance: node child
+ id: 'scanner result'
+ start: 'scanner position + 1'
+ end: 'scanner resultPosition'.
+ self consumeWhitespace: node child.
+ compiler codeReturn.
+ ] else: [
+ compiler codeComment: 'Looks like there is an error on its way...'.
+ compiler code: 'context position: scanner position.'.
+ compiler codeAssign: 'nil.' to: 'currentTokenType'.
+ compiler codeReturn.
+ ]
- self fromTokenMode.
+ ] ifFalse: [
+ compiler codeAssign: 'nil.' to: 'currentTokenType'.
+ compiler codeReturn: 'currentTokenValue'.
+ ].
+ compiler dedent.
+
+ "Token not found"
+ compiler add: '] ifFalse: ['.
+ compiler indent.
+ compiler codeError: id asString, ' expected'.
+ compiler dedent.
+ compiler add: '].'.
+
+ ^ self stopMethodForNode: node
+!
+
+visitTokenNode: node
+ ^ self visitToken: node
!
visitTrimmingTokenCharacterNode: node
| id |
+ self startMethodForNode:node.
"Tokens cannot be inlined,
- their result is true/false
@@ -93,82 +286,22 @@
self assert: node isMarkedForInline not.
id := compiler idFor: node.
- self toTokenMode.
compiler add: 'currentTokenType isNil ifFalse: [ ^ currentTokenType == ', id storeString, '].'.
compiler profileTokenRead: id.
- self addGuard: node ifTrue: nil ifFalse: [ compiler addOnLine: ' ^ false' ].
-
+ compiler add: '(context peek == ', node child character storeString, ') ifFalse: [ ^ false ].'.
compiler add: 'context next.'.
- compiler codeTranscriptShow: 'current token type: ', id storeString.
- compiler codeAssign: id storeString, '.' to: 'currentTokenType'.
- compiler codeAssign: node tokenClass asString, ' on: (context collection)
- start: context position
- stop: context position
- value: nil.'
- to: 'currentTokenValue := ', self retvalVar.
+ self createTokenInsance: node id: id storeString start: 'context position' end: 'context position'.
+ self consumeWhitespace: node.
- compiler addComment: 'Consume Whitespace:'.
- compiler
- codeAssignParsedValueOf:[ self visit:node whitespace ]
- to:#whatever.
- compiler nl.
-
- compiler add: '^ true'.
+ compiler codeReturn: 'true'.
- self fromTokenMode.
+ ^ self stopMethodForNode: node
!
visitTrimmingTokenNode: node
- | id startVar endVar |
-
- "Tokens cannot be inlined,
- - their result is true/false
- - the return value is always stored in currentTokenValue
- - the current token type is always stored in currentTokenType
- "
- self assert: node isMarkedForInline not.
-
- startVar := compiler allocateTemporaryVariableNamed: 'start'.
- endVar := compiler allocateTemporaryVariableNamed: 'end'.
-
- id := compiler idFor: node.
- self toTokenMode.
-
- compiler add: 'currentTokenType isNil ifFalse: [ ^ currentTokenType == ', id storeString, '].'.
- compiler profileTokenRead: id.
-
- node allNodes size > 2 ifTrue: [
- self addGuard: node ifTrue: nil ifFalse: [ compiler addOnLine: '^ false' ].
- ].
-
- compiler codeAssign: 'context position + 1.' to: startVar.
- compiler codeAssignParsedValueOf:[ self visit:node child ] to:#whatever.
-
- compiler add: 'error ifTrue: [ ^ error := false ].'.
-
- compiler codeAssign: 'context position.' to: endVar.
-
- compiler addComment: 'Consume Whitespace:'.
- compiler
- codeAssignParsedValueOf:[ self visit:node whitespace ]
- to:#whatever.
- compiler nl.
-
-
- compiler codeTranscriptShow: 'current token type: ', id storeString.
- compiler codeAssign: id storeString, '.' to: 'currentTokenType'.
- compiler codeAssign: node tokenClass asString, ' on: (context collection)
- start: ', startVar, '
- stop: ', endVar, '
- value: nil.'
- to: 'currentTokenValue := ', self retvalVar.
-
- compiler codeClearError.
- compiler add: '^ true'.
-
- self fromTokenMode.
+ ^ self visitToken: node
! !
--- a/compiler/PPCTokenConsumeNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCTokenConsumeNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -15,10 +15,31 @@
super name: value.
self child name isNil ifTrue: [
- self child name: self child prefix, '_', value.
+ self child name: value.
]
!
+nextFsa
+ ^ self propertyAt: #nextFsa
+!
+
+nextFsa: aPEGFsa
+ self propertyAt: #nextFsa put: aPEGFsa
+! !
+
+!PPCTokenConsumeNode methodsFor:'as yet unclassified'!
+
+markForInline
+ self error: 'current infrastructure does not allow for this!!'.
+ ^ super markForInline
+! !
+
+!PPCTokenConsumeNode methodsFor:'ids'!
+
+defaultName
+ ^ #token
+!
+
prefix
^ #consume
! !
--- a/compiler/PPCTokenDetector.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCTokenDetector.st Mon Aug 17 12:13:16 2015 +0100
@@ -43,7 +43,7 @@
visitTrimNode: node
self visitChildren: node.
-
+
(node child isKindOf: PPCTokenNode) ifTrue: [
self change.
^ PPCTrimmingTokenNode new
@@ -51,11 +51,13 @@
child: node child child;
tokenClass: node child tokenClass;
whitespace: node trimmer;
+ parser: node parser;
yourself
].
(node child isKindOf: PPCTokenConsumeNode) ifTrue: [
self change.
+ self halt: 'JK: this can happen???'.
^ PPCTrimmingTokenNode new
name: node name;
child: node child;
--- a/compiler/PPCTokenNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCTokenNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -11,10 +11,6 @@
!PPCTokenNode methodsFor:'accessing'!
-prefix
- ^ #token
-!
-
tokenClass
^ tokenClass
@@ -40,6 +36,12 @@
^ super hash bitXor: tokenClass hash
! !
+!PPCTokenNode methodsFor:'ids'!
+
+defaultName
+ ^ #token
+! !
+
!PPCTokenNode methodsFor:'testing'!
isTokenNode
--- a/compiler/PPCTokenVisitor.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCTokenVisitor.st Mon Aug 17 12:13:16 2015 +0100
@@ -44,7 +44,7 @@
^ node child
].
- self change.
+ self change.
^ PPCForwardNode new
child: node child;
name: node name;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCTokenizingCodeGen.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,59 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCCodeGen subclass:#PPCTokenizingCodeGen
+ instanceVariableNames:'rememberStrategy errorStrategy'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Compiler-Codegen'
+!
+
+!PPCTokenizingCodeGen methodsFor:'code generation'!
+
+codeClearError
+ errorStrategy codeClearError
+!
+
+codeError
+ errorStrategy codeError
+!
+
+codeError: message
+ errorStrategy codeError: message.
+!
+
+smartRemember: parser to: variableName
+ rememberStrategy smartRemember: parser to: variableName
+!
+
+smartRestore: parser from: mementoName
+ rememberStrategy smartRestore: parser from: mementoName
+! !
+
+!PPCTokenizingCodeGen methodsFor:'hooks'!
+
+errorStrategy
+ ^ errorStrategy ifNil: [ PPCCompilerTokenizingErrorStrategy on: self ]
+!
+
+errorStrategy: whatever
+ errorStrategy := whatever
+!
+
+rememberStrategy
+ ^ rememberStrategy ifNil: [ PPCCompilerTokenizingRememberStrategy on: self ]
+!
+
+rememberStrategy: whatever
+ rememberStrategy := whatever
+! !
+
+!PPCTokenizingCodeGen methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ rememberStrategy := PPCCompilerTokenizingRememberStrategy on: self.
+ errorStrategy := PPCCompilerTokenizingErrorStrategy on: self.
+! !
+
--- a/compiler/PPCTokenizingCodeGenerator.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCTokenizingCodeGenerator.st Mon Aug 17 12:13:16 2015 +0100
@@ -17,9 +17,12 @@
!
tokenGenerator
+ self error: 'deprecated'.
+
tokenGenerator isNil ifTrue: [
- tokenGenerator := PPCTokenCodeGenerator on: compiler.
- tokenGenerator arguments: arguments.
+ tokenGenerator := (PPCTokenCodeGenerator on: compiler)
+ arguments: arguments;
+ yourself.
].
^ tokenGenerator
!
@@ -62,6 +65,12 @@
^ true
! !
+!PPCTokenizingCodeGenerator methodsFor:'scanner'!
+
+compileScanner
+ compiler addConstant: self tokenGenerator compileScanner as: #scannerClass.
+! !
+
!PPCTokenizingCodeGenerator methodsFor:'visiting'!
visitAndNode: node
@@ -91,11 +100,15 @@
node children do: [ :child |
| tokenMethodName |
-
- child acceptsEpsilon ifTrue: [
+
+ "TODO: JK: fix this in a proper way. Commented for now to make LRPParser cimpilable
+ with tokenizing"
+ child acceptsEpsilon "false" ifTrue: [
possibleError := false.
- compiler codeAssignParsedValueOf:[ self visit:child ] to:self retvalVar.
- compiler codeReturn
+ compiler codeIf: 'true' then: [
+ compiler codeAssignParsedValueOf:[ self visit:child ] to:self retvalVar.
+ compiler codeReturn
+ ].
] ifFalse: [
child firstSetWithTokens do: [ :first |
"For each child, for each first compile this:"
@@ -125,7 +138,7 @@
compiler codeError: 'no choice found'.
]
- "Modified: / 10-05-2015 / 07:37:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 31-07-2015 / 08:07:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitDeterministicChoiceNode: node
@@ -183,30 +196,15 @@
!
visitTokenConsumeNode: node
- | id |
- id := (compiler idFor: node child).
- compiler add: 'self ', id asString, ' ifTrue: ['.
- compiler indent.
- compiler codeAssign: 'nil.' to: 'currentTokenType'.
- compiler codeReturn: 'currentTokenValue'.
- compiler dedent.
- compiler add: '] ifFalse: ['.
- compiler indent.
- compiler codeError: id asString, ' expected'.
- compiler dedent.
- compiler add: '].'.
-
-"
- compiler codeReturn: 'self consume: ', (compiler idFor: node child) storeString, '.'
-"
+ "dont do anything here"
+ ^ node
!
visitTokenNode: node
- self error: 'shoudl not happend!!'
+ self error: 'should not happen!!'
!
visitTokenizingParserNode: node
- self visit: node tokenizer.
self visit: node whitespace.
compiler codeHaltIfShiftPressed.
@@ -216,7 +214,11 @@
compiler codeReturn.
!
+visitTrimmingTokenCharacterNode: node
+ self error: 'should not happen!!'
+!
+
visitTrimmingTokenNode: node
- self error: 'shoudl not happend!!'
+ self error: 'should not happen!!'
! !
--- a/compiler/PPCTokenizingConfiguration.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCTokenizingConfiguration.st Mon Aug 17 12:13:16 2015 +0100
@@ -3,7 +3,7 @@
"{ NameSpace: Smalltalk }"
PPCConfiguration subclass:#PPCTokenizingConfiguration
- instanceVariableNames:''
+ instanceVariableNames:'codeGen'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Core'
@@ -11,6 +11,18 @@
!PPCTokenizingConfiguration methodsFor:'compiling'!
+buildClass: compiler
+ | builder |
+ builder := PPCClassBuilder new.
+
+ builder compiledClassName: arguments parserName.
+ builder compiledSuperclass: PPTokenizingCompiledParser.
+ builder methodDictionary: compiler methodDictionary.
+ builder constants: compiler constants.
+
+ ^ builder compileClass.
+!
+
invokePhases
self toPPCIr.
self createTokens.
@@ -25,11 +37,17 @@
self merge.
self check.
self cacheFirstFollow.
+ self generateScanner. "Please note that codeGen is shared between these two phases"
self generate.
! !
!PPCTokenizingConfiguration methodsFor:'hooks'!
+codeCompiler
+ codeGen isNil ifTrue: [ codeGen := PPCTokenizingCodeGen on: arguments ].
+ ^ codeGen
+!
+
codeCompilerOn: args
^ PPCTokenizingCompiler on: args
!
@@ -47,6 +65,19 @@
self remember: #LL1
!
+generateScanner
+ | generator scanner |
+ generator := PPCTokenCodeGenerator new
+ compiler: self codeCompiler;
+ arguments: arguments;
+ yourself.
+
+ generator visit: ir.
+
+ scanner := generator compileScanner.
+ self codeCompiler addConstant: scanner as: #scannerClass.
+!
+
tokenize
"
This will try transform the parser into the tokenizing parser
--- a/compiler/PPCTokenizingParserNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCTokenizingParserNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -11,6 +11,10 @@
!PPCTokenizingParserNode methodsFor:'accessing'!
+defaultName
+ ^ #tokenizingParser
+!
+
initialize
super initialize.
children := Array new: 3
@@ -24,10 +28,6 @@
children at: 1 put: node
!
-prefix
- ^ #tokenizingParser
-!
-
tokenizer
^ children at: 2
!
@@ -36,12 +36,20 @@
^ children at: 2 put: node
!
-whitespace
+tokens
^ children at: 3
!
+tokens: anObject
+ children at: 3 put: anObject
+!
+
+whitespace
+ ^ children at: 2
+!
+
whitespace: node
- children at: 3 put: node
+ children at: 2 put: node
! !
!PPCTokenizingParserNode methodsFor:'visiting'!
--- a/compiler/PPCTokenizingVisitor.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCTokenizingVisitor.st Mon Aug 17 12:13:16 2015 +0100
@@ -13,41 +13,44 @@
afterAccept: node retval: parserNode
self isRoot ifTrue: [
- | tokenizerNode whitespaceNode |
+ | tokensNode whitespaceNode |
self change.
- tokens addLast: self eofToken.
- tokens do: [ :token | token unmarkForInline ].
+" tokens addLast: self eofToken."
+ tokens do: [ :token | token unmarkForInline ].
+ whitespaceNode := tokens detect: [ :e | e isTrimmingTokenNode ] ifNone: [ nil ].
+ whitespaceNode notNil ifTrue: [
+ whitespaceNode := whitespaceNode whitespace copy
+ unmarkForInline;
+ name: 'consumeWhitespace';
+ yourself.
+ "whitespaceNode := PPCTokenWhitespaceNode new
+ child: whitespaceNode;
+ yourself"
+ ] ifFalse: [
+ whitespaceNode := PPCNilNode new
+ name: 'consumeWhitespace';
+ yourself
+ ].
- whitespaceNode := tokens detect: [ :e | e isTrimmingTokenNode ] ifNone:[nil].
- whitespaceNode notNil ifTrue:[
- whitespaceNode := whitespaceNode whitespace copy
- unmarkForInline;
- name: 'consumeWhitespace';
- yourself
- ] ifFalse:[
- whitespaceNode := (PPCNilNode new)
- name: 'consumeWhitespace';
- yourself
- ].
- tokenizerNode := PPCTokenChoiceNode new
+ tokensNode := PPCListNode new
children: tokens asArray;
name: 'nextToken';
yourself.
-
+
^ PPCTokenizingParserNode new
parser: parserNode;
- tokenizer: tokenizerNode;
whitespace: whitespaceNode;
- name: #'mainParser';
- yourself
- ].
+ tokens: tokensNode;
+ name: #mainParser;
+ yourself ].
^ parserNode
-
+
"Modified: / 12-05-2015 / 01:37:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
eofToken
| ws |
+ self error: 'deprecated?'.
ws := PPCStarNode new
child: (PPCMessagePredicateNode new
message: #isSeparator;
@@ -58,6 +61,7 @@
child: PPCEndOfFileNode new;
whitespace: ws;
tokenClass: PPToken;
+ name: 'eof'
yourself.
! !
@@ -86,6 +90,7 @@
visitActionNode: node
(node hasProperty: #trimmingToken) ifTrue: [
+ self halt: 'can this happen?'.
self change.
self addToken: node.
@@ -97,10 +102,21 @@
^ super visitActionNode: node
!
+visitTokenConsumeNode: node
+ "
+ Seems, it might happen, that if I create the consume node,
+ I will ge to it later. This would create a token consume node for the
+ child, thus having tokenConsumNode with tokenConsumNode as a child...
+ "
+ ^ node
+!
+
visitTokenNode: node
self change.
self addToken: node.
+ self assert: node acceptsEpsilon not description: 'Sorry, but the epsilon tokens are not allowed'.
+
^ PPCTokenConsumeNode new
child: node;
yourself.
@@ -112,6 +128,7 @@
^ PPCTokenConsumeNode new
child: node;
+ name: node name;
yourself.
! !
--- a/compiler/PPCTrimNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCTrimNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -21,7 +21,7 @@
children at: 2 put: anObject
!
-prefix
+defaultName
^ #trim
!
@@ -53,6 +53,7 @@
| message |
message := PPCMessagePredicateNode new
message: #isSeparator;
+ predicate: [ :char | char isSeparator ]
yourself.
^ PPCStarNode new
child: message;
--- a/compiler/PPCTrimmingTokenNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCTrimmingTokenNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -21,10 +21,6 @@
children at: 2 put: anObject
!
-prefix
- ^ #token
-!
-
tokenClass
^ tokenClass
@@ -93,6 +89,12 @@
^ super hash bitXor: tokenClass hash
! !
+!PPCTrimmingTokenNode methodsFor:'ids'!
+
+defaultName
+ ^ #token
+! !
+
!PPCTrimmingTokenNode methodsFor:'initialization'!
initialize
--- a/compiler/PPCUniversalConfiguration.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCUniversalConfiguration.st Mon Aug 17 12:13:16 2015 +0100
@@ -11,6 +11,18 @@
!PPCUniversalConfiguration methodsFor:'compiling'!
+buildClass: compiler
+ | builder |
+ builder := PPCClassBuilder new.
+
+ builder compiledClassName: arguments parserName.
+ builder compiledSuperclass: PPCompiledParser.
+ builder methodDictionary: compiler methodDictionary.
+ builder constants: compiler constants.
+
+ ^ builder compileClass.
+!
+
invokePhases
self toPPCIr.
self createTokens.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCUniversalResultStrategy.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,62 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCScannerResultStrategy subclass:#PPCUniversalResultStrategy
+ instanceVariableNames:'tokens'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Scanner'
+!
+
+!PPCUniversalResultStrategy methodsFor:'accessing'!
+
+indexForRetval: retval
+" tokens withIndexDo: [ :e :index |
+ (e == retval) ifTrue: [ ^ index ]
+ ].
+
+ self error: 'This should not happen!!'
+"
+ ^ codeGen idGen numericIdFor: retval
+!
+
+tokens
+ ^ tokens
+!
+
+tokens: array
+ self assert: (array isArray).
+ tokens := array
+! !
+
+!PPCUniversalResultStrategy methodsFor:'as yet unclassified'!
+
+recordFailure: retval
+ codeGen codeRecordFailure: (self indexForRetval: retval)
+!
+
+recordFailure: retval offset: offset
+ codeGen codeRecordFailure: (self indexForRetval: retval)
+!
+
+recordMatch: retval
+ codeGen codeComment: 'symbol: ', retval storeString.
+ codeGen codeRecordMatch: (self indexForRetval: retval)
+!
+
+recordMatch: retval offset: offset
+ codeGen codeComment: 'symbol: ', retval storeString.
+ codeGen codeRecordMatch: (self indexForRetval: retval) offset: offset
+!
+
+reset
+" ^ codeGen code: 'self reset:', tokens storeString, '.'"
+ ^ codeGen code: 'self reset.'
+!
+
+returnResult: state
+ self assert: (state isKindOf: PEGFsaState).
+ codeGen codeReturn.
+! !
+
--- a/compiler/PPCUnknownNode.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCUnknownNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -30,6 +30,10 @@
^ parser children
!
+defaultName
+ ^ #parser
+!
+
isContextFreePrim
^ parser isContextFreePrim
!
@@ -46,10 +50,6 @@
parser: anObject
parser := anObject
-!
-
-prefix
- ^ #parser
! !
!PPCUnknownNode methodsFor:'analysis'!
--- a/compiler/PPCompiledParser.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCompiledParser.st Mon Aug 17 12:13:16 2015 +0100
@@ -18,6 +18,10 @@
!PPCompiledParser class methodsFor:'as yet unclassified'!
+acceptsLoggingOfCompilation
+ ^ true
+!
+
addConstant: value as: id
self constants at: id ifPresent: [
((self constants at: id) = value) ifFalse: [self error: 'ooups']].
@@ -84,9 +88,10 @@
initialize
super initialize.
- self class constants keysAndValuesDo: [ :key :value |
+" self class constants keysAndValuesDo: [ :key :value |
self instVarNamed: key put: value.
].
+"
startSymbol := self class startSymbol.
--- a/compiler/PPTokenizingCompiledParser.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPTokenizingCompiledParser.st Mon Aug 17 12:13:16 2015 +0100
@@ -9,6 +9,19 @@
category:'PetitCompiler-Parsers'
!
+!PPTokenizingCompiledParser class methodsFor:'as yet unclassified'!
+
+acceptsLoggingOfCompilation
+ ^ self == PPTokenizingCompiledParser
+! !
+
+!PPTokenizingCompiledParser methodsFor:'initialization'!
+
+initialize
+ super initialize.
+
+! !
+
!PPTokenizingCompiledParser methodsFor:'tokenizing'!
consume: tokenType
@@ -22,7 +35,7 @@
!
consumeWhitespace
- self shouldBeImplemented
+ "self shouldBeImplemented "
!
currentTokenType
@@ -57,7 +70,9 @@
context noteFailure: failure.
error := false.
currentTokenType := nil.
- scanner := PPCScanner new.
+ scanner := (self class classVarNamed: #scannerClass) new.
+ scanner stream: aPPContext.
+
self consumeWhitespace.
retval := self perform: startSymbol.
--- a/compiler/abbrev.stc Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/abbrev.stc Mon Aug 17 12:13:16 2015 +0100
@@ -2,45 +2,62 @@
# 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
+PEGFsaAbstractDeterminizator PEGFsaAbstractDeterminizator stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
+PEGFsaFailure PEGFsaFailure stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 1
PEGFsaInterpret PEGFsaInterpret stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
+PEGFsaInterpretRecord PEGFsaInterpretRecord stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
+PEGFsaMinimizator PEGFsaMinimizator 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
+PEGFsaStateInfo PEGFsaStateInfo stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
PEGFsaTransition PEGFsaTransition stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
+PPCASTUtilities PPCASTUtilities stx:goodies/petitparser/compiler 'PetitCompiler-Support' 0
PPCArguments PPCArguments stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCBridge PPCBridge stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCClassBuilder PPCClassBuilder stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCCodeBlock PPCCodeBlock stx:goodies/petitparser/compiler 'PetitCompiler-Compiler-Codegen' 0
PPCCodeGen PPCCodeGen stx:goodies/petitparser/compiler 'PetitCompiler-Compiler-Codegen' 0
+PPCCompilationError PPCCompilationError stx:goodies/petitparser/compiler 'PetitCompiler-Exceptions' 1
+PPCCompilationWarning PPCCompilationWarning stx:goodies/petitparser/compiler 'PetitCompiler-Exceptions' 1
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
-PPCCompilerTokenRememberStrategy PPCCompilerTokenRememberStrategy stx:goodies/petitparser/compiler 'PetitCompiler-Compiler' 0
-PPCCompilerTokenizingErrorStrategy PPCCompilerTokenizingErrorStrategy stx:goodies/petitparser/compiler 'PetitCompiler-Compiler' 0
-PPCCompilerTokenizingRememberStrategy PPCCompilerTokenizingRememberStrategy stx:goodies/petitparser/compiler 'PetitCompiler-Compiler' 0
+PPCCompilerTokenErrorStrategy PPCCompilerTokenErrorStrategy stx:goodies/petitparser/compiler 'PetitCompiler-Compiler-Codegen-Straregies' 0
+PPCCompilerTokenRememberStrategy PPCCompilerTokenRememberStrategy stx:goodies/petitparser/compiler 'PetitCompiler-Compiler-Codegen-Straregies' 0
+PPCCompilerTokenizingErrorStrategy PPCCompilerTokenizingErrorStrategy stx:goodies/petitparser/compiler 'PetitCompiler-Compiler-Codegen-Straregies' 0
+PPCCompilerTokenizingRememberStrategy PPCCompilerTokenizingRememberStrategy stx:goodies/petitparser/compiler 'PetitCompiler-Compiler-Codegen-Straregies' 0
PPCConfiguration PPCConfiguration stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCContext PPCContext stx:goodies/petitparser/compiler 'PetitCompiler-Context' 0
PPCContextMemento PPCContextMemento stx:goodies/petitparser/compiler 'PetitCompiler-Context' 0
PPCGuard PPCGuard stx:goodies/petitparser/compiler 'PetitCompiler-Guards' 0
+PPCIdGenerator PPCIdGenerator stx:goodies/petitparser/compiler 'PetitCompiler-Compiler-Codegen' 0
PPCMethod PPCMethod stx:goodies/petitparser/compiler 'PetitCompiler-Compiler-Codegen' 0
PPCNode PPCNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCNodeVisitor PPCNodeVisitor stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
PPCPluggableConfiguration PPCPluggableConfiguration stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCScanner PPCScanner stx:goodies/petitparser/compiler 'PetitCompiler-Scanner' 0
PPCScannerCodeGenerator PPCScannerCodeGenerator stx:goodies/petitparser/compiler 'PetitCompiler-Scanner' 0
+PPCScannerResultStrategy PPCScannerResultStrategy stx:goodies/petitparser/compiler 'PetitCompiler-Scanner' 0
PPCTokenGuard PPCTokenGuard stx:goodies/petitparser/compiler 'PetitCompiler-Guards' 0
PPCompiledParser PPCompiledParser stx:goodies/petitparser/compiler 'PetitCompiler-Parsers' 4
PPMappedActionParser PPMappedActionParser stx:goodies/petitparser/compiler 'PetitCompiler-Parsers' 0
stx_goodies_petitparser_compiler stx_goodies_petitparser_compiler stx:goodies/petitparser/compiler '* Projects & Packages *' 3
FooScanner FooScanner stx:goodies/petitparser/compiler 'PetitCompiler-Scanner' 0
+PEGFsaCharacterTransition PEGFsaCharacterTransition stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
+PEGFsaChoiceDeterminizator PEGFsaChoiceDeterminizator stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
+PEGFsaDeterminizator PEGFsaDeterminizator stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
+PEGFsaEpsilonTransition PEGFsaEpsilonTransition stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
PEGFsaGenerator PEGFsaGenerator stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
+PEGFsaPredicateTransition PEGFsaPredicateTransition stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
+PEGFsaSequenceDeterminizator PEGFsaSequenceDeterminizator stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
+PEGFsaUncopiableState PEGFsaUncopiableState 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
PPCCharacterNode PPCCharacterNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCCodeGenerator PPCCodeGenerator stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
PPCDelegateNode PPCDelegateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCEndOfFileNode PPCEndOfFileNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
+PPCDistinctResultStrategy PPCDistinctResultStrategy stx:goodies/petitparser/compiler 'PetitCompiler-Scanner' 0
+PPCEndOfFileNode PPCEndOfFileNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 1
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
@@ -49,11 +66,15 @@
PPCPluggableNode PPCPluggableNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCProfilingContext PPCProfilingContext stx:goodies/petitparser/compiler 'PetitCompiler-Context' 0
PPCRewritingVisitor PPCRewritingVisitor stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
+PPCTokenCodeGenerator PPCTokenCodeGenerator stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
+PPCTokenizingCodeGen PPCTokenizingCodeGen stx:goodies/petitparser/compiler 'PetitCompiler-Compiler-Codegen' 0
PPCTokenizingCompiler PPCTokenizingCompiler stx:goodies/petitparser/compiler 'PetitCompiler-Compiler' 0
PPCTokenizingConfiguration PPCTokenizingConfiguration stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCUniversalConfiguration PPCUniversalConfiguration stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
+PPCUniversalResultStrategy PPCUniversalResultStrategy stx:goodies/petitparser/compiler 'PetitCompiler-Scanner' 0
PPCUnknownNode PPCUnknownNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPTokenizingCompiledParser PPTokenizingCompiledParser stx:goodies/petitparser/compiler 'PetitCompiler-Parsers' 4
+PEGFsaEOFTransition PEGFsaEOFTransition stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
PPCAbstractActionNode PPCAbstractActionNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCAndNode PPCAndNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCCharSetPredicateNode PPCCharSetPredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
@@ -81,7 +102,6 @@
PPCSequenceNode PPCSequenceNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCSpecializingVisitor PPCSpecializingVisitor stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
PPCStarNode PPCStarNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCTokenCodeGenerator PPCTokenCodeGenerator stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
PPCTokenConsumeNode PPCTokenConsumeNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCTokenDetector PPCTokenDetector stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
PPCTokenNode PPCTokenNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
--- a/compiler/bc.mak Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/bc.mak Mon Aug 17 12:13:16 2015 +0100
@@ -78,16 +78,23 @@
# 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)PEGFsaAbstractDeterminizator.$(O) PEGFsaAbstractDeterminizator.$(H): PEGFsaAbstractDeterminizator.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)PEGFsaInterpretRecord.$(O) PEGFsaInterpretRecord.$(H): PEGFsaInterpretRecord.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaMinimizator.$(O) PEGFsaMinimizator.$(H): PEGFsaMinimizator.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)PEGFsaStateInfo.$(O) PEGFsaStateInfo.$(H): PEGFsaStateInfo.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PEGFsaTransition.$(O) PEGFsaTransition.$(H): PEGFsaTransition.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCASTUtilities.$(O) PPCASTUtilities.$(H): PPCASTUtilities.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)PPCCompilationError.$(O) PPCCompilationError.$(H): PPCCompilationError.st $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCCompilationWarning.$(O) PPCCompilationWarning.$(H): PPCCompilationWarning.st $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Notification.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\UserNotification.$(H) $(INCLUDE_TOP)\stx\libbasic\Warning.$(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)
@@ -98,24 +105,34 @@
$(OUTDIR)PPCContext.$(O) PPCContext.$(H): PPCContext.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\PeekableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PositionableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\ReadStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(STCHDR)
$(OUTDIR)PPCContextMemento.$(O) PPCContextMemento.$(H): PPCContextMemento.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCGuard.$(O) PPCGuard.$(H): PPCGuard.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCIdGenerator.$(O) PPCIdGenerator.$(H): PPCIdGenerator.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCMethod.$(O) PPCMethod.$(H): PPCMethod.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(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)PPCScannerResultStrategy.$(O) PPCScannerResultStrategy.$(H): PPCScannerResultStrategy.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)PEGFsaCharacterTransition.$(O) PEGFsaCharacterTransition.$(H): PEGFsaCharacterTransition.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PEGFsaTransition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaChoiceDeterminizator.$(O) PEGFsaChoiceDeterminizator.$(H): PEGFsaChoiceDeterminizator.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PEGFsaAbstractDeterminizator.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaDeterminizator.$(O) PEGFsaDeterminizator.$(H): PEGFsaDeterminizator.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PEGFsaAbstractDeterminizator.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaEpsilonTransition.$(O) PEGFsaEpsilonTransition.$(H): PEGFsaEpsilonTransition.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PEGFsaTransition.$(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)PEGFsaPredicateTransition.$(O) PEGFsaPredicateTransition.$(H): PEGFsaPredicateTransition.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PEGFsaTransition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaSequenceDeterminizator.$(O) PEGFsaSequenceDeterminizator.$(H): PEGFsaSequenceDeterminizator.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PEGFsaAbstractDeterminizator.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaUncopiableState.$(O) PEGFsaUncopiableState.$(H): PEGFsaUncopiableState.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PEGFsaState.$(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)
$(OUTDIR)PPCCharacterNode.$(O) PPCCharacterNode.$(H): PPCCharacterNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(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)PPCDistinctResultStrategy.$(O) PPCDistinctResultStrategy.$(H): PPCDistinctResultStrategy.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCScannerResultStrategy.$(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)
@@ -125,11 +142,15 @@
$(OUTDIR)PPCPluggableNode.$(O) PPCPluggableNode.$(H): PPCPluggableNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCProfilingContext.$(O) PPCProfilingContext.$(H): PPCProfilingContext.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPStream.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCContext.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\PeekableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PositionableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\ReadStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(STCHDR)
$(OUTDIR)PPCRewritingVisitor.$(O) PPCRewritingVisitor.$(H): PPCRewritingVisitor.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNodeVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCTokenCodeGenerator.$(O) PPCTokenCodeGenerator.$(H): PPCTokenCodeGenerator.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNodeVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCTokenizingCodeGen.$(O) PPCTokenizingCodeGen.$(H): PPCTokenizingCodeGen.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCCodeGen.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenizingCompiler.$(O) PPCTokenizingCompiler.$(H): PPCTokenizingCompiler.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCCompiler.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenizingConfiguration.$(O) PPCTokenizingConfiguration.$(H): PPCTokenizingConfiguration.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCConfiguration.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCUniversalConfiguration.$(O) PPCUniversalConfiguration.$(H): PPCUniversalConfiguration.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCConfiguration.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCUniversalResultStrategy.$(O) PPCUniversalResultStrategy.$(H): PPCUniversalResultStrategy.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCScannerResultStrategy.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCUnknownNode.$(O) PPCUnknownNode.$(H): PPCUnknownNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPTokenizingCompiledParser.$(O) PPTokenizingCompiledParser.$(H): PPTokenizingCompiledParser.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCompiledParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PEGFsaEOFTransition.$(O) PEGFsaEOFTransition.$(H): PEGFsaEOFTransition.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PEGFsaPredicateTransition.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PEGFsaTransition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCAbstractActionNode.$(O) PPCAbstractActionNode.$(H): PPCAbstractActionNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCDelegateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCAndNode.$(O) PPCAndNode.$(H): PPCAndNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCDelegateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCCharSetPredicateNode.$(O) PPCCharSetPredicateNode.$(H): PPCCharSetPredicateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractPredicateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
@@ -157,7 +178,6 @@
$(OUTDIR)PPCSequenceNode.$(O) PPCSequenceNode.$(H): PPCSequenceNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCListNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCSpecializingVisitor.$(O) PPCSpecializingVisitor.$(H): PPCSpecializingVisitor.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNodeVisitor.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCRewritingVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCStarNode.$(O) PPCStarNode.$(H): PPCStarNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCDelegateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCTokenCodeGenerator.$(O) PPCTokenCodeGenerator.$(H): PPCTokenCodeGenerator.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCCodeGenerator.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNodeVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenConsumeNode.$(O) PPCTokenConsumeNode.$(H): PPCTokenConsumeNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCDelegateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenDetector.$(O) PPCTokenDetector.$(H): PPCTokenDetector.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNodeVisitor.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCRewritingVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenNode.$(O) PPCTokenNode.$(H): PPCTokenNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCDelegateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
@@ -180,7 +200,7 @@
$(OUTDIR)PPCMappedActionNode.$(O) PPCMappedActionNode.$(H): PPCMappedActionNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractActionNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCActionNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCDelegateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenStarMessagePredicateNode.$(O) PPCTokenStarMessagePredicateNode.$(H): PPCTokenStarMessagePredicateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCDelegateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCStarMessagePredicateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCStarNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenStarSeparatorNode.$(O) PPCTokenStarSeparatorNode.$(H): PPCTokenStarSeparatorNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCDelegateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCStarMessagePredicateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCStarNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCTokenStarMessagePredicateNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPActionParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPAndParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPCharSetPredicate.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPChoiceParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPCompositeParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPContext.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPEndOfInputParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPEpsilonParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPFailure.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPFlattenParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPListParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPLiteralObjectParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPLiteralParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPLiteralSequenceParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPNotParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPOptionalParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPPluggableParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPPossessiveRepeatingParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPPredicateObjectParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPPredicateParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPRepeatingParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPSequenceParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPStream.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPToken.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPTokenParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPTrimmingParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\parsers\java\PPJavaWhitespaceParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk\PPSmalltalkGrammar.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk\PPSmalltalkTokenParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk\PPSmalltalkWhitespaceParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Character.$(H) $(INCLUDE_TOP)\stx\libbasic\Magnitude.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\PeekableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PositionableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\ReadStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(INCLUDE_TOP)\stx\libbasic\UndefinedObject.$(H) $(STCHDR)
+$(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPActionParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPAndParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPCharSetPredicate.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPChoiceParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPCompositeParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPContext.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPEndOfFileParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPEndOfInputParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPEpsilonParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPFailure.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPFlattenParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPListParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPLiteralObjectParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPLiteralParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPLiteralSequenceParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPNotParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPOptionalParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPPluggableParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPPossessiveRepeatingParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPPredicateObjectParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPPredicateParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPRepeatingParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPSequenceParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPStream.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPToken.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPTokenParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPTrimmingParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\parsers\java\PPJavaWhitespaceParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk\PPSmalltalkGrammar.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk\PPSmalltalkTokenParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk\PPSmalltalkWhitespaceParser.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBLiteralNode.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBLiteralValueNode.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBProgramNode.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBStatementNode.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBValueNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Character.$(H) $(INCLUDE_TOP)\stx\libbasic\Magnitude.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\PeekableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PositionableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\ReadStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(INCLUDE_TOP)\stx\libbasic\UndefinedObject.$(H) $(STCHDR)
# ENDMAKEDEPEND --- do not remove this line
--- a/compiler/benchmarks/PPCBenchmark.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/benchmarks/PPCBenchmark.st Mon Aug 17 12:13:16 2015 +0100
@@ -4,7 +4,7 @@
Object subclass:#PPCBenchmark
instanceVariableNames:'sources report contextClass compile parser context input
- configuration profile'
+ configuration profile repetitions'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Benchmarks-Core'
@@ -63,6 +63,16 @@
"Modified: / 16-05-2015 / 19:19:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!PPCBenchmark methodsFor:'accessing'!
+
+repetitions
+ ^ repetitions
+!
+
+repetitions: anObject
+ repetitions := anObject
+! !
+
!PPCBenchmark methodsFor:'benchmark support'!
compile: value
@@ -263,15 +273,12 @@
self setupSmalltalkGrammarCompiled.
- time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
-
- self reportInput: input time: time name: 'Compiled Smalltalk Grammar'.
-
-"
- 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'.
-"
+ repetitions timesRepeat: [
+ time := [ input do: [ :source |
+ parser parse: source withContext: context
+ ]] timeToRun asMilliSeconds.
+ self reportInput: input time: time name: 'Compiled Smalltalk Grammar'.
+ ]
!
benchmarkSmalltalkGrammarTokenized
@@ -279,12 +286,12 @@
self setupSmalltalkGrammarTokenized.
- time := [ input do: [ :source |
- parser parse: source withContext: context ]
- ] timeToRun asMilliSeconds.
-
- self reportInput: input time: time name: 'Tokenized Smalltalk Grammar'.
-
+ repetitions timesRepeat: [
+ time := [ input do: [ :source |
+ parser parse: source withContext: context ]
+ ] timeToRun asMilliSeconds.
+ self reportInput: input time: time name: 'Tokenized Smalltalk Grammar'.
+ ]
"
size := input inject: 0 into: [:r :e | r + e size ].
Transcript crShow: 'Compiled Grammar time: ', time asString.
@@ -443,6 +450,8 @@
compile := false.
profile := false.
+
+ repetitions := 3
! !
!PPCBenchmark methodsFor:'meta'!
@@ -497,7 +506,8 @@
setupExpressionGrammarCompiled
configuration := PPCConfiguration universal.
- configuration arguments name: #PPCompiledExpressionGrammar.
+ configuration arguments parserName: #PPCompiledExpressionGrammar.
+ configuration arguments scannerName: #PPCompiledExpressionScanner.
parser := PPExpressionGrammar new compileWithConfiguration: configuration.
context := self context.
context initializeFor: parser.
@@ -507,7 +517,8 @@
setupExpressionGrammarTokenized
configuration := PPCConfiguration tokenizing.
- configuration arguments name: #PPTokenizedExpressionGrammar.
+ configuration arguments parserName: #PPTokenizedExpressionGrammar.
+ configuration arguments scannerName: #PPTokenizedExpressionScanner.
parser := PPExpressionGrammar new compileWithConfiguration: configuration.
context := self context.
context initializeFor: parser.
@@ -546,7 +557,8 @@
setupLL1ExpressionGrammarCompiled
configuration := PPCConfiguration universal.
- configuration arguments name: #PPCompiledLL1ExpressionGrammar.
+ configuration arguments parserName: #PPCompiledLL1ExpressionGrammar.
+ configuration arguments scannerName: #PPCompiledLL1ExpressionScanner.
parser := PPLL1ExpressionGrammar new compileWithConfiguration: configuration.
context := self context.
context initializeFor: parser.
@@ -556,7 +568,8 @@
setupLL1ExpressionGrammarTokenized
configuration := PPCConfiguration tokenizing.
- configuration arguments name: #PPTokenizedLL1ExpressionGrammar.
+ configuration arguments parserName: #PPTokenizedLL1ExpressionGrammar.
+ configuration arguments scannerName: #PPTokenizedLL1ExpressionScanner.
parser := PPLL1ExpressionGrammar new compileWithConfiguration: configuration.
context := self context.
context initializeFor: parser.
@@ -579,7 +592,8 @@
setupSmalltalkGrammarCompiled
configuration := PPCConfiguration universal.
- configuration arguments name: #PPCompiledSmalltalkGrammar.
+ configuration arguments parserName: #PPCompiledSmalltalkGrammar.
+ configuration arguments scannerName: #PPCompiledSmalltalkScanner.
configuration arguments profile: profile.
parser := PPSmalltalkGrammar new compileWithConfiguration: configuration.
@@ -596,7 +610,8 @@
setupSmalltalkGrammarTokenized
configuration := PPCConfiguration tokenizing.
- configuration arguments name: #PPTokenizedSmalltalkGrammar.
+ configuration arguments parserName: #PPTokenizedSmalltalkGrammar.
+ configuration arguments scannerName: #PPTokenizedSmalltalkScanner.
configuration arguments profile: profile.
parser := PPSmalltalkGrammar new compileWithConfiguration: configuration.
@@ -622,7 +637,7 @@
setupSmalltalkNoopParserTokenized
- configuration := PPCConfiguration LL1.
+ configuration := PPCConfiguration tokenizing.
parser := PPCSmalltalkNoopParser new compileWithConfiguration: configuration.
context := PPCContext new.
context initializeFor: parser.
--- a/compiler/extensions.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/extensions.st Mon Aug 17 12:13:16 2015 +0100
@@ -14,6 +14,12 @@
!Object methodsFor:'*petitcompiler'!
+isFsaFailure
+ ^ false
+! !
+
+!Object methodsFor:'*petitcompiler'!
+
isInlinedMethod
^ false
! !
@@ -163,6 +169,12 @@
!PPContext methodsFor:'*petitcompiler'!
+methodFinished: whatever
+ "nothing to do"
+! !
+
+!PPContext methodsFor:'*petitcompiler'!
+
methodInvoked: whatever
"nothing to do"
! !
@@ -187,6 +199,12 @@
!PPContext methodsFor:'*petitcompiler'!
+tokenRead: whatever
+ "nothing to do"
+! !
+
+!PPContext methodsFor:'*petitcompiler'!
+
whitespace
^ self globalAt: #whitespace ifAbsent: [ nil ].
! !
@@ -227,6 +245,14 @@
^ super compileWith: aPetitCompiler.
! !
+!PPEndOfFileParser methodsFor:'*petitcompiler'!
+
+asCompilerNode
+ ^ PPCEndOfFileNode new
+ name: self name;
+ yourself
+! !
+
!PPEndOfInputParser methodsFor:'*petitcompiler'!
asCompilerNode
@@ -649,6 +675,21 @@
!PPSmalltalkGrammar methodsFor:'*petitcompiler'!
+number
+ | numberChars |
+ numberChars := #hex asParser / 'r' asParser / 's' asParser / '-' asParser.
+ ^ $- asParser optional, #digit asParser, numberChars star, ('.' asParser, numberChars plus) optional.
+
+" ^ ($- asParser optional , #digit asParser) and , [ :context |
+ [ (NumberParser on: context stream) nextNumber ]
+ on: Error
+ do: [ :err | PPFailure message: err messageText at: context position ] ]
+ asParser
+"
+! !
+
+!PPSmalltalkGrammar methodsFor:'*petitcompiler'!
+
whitespace
^ #space asParser plus
! !
@@ -717,6 +758,20 @@
^ self name hash
! !
+!PPSmalltalkWhitespaceParser methodsFor:'*petitcompiler'!
+
+parseOn: aPPContext
+ [ [aPPContext atEnd not and: [ aPPContext uncheckedPeek isSeparator ] ]
+ whileTrue: [ aPPContext next ].
+
+ aPPContext atEnd not and: [ aPPContext uncheckedPeek = $" ] ] whileTrue: [
+ aPPContext next.
+ "aPPContext upTo: $".
+
+ [aPPContext atEnd or: [aPPContext next == $"]] whileFalse
+ ].
+! !
+
!PPStream methodsFor:'*petitcompiler'!
peek: anInteger
@@ -805,14 +860,45 @@
yourself
! !
+!RBLiteralValueNode methodsFor:'*petitcompiler'!
+
+isLiteralNumber
+ [(NumberParser on: sourceText ) nextNumber] on: Exception do: [ ^ false ].
+ ^ true
+! !
+
+!RBProgramNode methodsFor:'*petitcompiler'!
+
+isLiteralNumber
+ ^ false
+! !
+
!UndefinedObject methodsFor:'*petitcompiler'!
asInteger
+ "
+ because nil is returned as and of text on stream
+
+ JK: This should be obviously rewritten in future!!
+ "
+ self flag: 'JK: Hack alert!!'.
^ 256
! !
!UndefinedObject methodsFor:'*petitcompiler'!
+codePoint
+ "
+ because nil is returned as and of text on stream
+
+ JK: This should be obviously rewritten in future!!
+ "
+ self flag: 'JK: Hack alert!!'.
+ ^ 0
+! !
+
+!UndefinedObject methodsFor:'*petitcompiler'!
+
isAlphaNumeric
^ false
! !
--- a/compiler/libInit.cc Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/libInit.cc Mon Aug 17 12:13:16 2015 +0100
@@ -28,16 +28,23 @@
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);
+_PEGFsaAbstractDeterminizator_Init(pass,__pRT__,snd);
_PEGFsaFailure_Init(pass,__pRT__,snd);
_PEGFsaInterpret_Init(pass,__pRT__,snd);
+_PEGFsaInterpretRecord_Init(pass,__pRT__,snd);
+_PEGFsaMinimizator_Init(pass,__pRT__,snd);
_PEGFsaPair_Init(pass,__pRT__,snd);
_PEGFsaState_Init(pass,__pRT__,snd);
+_PEGFsaStateInfo_Init(pass,__pRT__,snd);
_PEGFsaTransition_Init(pass,__pRT__,snd);
+_PPCASTUtilities_Init(pass,__pRT__,snd);
_PPCArguments_Init(pass,__pRT__,snd);
_PPCBridge_Init(pass,__pRT__,snd);
_PPCClassBuilder_Init(pass,__pRT__,snd);
_PPCCodeBlock_Init(pass,__pRT__,snd);
_PPCCodeGen_Init(pass,__pRT__,snd);
+_PPCCompilationError_Init(pass,__pRT__,snd);
+_PPCCompilationWarning_Init(pass,__pRT__,snd);
_PPCCompiledMethod_Init(pass,__pRT__,snd);
_PPCCompiler_Init(pass,__pRT__,snd);
_PPCCompilerTokenErrorStrategy_Init(pass,__pRT__,snd);
@@ -48,24 +55,34 @@
_PPCContext_Init(pass,__pRT__,snd);
_PPCContextMemento_Init(pass,__pRT__,snd);
_PPCGuard_Init(pass,__pRT__,snd);
+_PPCIdGenerator_Init(pass,__pRT__,snd);
_PPCMethod_Init(pass,__pRT__,snd);
_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);
+_PPCScannerResultStrategy_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);
+_PEGFsaCharacterTransition_Init(pass,__pRT__,snd);
+_PEGFsaChoiceDeterminizator_Init(pass,__pRT__,snd);
+_PEGFsaDeterminizator_Init(pass,__pRT__,snd);
+_PEGFsaEpsilonTransition_Init(pass,__pRT__,snd);
_PEGFsaGenerator_Init(pass,__pRT__,snd);
+_PEGFsaPredicateTransition_Init(pass,__pRT__,snd);
+_PEGFsaSequenceDeterminizator_Init(pass,__pRT__,snd);
+_PEGFsaUncopiableState_Init(pass,__pRT__,snd);
_PPCAbstractLiteralNode_Init(pass,__pRT__,snd);
_PPCAbstractPredicateNode_Init(pass,__pRT__,snd);
_PPCAnyNode_Init(pass,__pRT__,snd);
_PPCCharacterNode_Init(pass,__pRT__,snd);
_PPCCodeGenerator_Init(pass,__pRT__,snd);
_PPCDelegateNode_Init(pass,__pRT__,snd);
+_PPCDistinctResultStrategy_Init(pass,__pRT__,snd);
_PPCEndOfFileNode_Init(pass,__pRT__,snd);
_PPCFSACodeGen_Init(pass,__pRT__,snd);
_PPCInlinedMethod_Init(pass,__pRT__,snd);
@@ -75,11 +92,15 @@
_PPCPluggableNode_Init(pass,__pRT__,snd);
_PPCProfilingContext_Init(pass,__pRT__,snd);
_PPCRewritingVisitor_Init(pass,__pRT__,snd);
+_PPCTokenCodeGenerator_Init(pass,__pRT__,snd);
+_PPCTokenizingCodeGen_Init(pass,__pRT__,snd);
_PPCTokenizingCompiler_Init(pass,__pRT__,snd);
_PPCTokenizingConfiguration_Init(pass,__pRT__,snd);
_PPCUniversalConfiguration_Init(pass,__pRT__,snd);
+_PPCUniversalResultStrategy_Init(pass,__pRT__,snd);
_PPCUnknownNode_Init(pass,__pRT__,snd);
_PPTokenizingCompiledParser_Init(pass,__pRT__,snd);
+_PEGFsaEOFTransition_Init(pass,__pRT__,snd);
_PPCAbstractActionNode_Init(pass,__pRT__,snd);
_PPCAndNode_Init(pass,__pRT__,snd);
_PPCCharSetPredicateNode_Init(pass,__pRT__,snd);
@@ -107,7 +128,6 @@
_PPCSequenceNode_Init(pass,__pRT__,snd);
_PPCSpecializingVisitor_Init(pass,__pRT__,snd);
_PPCStarNode_Init(pass,__pRT__,snd);
-_PPCTokenCodeGenerator_Init(pass,__pRT__,snd);
_PPCTokenConsumeNode_Init(pass,__pRT__,snd);
_PPCTokenDetector_Init(pass,__pRT__,snd);
_PPCTokenNode_Init(pass,__pRT__,snd);
--- a/compiler/stx_goodies_petitparser_compiler.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/stx_goodies_petitparser_compiler.st Mon Aug 17 12:13:16 2015 +0100
@@ -59,6 +59,7 @@
#'stx:goodies/petitparser' "PPActionParser - extended"
#'stx:goodies/petitparser/parsers/java' "PPJavaWhitespaceParser - extended"
#'stx:goodies/petitparser/parsers/smalltalk' "PPSmalltalkGrammar - extended"
+ #'stx:goodies/refactoryBrowser/parser' "RBLiteralNode - extended"
#'stx:libbasic' "Character - extended"
)
!
@@ -75,7 +76,6 @@
^ #(
#'stx:goodies/petitparser/analyzer' "PPSentinel - referenced by PPCompiledParser class>>referringParser"
- #'stx:goodies/refactoryBrowser/parser' "RBAssignmentNode - referenced by PPCCodeGenerator>>visitActionNode:"
#'stx:libbasic2' "IdentityBag - referenced by PEGFsa>>checkTransitionsIdentity"
#'stx:libview' "Color - referenced by PEGFsa>>viewGraphOn:"
)
@@ -110,16 +110,23 @@
^ #(
"<className> or (<className> attributes...) in load order"
PEGFsa
+ PEGFsaAbstractDeterminizator
PEGFsaFailure
PEGFsaInterpret
+ PEGFsaInterpretRecord
+ PEGFsaMinimizator
PEGFsaPair
PEGFsaState
+ PEGFsaStateInfo
PEGFsaTransition
+ PPCASTUtilities
PPCArguments
PPCBridge
PPCClassBuilder
PPCCodeBlock
PPCCodeGen
+ PPCCompilationError
+ PPCCompilationWarning
PPCCompiledMethod
PPCCompiler
PPCCompilerTokenErrorStrategy
@@ -130,24 +137,34 @@
PPCContext
PPCContextMemento
PPCGuard
+ PPCIdGenerator
PPCMethod
PPCNode
PPCNodeVisitor
PPCPluggableConfiguration
PPCScanner
PPCScannerCodeGenerator
+ PPCScannerResultStrategy
PPCTokenGuard
PPCompiledParser
PPMappedActionParser
#'stx_goodies_petitparser_compiler'
FooScanner
+ PEGFsaCharacterTransition
+ PEGFsaChoiceDeterminizator
+ PEGFsaDeterminizator
+ PEGFsaEpsilonTransition
PEGFsaGenerator
+ PEGFsaPredicateTransition
+ PEGFsaSequenceDeterminizator
+ PEGFsaUncopiableState
PPCAbstractLiteralNode
PPCAbstractPredicateNode
PPCAnyNode
PPCCharacterNode
PPCCodeGenerator
PPCDelegateNode
+ PPCDistinctResultStrategy
PPCEndOfFileNode
PPCFSACodeGen
PPCInlinedMethod
@@ -157,11 +174,15 @@
PPCPluggableNode
PPCProfilingContext
PPCRewritingVisitor
+ PPCTokenCodeGenerator
+ PPCTokenizingCodeGen
PPCTokenizingCompiler
PPCTokenizingConfiguration
PPCUniversalConfiguration
+ PPCUniversalResultStrategy
PPCUnknownNode
PPTokenizingCompiledParser
+ PEGFsaEOFTransition
PPCAbstractActionNode
PPCAndNode
PPCCharSetPredicateNode
@@ -189,7 +210,6 @@
PPCSequenceNode
PPCSpecializingVisitor
PPCStarNode
- PPCTokenCodeGenerator
PPCTokenConsumeNode
PPCTokenDetector
PPCTokenNode
@@ -329,6 +349,15 @@
Object canHavePPCId
PPCompositeParser asCompilerNode
PPSequenceParser map:
+ Object isFsaFailure
+ PPContext methodFinished:
+ PPContext tokenRead:
+ PPEndOfFileParser asCompilerNode
+ PPSmalltalkGrammar number
+ PPSmalltalkWhitespaceParser parseOn:
+ RBLiteralValueNode isLiteralNumber
+ RBProgramNode isLiteralNumber
+ UndefinedObject codePoint
)
! !
--- a/compiler/tests/FooScannerTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/FooScannerTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -14,7 +14,8 @@
fail: stream rule: rule
scanner initialize.
scanner stream: stream asPetitStream.
- result := scanner perform: rule.
+ scanner perform: rule.
+ result := scanner polyResult.
self assert: result isEmpty
!
@@ -26,8 +27,9 @@
fail: stream token: token rule: rule position: position
scanner initialize.
scanner stream: stream asPetitStream.
- result := scanner perform: rule.
-
+ scanner perform: rule.
+
+ result := scanner polyResult.
self assert: (result at: token ifAbsent: [nil]) isNil.
!
@@ -38,7 +40,8 @@
parse: stream token: token rule: rule position: position
scanner initialize.
scanner stream: stream asPetitStream.
- result := scanner perform: rule.
+ scanner perform: rule.
+ result := scanner polyResult.
self assert: (result includesKey: token).
self assert: (result at: token) = position.
@@ -85,7 +88,7 @@
!
testAB
- self parse: 'ab' token: #b rule: #nextTokenAB position: 2.
+ self parse: 'ab' token: #B rule: #nextTokenAB position: 2.
!
testABorBC
@@ -151,12 +154,21 @@
self parse: 'aaab' token: #AstarB rule: #nextTokenAstarB.
self fail: 'c' rule: #nextTokenAstarB.
-!
+! !
+
+!FooScannerTest methodsFor:'multivalues'!
testAuorA
- self parse: 'a' token: #a1 rule: #nextTokenAuorA.
- self parse: 'a' token: #a2 rule: #nextTokenAuorA.
+ self parse: 'a' token: #A1 rule: #nextTokenAuorA.
+ self parse: 'a' token: #A2 rule: #nextTokenAuorA.
self fail: 'b' rule: #nextTokenAuorA.
+!
+
+testMultiA
+ self parse: 'a' token: #A1 rule: #nextMultiTokenA position: 1.
+ self parse: 'a' token: #A2 rule: #nextMultiTokenA position: 1.
+
+ self fail: 'b' rule: #nextMultiTokenA.
! !
--- a/compiler/tests/Make.proto Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/Make.proto Mon Aug 17 12:13:16 2015 +0100
@@ -128,13 +128,18 @@
# 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)PEGFsaChoiceDeterminizationTest.$(O) PEGFsaChoiceDeterminizationTest.$(H): PEGFsaChoiceDeterminizationTest.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)PEGFsaIntegrationTest.$(O) PEGFsaIntegrationTest.$(H): PEGFsaIntegrationTest.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)PEGFsaMinimizationTest.$(O) PEGFsaMinimizationTest.$(H): PEGFsaMinimizationTest.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)PEGFsaSequenceDeterminizationTest.$(O) PEGFsaSequenceDeterminizationTest.$(H): PEGFsaSequenceDeterminizationTest.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)PPCASTUtilitiesTests.$(O) PPCASTUtilitiesTests.$(H): PPCASTUtilitiesTests.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)
@@ -142,6 +147,7 @@
$(OUTDIR)PPCContextTest.$(O) PPCContextTest.$(H): PPCContextTest.st $(INCLUDE_TOP)/stx/goodies/petitparser/tests/PPContextTest.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCCopyVisitorTest.$(O) PPCCopyVisitorTest.$(H): PPCCopyVisitorTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCGuardTest.$(O) PPCGuardTest.$(H): PPCGuardTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCIdGeneratorTest.$(O) PPCIdGeneratorTest.$(H): PPCIdGeneratorTest.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)PPCInliningVisitorTest.$(O) PPCInliningVisitorTest.$(H): PPCInliningVisitorTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCLL1VisitorTest.$(O) PPCLL1VisitorTest.$(H): PPCLL1VisitorTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCLTokenizingOptimizationTest.$(O) PPCLTokenizingOptimizationTest.$(H): PPCLTokenizingOptimizationTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
@@ -150,6 +156,7 @@
$(OUTDIR)PPCNodeFirstFollowNextTests.$(O) PPCNodeFirstFollowNextTests.$(H): PPCNodeFirstFollowNextTests.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCNodeTest.$(O) PPCNodeTest.$(H): PPCNodeTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(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)PPCOverlappingTokensTest.$(O) PPCOverlappingTokensTest.$(H): PPCOverlappingTokensTest.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)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)
--- a/compiler/tests/Make.spec Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/Make.spec Mon Aug 17 12:13:16 2015 +0100
@@ -52,13 +52,18 @@
COMMON_CLASSES= \
FooScannerTest \
+ PEGFsaChoiceDeterminizationTest \
PEGFsaDeterminizationTest \
PEGFsaGeneratorTest \
+ PEGFsaIntegrationTest \
PEGFsaInterpretTest \
+ PEGFsaMinimizationTest \
PEGFsaScannerIntegrationTest \
+ PEGFsaSequenceDeterminizationTest \
PEGFsaStateTest \
PEGFsaTest \
PEGFsaTransitionTest \
+ PPCASTUtilitiesTests \
PPCClassBuilderTest \
PPCCodeGeneratorTest \
PPCCompilerTest \
@@ -66,6 +71,7 @@
PPCContextTest \
PPCCopyVisitorTest \
PPCGuardTest \
+ PPCIdGeneratorTest \
PPCInliningVisitorTest \
PPCLL1VisitorTest \
PPCLTokenizingOptimizationTest \
@@ -74,6 +80,7 @@
PPCNodeFirstFollowNextTests \
PPCNodeTest \
PPCOptimizeChoicesTest \
+ PPCOverlappingTokensTest \
PPCRecognizerComponentDetectorTest \
PPCRecognizerComponentVisitorTest \
PPCScannerCodeGeneratorTest \
@@ -92,13 +99,18 @@
COMMON_OBJS= \
$(OUTDIR_SLASH)FooScannerTest.$(O) \
+ $(OUTDIR_SLASH)PEGFsaChoiceDeterminizationTest.$(O) \
$(OUTDIR_SLASH)PEGFsaDeterminizationTest.$(O) \
$(OUTDIR_SLASH)PEGFsaGeneratorTest.$(O) \
+ $(OUTDIR_SLASH)PEGFsaIntegrationTest.$(O) \
$(OUTDIR_SLASH)PEGFsaInterpretTest.$(O) \
+ $(OUTDIR_SLASH)PEGFsaMinimizationTest.$(O) \
$(OUTDIR_SLASH)PEGFsaScannerIntegrationTest.$(O) \
+ $(OUTDIR_SLASH)PEGFsaSequenceDeterminizationTest.$(O) \
$(OUTDIR_SLASH)PEGFsaStateTest.$(O) \
$(OUTDIR_SLASH)PEGFsaTest.$(O) \
$(OUTDIR_SLASH)PEGFsaTransitionTest.$(O) \
+ $(OUTDIR_SLASH)PPCASTUtilitiesTests.$(O) \
$(OUTDIR_SLASH)PPCClassBuilderTest.$(O) \
$(OUTDIR_SLASH)PPCCodeGeneratorTest.$(O) \
$(OUTDIR_SLASH)PPCCompilerTest.$(O) \
@@ -106,6 +118,7 @@
$(OUTDIR_SLASH)PPCContextTest.$(O) \
$(OUTDIR_SLASH)PPCCopyVisitorTest.$(O) \
$(OUTDIR_SLASH)PPCGuardTest.$(O) \
+ $(OUTDIR_SLASH)PPCIdGeneratorTest.$(O) \
$(OUTDIR_SLASH)PPCInliningVisitorTest.$(O) \
$(OUTDIR_SLASH)PPCLL1VisitorTest.$(O) \
$(OUTDIR_SLASH)PPCLTokenizingOptimizationTest.$(O) \
@@ -114,6 +127,7 @@
$(OUTDIR_SLASH)PPCNodeFirstFollowNextTests.$(O) \
$(OUTDIR_SLASH)PPCNodeTest.$(O) \
$(OUTDIR_SLASH)PPCOptimizeChoicesTest.$(O) \
+ $(OUTDIR_SLASH)PPCOverlappingTokensTest.$(O) \
$(OUTDIR_SLASH)PPCRecognizerComponentDetectorTest.$(O) \
$(OUTDIR_SLASH)PPCRecognizerComponentVisitorTest.$(O) \
$(OUTDIR_SLASH)PPCScannerCodeGeneratorTest.$(O) \
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PEGFsaChoiceDeterminizationTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,194 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PEGFsaChoiceDeterminizationTest
+ instanceVariableNames:'fsa a b c result d interpreter e t1 t2 state anotherState parser
+ generator'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-FSA'
+!
+
+!PEGFsaChoiceDeterminizationTest 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.
+
+ result := interpreter interpret: anFsa on: stream.
+
+ self assert: result size = 1.
+ self assert: ((result anyOne) = end) description: 'wrong position'.
+
+ ^ result anyOne
+!
+
+determinizator
+ ^ PEGFsaChoiceDeterminizator new
+!
+
+determinize: anFsa
+ ^ self determinizator determinize: anFsa
+!
+
+fsaFrom: aNode
+ ^ (aNode accept: generator)
+ yourself
+!
+
+joinState: s1 with: s2
+ ^ self determinizator joinState: s1 with: s2
+!
+
+setUp
+ a := PEGFsaState new name: #a; retval: #token; yourself.
+ b := PEGFsaState new name: #b; retval: #token; yourself.
+ c := PEGFsaState new name: #c; retval: #token; yourself.
+ d := PEGFsaState new name: #d; retval: #token; yourself.
+ e := PEGFsaState new name: #e; retval: #token; yourself.
+
+ state := PEGFsaState new name: #state; retval: #token; yourself.
+ anotherState := PEGFsaState new name: #anotherState; retval: #token; yourself.
+
+ t1 := PEGFsaCharacterTransition new.
+ t2 := PEGFsaCharacterTransition new.
+
+ fsa := PEGFsa new.
+ generator := PEGFsaGenerator new.
+
+ interpreter := PEGFsaInterpret new
+ yourself.
+!
+
+testAAorA
+ parser := 'aa' asParser / 'a' asParser.
+ fsa := self fsaFrom: parser asCompilerTree.
+
+" self assert: fsa states size = 2."
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self assert: fsa parse: 'a'.
+ self assert: fsa parse: 'aa'.
+ self assert: fsa fail: 'b'.
+!
+
+testAorAA
+ parser := 'a' asParser / 'aa' asParser.
+ fsa := self fsaFrom: parser asCompilerTree.
+
+" self assert: fsa states size = 2."
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self assert: fsa parse: 'a'.
+ self assert: fsa parse: 'aa' end: 1.
+ self assert: fsa fail: 'b'.
+!
+
+testDeterminizeFsa
+ 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.
+
+ b final: true.
+ b priority: 0.
+ c final: true.
+ c priority: 0.
+ c failure: true.
+
+ fsa addTransitionFrom: a to: d on: $a priority: -1.
+ fsa addTransitionFrom: d to: e on: $a priority: -1.
+
+ d priority: -1.
+ e final: true.
+ e priority: -1.
+ e failure: true.
+
+
+ self determinize: fsa.
+
+ self assert: fsa states size = 3.
+ self assert: a transitions size = 1.
+ self assert: a destination isFinal.
+ self assert: a destination destination isFinal.
+!
+
+testDeterminizeFsa2
+ 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.
+
+ b final: true.
+ b priority: 0.
+ c final: true.
+ c priority: 0.
+ c failure: true.
+
+ fsa addTransitionFrom: a to: d on: $a priority: -1.
+ fsa addTransitionFrom: d to: e on: $b priority: -1.
+
+ d priority: -1.
+ e final: true.
+ e priority: -1.
+ e failure: true.
+
+ self determinize: fsa.
+
+ self assert: fsa states size = 3.
+ self assert: a transitions size = 1.
+ self assert: a destination isFinal.
+ self assert: a destination transitions size = 1.
+ self assert: a destination destination isFsaFailure.
+!
+
+testNot
+ parser := ('aa' asParser, 'aa' asParser not) / ('aa' asParser, 'aa' asParser).
+ fsa := self fsaFrom: parser asCompilerTree.
+
+
+" self assert: fsa states size = 2."
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self assert: fsa parse: 'aabc' end: 2.
+ self assert: fsa parse: 'aaa' end: 2.
+ self assert: fsa parse: 'aa'.
+
+ self assert: fsa parse: 'aaaa'.
+ self assert: fsa parse: 'aaaaa' end: 4.
+
+ self assert: fsa fail: 'ab'.
+! !
+
--- a/compiler/tests/PEGFsaDeterminizationTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/PEGFsaDeterminizationTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -3,7 +3,7 @@
"{ NameSpace: Smalltalk }"
TestCase subclass:#PEGFsaDeterminizationTest
- instanceVariableNames:'fsa a b c result d interpreter e'
+ instanceVariableNames:'parser1 parser2 fsa generator'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Tests-FSA'
@@ -11,249 +11,107 @@
!PEGFsaDeterminizationTest methodsFor:'as yet unclassified'!
-assert: anFsa fail: input
- | stream |
- stream := input asPetitStream.
-
- result := interpreter interpret: anFsa on: stream.
-
- self assert: result isEmpty.
- ^ result
+determinizator
+ ^ PEGFsaDeterminizator new
!
-assert: anFsa parse: input retval: name
- ^ self assert: anFsa parse: input retval: name end: input size
+fsaFrom: aNode
+ ^ (aNode accept: generator)
+ determinize;
+ yourself
!
-assert: anFsa parse: input retval: name end: end
- | stream |
- stream := input asPetitStream.
+merge
+ | startState fsa1 fsa2 |
+ fsa := PEGFsa new.
+ startState := PEGFsaState new.
- result := interpreter interpret: anFsa on: stream.
+ fsa addState: startState.
+ fsa startState: startState.
- self assert: result isEmpty not.
- self assert: ((result at: name) = end) description: 'wrong position'.
+ fsa1 := self fsaFrom: parser1 asCompilerTree.
+ fsa1 retval: #token1.
+ fsa adopt: fsa1.
+ fsa addTransitionFrom: startState to: fsa1 startState.
- ^ result
-!
-assertFail: name
- self assert: (result includesKey: name) not
-!
-
-assertPass: name
- self assert: (result includesKey: name)
+ fsa2 := self fsaFrom: parser2 asCompilerTree.
+ fsa2 retval: #token2.
+ fsa adopt: fsa2.
+ fsa addTransitionFrom: startState to: fsa2 startState.
+
+ self determinizator determinize: fsa
!
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.
+ super setUp.
+ generator := PEGFsaGenerator new.
!
-testAB
- fsa addState: a.
- fsa addState: b.
- fsa addState: c.
- fsa addState: d.
- fsa startState: a.
- fsa finalState: d.
+testA_A
+ parser1 := 'a' asParser.
+ parser2 := 'a' asParser.
+
+ self merge.
- 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'.
+ self assert: fsa states size = 2.
+ self assert: fsa finalStates size = 1.
+ self assert: fsa finalStates anyOne retvals size = 2.
+ self assert: (fsa finalStates anyOne retvals includes: #token1).
+ self assert: (fsa finalStates anyOne retvals includes: #token2).
!
-testAPlusA
- fsa addState: a.
- fsa addState: b.
- fsa addState: c.
- fsa addState: d.
- fsa startState: a.
- fsa finalState: d.
+testA_AB
+ parser1 := 'a' asParser.
+ parser2 := 'ab' asParser.
+
+ self merge.
- 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 = 3.
+ self assert: fsa finalStates size = 2.
+ self assert: fsa startState destination retvals size = 1.
+ self assert: fsa startState destination retval = #token1.
-" 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'.
+ self assert: fsa startState destination destination retvals size = 1.
+ self assert: fsa startState destination destination retval = #token2.
!
-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.
+testID_KW
+ parser1 := #word asParser plus.
+ parser2 := #word asParser plus, $: asParser.
- fsa determinize.
-
- self assert: fsa states size = 3.
- self assert: fsa isDeterministic.
- self assert: fsa isWithoutEpsilons.
+ self merge.
- 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'.
-!
+ self assert: fsa states size = 3.
+ self assert: fsa finalStates size = 2.
-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.
+ self assert: (fsa finalStates anySatisfy: [ :fs | fs retvals includes: #token1 ]).
+ self assert: (fsa finalStates anySatisfy: [ :fs | fs retvals includes: #token2 ]).
- 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.
+testTrue_ID
+ parser1 := 'true' asParser.
+ parser2 := #word asParser plus.
- 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.
+ self merge.
- 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'.
+ self assert: fsa states size = 6.
+ self assert: fsa finalStates size = 5.
+ "Only 1 state with both #token1 and #token2"
+ self assert: ((fsa finalStates select: [:fs | fs retvals size = 2]) size = 1).
!
-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.
+testTrue_True
+ parser1 := 'true' asParser.
+ parser2 := 'true' asParser.
- c priority: 0.
- e priority: 0.
+ self merge.
- 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'.
+ self assert: fsa states size = 5.
+ self assert: fsa finalStates size = 1.
+ self assert: fsa finalStates anyOne retvals size = 2.
+ self assert: (fsa finalStates anyOne retvals includes: #token1).
+ self assert: (fsa finalStates anyOne retvals includes: #token2).
! !
--- a/compiler/tests/PEGFsaGeneratorTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/PEGFsaGeneratorTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -40,7 +40,8 @@
fsaFrom: aNode
^ (aNode accept: generator)
- compact;
+ determinize;
+ minimize;
yourself
!
@@ -48,208 +49,20 @@
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'.
-!
+!PEGFsaGeneratorTest methodsFor:'basic'!
-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.
+testAnyNode
+ node := PPCAnyNode new
+ yourself.
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: ''.
+ self assert: fsa parse: 'a'.
+ self assert: fsa parse: 'b'.
+ self assert: fsa parse: String cr.
+ self assert: fsa parse: String tab.
!
testCharSetPredicateNode
@@ -309,18 +122,14 @@
self assert: fsa fail: 'fof'.
!
-testChoicePriorities
- | parser |
- parser := ($a asParser optional, $b asParser optional) / $a asParser.
- node := parser asCompilerTree.
+testEndOfFileNode
+ node := PPCEndOfFileNode new
+ yourself.
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.
+ self assert: fsa parse: '' end: 1.
+ self assert: fsa fail: 'a'.
!
testLiteralNode
@@ -346,19 +155,6 @@
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
@@ -440,6 +236,38 @@
self assert: fsa fail: 'boz'.
!
+testSequenceNode3
+ | literal1 literal2 literal3 choice |
+ literal1 := PPCLiteralNode new
+ literal: 'a';
+ yourself.
+ literal2 := PPCLiteralNode new
+ literal: 'b';
+ yourself.
+
+ literal3 := PPCLiteralNode new
+ literal: 'c';
+ yourself.
+
+
+ choice := PPCChoiceNode new
+ children: { literal1 . literal2 };
+ yourself.
+
+ node := PPCSequenceNode new
+ children: { choice . literal3 };
+ yourself.
+
+ fsa := self fsaFrom: node.
+
+
+ self assert: fsa parse: 'ac'.
+ self assert: fsa parse: 'bc'.
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'b'.
+ self assert: fsa fail: 'c'.
+!
+
testStarNode
| literal |
literal := PPCLiteralNode new
@@ -457,6 +285,758 @@
self assert: fsa parse: 'foofoofoo'.
! !
+!PEGFsaGeneratorTest methodsFor:'complex'!
+
+testAAAAnot_Astar
+ | parser |
+ parser := 'aaaa' asParser not, ($a asParser star).
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: ''.
+ self assert: fsa parse: 'a'.
+ self assert: fsa parse: 'aa'.
+ self assert: fsa parse: 'aaa'.
+
+ self assert: fsa fail: 'aaaa'.
+ self assert: fsa fail: 'aaaaa'.
+ self assert: fsa fail: 'aaaaaa'.
+ self assert: fsa fail: 'aaaaaaa'.
+!
+
+testAAAAorA_AA
+ | parser |
+ parser := ('aaaaa' asParser / 'a' asParser), 'aa' asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'aaaaaaa'.
+ self assert: fsa parse: 'aaa'.
+ self assert: fsa parse: 'aaaa' end: 3.
+
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'aa'.
+ self assert: fsa fail: 'aaaaa'.
+ self assert: fsa fail: 'aaaaaa'.
+!
+
+testAAAnot_Aplus
+ | 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'.
+!
+
+testAAAorA_A
+ | parser |
+ parser := ('aaa' asParser / 'a' asParser), 'a' asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'aaaa'.
+ self assert: fsa parse: 'aa'.
+ self assert: fsa fail: 'aaa'.
+ self assert: fsa fail: 'a'.
+!
+
+testAAAorA_AA
+ | parser |
+ parser := ('aaa' asParser / 'a' asParser), 'aa' asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'aaaaa'.
+ self assert: fsa parse: 'aaaaaa' end: 5.
+ self assert: fsa parse: 'aaaaaaa' end: 5.
+
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'aa'.
+ self assert: fsa fail: 'aaa'.
+ self assert: fsa fail: 'aaaa'.
+!
+
+testAAAorA_Astar
+ | parser |
+ parser := (('aaa' asParser / 'a' asParser), 'a' asParser) star.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: ''.
+ self assert: fsa parse: 'aa'.
+ self assert: fsa parse: 'aaaa'.
+ self assert: fsa parse: 'aaaaaa'.
+ self assert: fsa parse: 'aaaaaaaa'.
+
+ "So far the FSA cannot handle loops with such as tokens as aaa/a, a"
+ self flag: 'not working :('.
+ self assert: fsa parse: 'aaaaaaa' end: 4.
+
+ self assert: fsa fail: 'aaa'.
+ self assert: fsa fail: 'a'.
+!
+
+testAAAstar_AA
+ | parser |
+ parser := ('aaa' asParser) star, 'aa' asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'aa'.
+ self assert: fsa parse: 'aaaaa'.
+ self assert: fsa parse: 'aaaaaaaa'.
+
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'aaa'.
+ self assert: fsa fail: 'aaaa'.
+ self assert: fsa fail: 'aaaaaaa'.
+!
+
+testAAorA_A
+ | parser |
+ parser := ('aa' asParser / 'a' asParser), 'a' asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'aaa'.
+ self assert: fsa fail: 'aa'.
+ self assert: fsa fail: 'a'.
+!
+
+testAAorA_AAorA
+ | parser |
+ parser := ('aa' asParser / 'a' asParser), ('aa' asParser / 'a' asParser).
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'aaaa'.
+ self assert: fsa parse: 'aaa'.
+
+ self assert: fsa fail: ''.
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'aa'.
+!
+
+testAAorA_A_B
+ | parser |
+ parser := ('aa' asParser / 'a' asParser), 'a' asParser, 'b' asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'aaab'.
+ self assert: fsa fail: 'aab'.
+!
+
+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_Bnot
+ | parser |
+ parser := $a asParser, $b asParser not.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'a'.
+ self assert: fsa parse: 'ac' end: 1.
+ self assert: fsa parse: 'aaa' end: 1.
+ self assert: fsa fail: 'ab'.
+ self assert: fsa fail: 'b'.
+!
+
+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'.
+!
+
+testAoptional_Boptional
+ | parser |
+ parser := $a asParser optional, $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: 'bc' end: 1.
+ self assert: fsa parse: 'a'.
+ self assert: fsa parse: 'b'.
+ self assert: fsa parse: 'c' end: 0.
+ self assert: fsa parse: ''.
+!
+
+testAoptionalstar
+ | parser |
+ parser := 'a' asParser optional star.
+ node := parser asCompilerTree.
+
+ self should: [fsa := self fsaFrom: node] raise: Exception.
+
+!
+
+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.
+!
+
+testAplusA
+ | parser |
+ parser := $a asParser plus, $a asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'aa'.
+ self assert: fsa fail: 'aaa'.
+!
+
+testAplusB
+ | parser |
+ parser := $a asParser plus, $b asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'ab'.
+ self assert: fsa parse: 'aaab'.
+ self assert: fsa parse: 'ab'.
+
+ self assert: fsa fail: 'b'.
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'ac'.
+ self assert: fsa fail: 'aac'.
+!
+
+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'.
+!
+
+testAstar_Bplus
+ | parser |
+ parser := 'a' asParser star, 'b' asParser plus.
+ node := parser asCompilerTree.
+
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'b'.
+ self assert: fsa parse: 'bbbb'.
+ self assert: fsa parse: 'aaaab'.
+
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'aaa'.
+!
+
+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: ''.
+!
+
+testChoice
+ | 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.
+!
+
+testChoice2
+ | parser |
+ parser := 'aaa' asParser / 'aa' asParser / 'a' asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'aaa'.
+ self assert: fsa parse: 'aa'.
+ self assert: fsa parse: 'a'
+!
+
+testIdentity
+ | parser quot |
+ quot := $" asParser.
+ parser := quot, $a asParser star, quot.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: '""'.
+ self assert: fsa parse: '"a"'.
+ self assert: fsa parse: '"aa"'.
+ self assert: fsa parse: '"aaaaaaaa"'.
+!
+
+testKwPlus
+ | parser |
+ parser := (#word asParser plus, $: asParser) plus.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'foo:bar:baz:'.
+ self assert: fsa parse: 'foo:bar:baz' end: 8.
+
+ self assert: fsa fail: ''.
+ self assert: fsa fail: 'foo'.
+!
+
+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: 'aaaaa'.
+ self assert: fsa fail: ''.
+!
+
+testOptional
+ | 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.
+!
+
+testOptional2
+ | parser |
+ parser := ($a asParser, $b asParser optional) / 'ac' asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'ab'.
+ self assert: fsa parse: 'a'.
+ self assert: fsa fail: 'b'.
+ self assert: fsa parse: 'ac' end: 1.
+!
+
+testPlus
+ | parser |
+ parser := ('aa' asParser) plus, ('a' asParser / 'aa' asParser).
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'aaa'.
+ self assert: fsa parse: 'aaaaa'.
+
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'aa'.
+ self assert: fsa fail: 'aaaa'.
+!
+
+testPlus2
+ | parser |
+ parser := ('aaaaaa' asParser / 'a' asParser) plus.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'a'.
+ self assert: fsa parse: 'aa'.
+ self assert: fsa parse: 'aaa'.
+ self assert: fsa parse: 'aaaa'.
+ self assert: fsa parse: 'aaaaa'.
+ self assert: fsa parse: 'aaaaaa'.
+ self assert: fsa parse: 'aaaaaaa'.
+
+ self assert: fsa fail: ''.
+!
+
+testPlus3
+ | parser |
+ parser := ('aaaaaa' asParser / 'aa' asParser) plus.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'aa'.
+ self assert: fsa parse: 'aaaa'.
+ self assert: fsa parse: 'aaaaaa'.
+
+ self assert: fsa fail: ''.
+ self assert: fsa fail: 'a'.
+
+ self assert: fsa parse: 'aaa' end: 2.
+ self assert: fsa parse: 'aaaaa' end: 4.
+ self assert: fsa parse: 'aaaaaaa' end: 6.
+
+!
+
+testPlus4
+ | parser |
+ parser := ('aaa' asParser / 'aa' asParser / 'a' asParser) plus.
+ node := parser asCompilerTree.
+
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'a'.
+ self assert: fsa parse: 'aa'.
+ self assert: fsa parse: 'aaa'.
+ self assert: fsa parse: 'aaaa'.
+ self assert: fsa parse: 'aaaaa'.
+ self assert: fsa parse: 'aaaaaa'.
+!
+
+testPlus5
+ | parser |
+ parser := ('aaa' asParser / 'aa' asParser / 'b' asParser) plus.
+ node := parser asCompilerTree.
+
+
+ fsa := self fsaFrom: node.
+
+
+ self assert: fsa parse: 'b'.
+ self assert: fsa parse: 'bb'.
+ self assert: fsa parse: 'bbaaa'.
+ self assert: fsa parse: 'bbaaabbaa'.
+
+ self assert: fsa parse: 'aa'.
+ self assert: fsa parse: 'aaa'.
+ self assert: fsa parse: 'aaaaa'.
+ self assert: fsa parse: 'aaaaaa'.
+ self assert: fsa parse: 'aaaaaab'.
+
+ self assert: fsa parse: 'bba' end: 2.
+ self assert: fsa parse: 'aaaa' end: 3.
+!
+
+testSequence
+ | parser |
+ parser := ('aa' asParser plus), ('aa' asParser plus).
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'aa'.
+ self assert: fsa fail: 'aaa'.
+ self assert: fsa fail: 'aaaa'.
+ self assert: fsa fail: 'aaaaa'.
+ self assert: fsa fail: 'aaaaaa'.
+!
+
+testSequence2
+ | parser |
+ parser := ('aa' asParser star), ('bb' asParser star).
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'aa'.
+ self assert: fsa parse: 'aaaa'.
+ self assert: fsa parse: 'aaaaaa'.
+ self assert: fsa parse: 'aaaaaaaa'.
+
+ self assert: fsa parse: 'a' end: 0.
+ self assert: fsa parse: 'aaa' end: 2.
+ self assert: fsa parse: 'aaaaa' end: 4.
+ self assert: fsa parse: 'aaaaaaa' end: 6.
+ self assert: fsa parse: 'aaaaaaaaa' end: 8.
+!
+
+testSequence3
+ | parser |
+ parser := 'a' asParser, 'b' asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: (fsa states noneSatisfy: [ :s | s isFsaFailure ]).
+!
+
+testSequence4
+ | parser |
+ parser := 'a' asParser star, 'b' asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: (fsa states noneSatisfy: [ :s | s isFsaFailure ]).
+!
+
+testUnaryOrKw
+ | parser unary kw |
+ unary := #letter asParser plus, $: asParser not.
+ kw := #letter asParser plus, $: asParser.
+ parser := unary / kw.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'foo'.
+ self assert: fsa parse: 'foo:'.
+
+ self assert: fsa fail: '123'.
+!
+
+testUnaryOrKwPlus
+ | parser unary kw |
+ unary := #letter asParser plus, $: asParser not.
+ kw := #letter asParser plus, $: asParser.
+ parser := (unary / kw) plus.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'foo'.
+ self assert: fsa parse: 'foo:'.
+ self assert: fsa parse: 'foo:bar:'.
+ self assert: fsa fail: '123'.
+!
+
+testUnaryOrMultiword
+ | parser unary kw |
+ unary := #letter asParser plus, $: asParser not.
+ kw := #letter asParser plus, $: asParser.
+ parser := unary / (kw plus).
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'foo'.
+ self assert: fsa parse: 'foo:'.
+ self assert: fsa parse: 'foo:bar:'.
+ self assert: fsa fail: '123'.
+! !
+
+!PEGFsaGeneratorTest methodsFor:'recursive'!
+
+testRecursive
+ | parser |
+ parser := PPDelegateParser new.
+
+ parser setParser: ($a asParser, parser) / $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: 'aaa'.
+ self assert: fsa fail: ''.
+ self assert: fsa fail: 'aac'.
+!
+
+testRecursive2
+ | parser |
+ parser := PPDelegateParser new.
+
+ parser setParser: (($a asParser / $b asParser), parser) / $c asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'c'.
+ self assert: fsa parse: 'ac'.
+ self assert: fsa parse: 'bc'.
+ self assert: fsa parse: 'ababc'.
+ self assert: fsa fail: 'aaab'.
+ self assert: fsa fail: 'ab'.
+! !
+
!PEGFsaGeneratorTest class methodsFor:'documentation'!
version_HG
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PEGFsaIntegrationTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,174 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PEGFsaIntegrationTest
+ instanceVariableNames:'result node fsa generator interpreter parser1 parser2 parser3'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-FSA'
+!
+
+
+!PEGFsaIntegrationTest methodsFor:'as yet unclassified'!
+
+determinizator
+ ^ PEGFsaDeterminizator new
+!
+
+failScan: input token: token
+ | stream |
+ stream := input asPetitStream.
+
+ result := interpreter interpret: fsa on: stream.
+ self assert: (result includes: token) not.
+
+ ^ result
+!
+
+fsaFrom: aNode
+ ^ (aNode accept: generator)
+ determinize;
+ minimize;
+ yourself
+!
+
+merge
+ | startState fsa1 fsa2 fsa3 |
+ fsa := PEGFsa new.
+ startState := PEGFsaState new.
+
+ fsa addState: startState.
+ fsa startState: startState.
+
+ fsa1 := self fsaFrom: parser1 asCompilerTree.
+ fsa1 retval: #token1.
+ fsa adopt: fsa1.
+ fsa addTransitionFrom: startState to: fsa1 startState.
+
+ fsa2 := self fsaFrom: parser2 asCompilerTree.
+ fsa2 retval: #token2.
+ fsa adopt: fsa2.
+ fsa addTransitionFrom: startState to: fsa2 startState.
+
+ parser3 isNil ifFalse: [
+ fsa3 := self fsaFrom: parser3 asCompilerTree.
+ fsa3 retval: #token3.
+ fsa adopt: fsa3.
+ fsa addTransitionFrom: startState to: fsa3 startState.
+ ].
+
+ self determinizator determinize: fsa.
+ fsa minimize.
+!
+
+scan: input token: token
+ ^ self scan: input token: token position: input size
+!
+
+scan: input token: token position: position
+ | stream |
+ stream := input asPetitStream.
+
+ result := interpreter interpret: fsa on: stream.
+
+ self assert: (result includesKey: token).
+ self assert: (result at: token) = position.
+
+ ^ result
+!
+
+setUp
+ super setUp.
+ generator := PEGFsaGenerator new.
+ interpreter := PEGFsaInterpret new.
+!
+
+testFooOrId
+ parser1 := 'foo' asParser.
+ parser2 := #letter asParser plus.
+
+ self merge.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+ self assert: fsa hasDistinctRetvals not.
+
+ self failScan: 'bar' token: #token1.
+ self scan: 'bar' token: #token2 position: 3.
+
+ self scan: 'foo' token: #token1 position: 3.
+ self scan: 'foo' token: #token2 position: 3.
+
+ self scan: 'foobar' token: #token1 position: 3.
+ self scan: 'foobar' token: #token2 position: 6.
+
+!
+
+testTrueOrId
+ parser1 := 'true' asParser.
+ parser2 := #letter asParser plus.
+
+ self merge.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+ self assert: fsa hasDistinctRetvals not.
+
+ self failScan: 'false' token: #token1.
+ self scan: 'false' token: #token2 position: 5.
+
+ self scan: 'true' token: #token1 position: 4.
+ self scan: 'true' token: #token2 position: 4.
+
+ self scan: 'truecrypt' token: #token1 position: 4.
+ self scan: 'truecrypt' token: #token2 position: 9.
+
+!
+
+testUnaryOrKW
+ parser1 := #letter asParser plus, $: asParser not.
+ parser2 := #letter asParser plus, $: asParser.
+
+ self merge.
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self scan: 'foo' token: #token1.
+ self failScan: 'foo' token: #token2.
+
+ self failScan: 'foo:' token: #token1.
+ self scan: 'foo:' token: #token2.
+!
+
+testUnaryOrKWorId
+ parser1 := #letter asParser plus, $: asParser not.
+ parser2 := #letter asParser plus, $: asParser.
+ parser3 := #letter asParser plus.
+
+ self merge.
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self scan: 'foo' token: #token1.
+ self failScan: 'foo' token: #token2.
+ self scan: 'foo' token: #token3.
+
+ self failScan: 'foo:' token: #token1.
+ self scan: 'foo:' token: #token2.
+ self scan: 'foo' token: #token3.
+
+
+ self failScan: '123' token: #token1.
+ self failScan: '123' token: #token2.
+ self failScan: '123' token: #token3.
+
+! !
+
+!PEGFsaIntegrationTest class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/compiler/tests/PEGFsaInterpretTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/PEGFsaInterpretTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -68,16 +68,32 @@
!
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.
+ a := PEGFsaState new name: #a; retval: #token; yourself.
+ b := PEGFsaState new name: #b; retval: #token; yourself.
+ c := PEGFsaState new name: #c; retval: #token; yourself.
+ d := PEGFsaState new name: #d; retval: #token; yourself.
+ e := PEGFsaState new name: #e; retval: #token; yourself.
fsa := PEGFsa new.
interpreter := PEGFsaInterpret new
yourself.
+! !
+
+!PEGFsaInterpretTest methodsFor:'tests'!
+
+testA
+ fsa addState: a.
+ fsa addState: b.
+ fsa startState: a.
+ fsa finalState: b.
+
+ fsa addTransitionFrom: a to: b on: $a.
+
+ self assert: fsa parse: 'a'.
+ self assert: fsa parse: 'abc' end: 1.
+
+ self assert: fsa fail: 'b'.
!
testAB
@@ -90,8 +106,8 @@
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 parse: 'ab' retval: #token.
+ self assert: fsa parse: 'abc' retval: #token end: 2.
self assert: fsa fail: 'ac'.
!
@@ -117,45 +133,17 @@
testAOptional
fsa addState: a.
fsa addState: b.
- fsa addState: c.
fsa startState: a.
+ fsa finalState: 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.
@@ -172,6 +160,26 @@
self assert: fsa fail: 'ac'.
!
+testA_Bnot
+ 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: $b.
+
+ c retval: #token.
+ c failure: true.
+
+ self assert: fsa parse: 'ac' retval: #token end: 1.
+ self assert: fsa parse: 'aaa' retval: #token end: 1.
+
+ self assert: fsa fail: 'ab'.
+!
+
testChoice
fsa addState: a.
fsa addState: b.
@@ -189,24 +197,6 @@
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.
@@ -214,8 +204,10 @@
" fsa addTransitionFrom: a to: b.
"
- self assert: fsa parse: '' retval: #a.
-!
+ self assert: fsa parse: '' retval: #token.
+! !
+
+!PEGFsaInterpretTest methodsFor:'tests - multivalues'!
testEpsilonChoice
fsa addState: a.
@@ -232,9 +224,12 @@
fsa addTransitionFrom: a to: b.
fsa addTransitionFrom: a to: d.
+
+ c retval: #c.
+ e retval: #e.
- self assert: fsa parse: 'c'.
- self assert: fsa parse: 'e'.
+ self assert: fsa parse: 'c' retval: #c.
+ self assert: fsa parse: 'e' retval: #e.
self assert: fsa fail: 'a'
!
@@ -254,6 +249,9 @@
fsa addTransitionFrom: a to: b.
fsa addTransitionFrom: a to: d.
+
+ c retval: #c.
+ e retval: #e.
self assert: fsa parse: 'a'.
self assert: #c position: 1.
@@ -262,72 +260,7 @@
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
+testMultivalueChoice
fsa addState: a.
fsa addState: b.
fsa addState: c.
@@ -335,108 +268,16 @@
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: b on: $a.
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.
+ b retval: #b.
+ c retval: #c.
self assert: fsa parse: 'a'.
self assert: #b position: 1.
-
- self assert: fsa fail: 'aa'
+ self assert: #c position: 1.
+
+ self assert: fsa fail: 'b'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PEGFsaMinimizationTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,256 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PEGFsaMinimizationTest
+ instanceVariableNames:'fsa a b c d e state t1 anotherState t2 t3 t4'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-FSA'
+!
+
+!PEGFsaMinimizationTest methodsFor:'as yet unclassified'!
+
+assert: s1 equals: s2
+ self assert: (self minimizator state: s1 equals: s2).
+!
+
+assert: s1 notEquals: s2
+ self assert: (self minimizator state: s1 equals: s2) not.
+!
+
+minimizator
+ ^ PEGFsaMinimizator new
+!
+
+setUp
+ a := PEGFsaState new name: #a; retval: #token; yourself.
+ b := PEGFsaState new name: #b; retval: #token; yourself.
+ c := PEGFsaState new name: #c; retval: #token; yourself.
+ d := PEGFsaState new name: #d; retval: #token; yourself.
+ e := PEGFsaState new name: #e; retval: #token; yourself.
+
+ state := PEGFsaState new name: #state; retval: #state; yourself.
+ anotherState := PEGFsaState new name: #anotherState; retval: #anotherState; yourself.
+
+ t1 := PEGFsaCharacterTransition new.
+ t2 := PEGFsaCharacterTransition new.
+ t3 := PEGFsaCharacterTransition new.
+ t4 := PEGFsaCharacterTransition new.
+
+ fsa := PEGFsa new.
+! !
+
+!PEGFsaMinimizationTest methodsFor:'tests'!
+
+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.
+!
+
+testMinimze3
+ | merged |
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+
+ fsa startState: a.
+ fsa finalState: b.
+ fsa finalState: c.
+
+ "states c and d are equivalent"
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: a to: c on: $a.
+
+ fsa addTransitionFrom: b to: b on: $b.
+ fsa addTransitionFrom: c to: c on: $b.
+
+
+ fsa minimize.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa states size = 2.
+
+ merged := a destination.
+ self assert: merged transitions size = 1.
+ self assert: merged destination isFinal.
+!
+
+testMinimze4
+ | merged |
+ 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: a to: d on: $a.
+
+ fsa addTransitionFrom: b to: c on: $b.
+ fsa addTransitionFrom: c to: b on: $b.
+
+ fsa addTransitionFrom: d to: e on: $b.
+ fsa addTransitionFrom: e to: d on: $b.
+
+ fsa minimize.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa states size = 3.
+
+ merged := a destination.
+ self assert: merged transitions size = 1.
+ self assert: merged destination isFinal.
+!
+
+testStateEquals
+ state addTransition: t1.
+ anotherState addTransition: t2.
+
+ state retval: #baz.
+ anotherState retval: #baz.
+
+ t1 destination: #foo.
+ t2 destination: #bar.
+
+ self assert: state notEquals: anotherState
+!
+
+testStateEquals2
+ state addTransition: t1.
+ anotherState addTransition: t2.
+
+ state retval: #baz.
+ anotherState retval: #baz.
+
+ t1 destination: #foo.
+ t2 destination: #foo.
+
+ self assert: state equals: anotherState.
+!
+
+testStateEquals3
+ state addTransition: t1.
+ anotherState addTransition: t2.
+
+ state retval: #bar.
+ anotherState retval: #baz.
+
+ t1 destination: #foo.
+ t2 destination: #foo.
+
+ self assert: state notEquals: anotherState
+!
+
+testStateEquals4
+ 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 notEquals: anotherState
+!
+
+testStateEquals5
+ 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
+!
+
+testStateEquals6
+ 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 notEquals: anotherState
+! !
+
--- a/compiler/tests/PEGFsaScannerIntegrationTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/PEGFsaScannerIntegrationTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -3,7 +3,7 @@
"{ NameSpace: Smalltalk }"
TestCase subclass:#PEGFsaScannerIntegrationTest
- instanceVariableNames:'fsa fsaGenerator parser scanner result compiled'
+ instanceVariableNames:'fsa fsaGenerator parser scanner result compiled parser1 parser2'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Tests-Scanner'
@@ -11,66 +11,6 @@
!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.
@@ -85,6 +25,39 @@
self failScan: 'aaa'.
self failScan: 'aaaa'.
self failScan: 'aaaaa'.
+! !
+
+!PEGFsaScannerIntegrationTest methodsFor:'distinct'!
+
+testAAAnot_Aplus
+ parser := 'aaa' asParser not, $a asParser plus.
+ self compile.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+ self assert: fsa hasDistinctRetvals.
+
+ self scan: 'a' token: #token.
+ self scan: 'aa' token: #token.
+
+ self failScan: ''.
+ self failScan: 'aaa'.
+ self failScan: 'aaaa'.
+ self failScan: 'aaaaa'.
+!
+
+testAAAstar_AA
+ parser := 'aaa' asParser star, 'aa' asParser.
+
+ self scan: 'aa' token: #token.
+ self scan: 'aaaaa' token: #token.
+ self scan: 'aaaaaaaa' token: #token.
+
+
+ self failScan: 'a'.
+ self failScan: 'aaa'.
+ self failScan: 'aaaa'.
+ self failScan: 'aaaaaaa'.
!
testAAplus_A
@@ -150,6 +123,35 @@
self scan: 'aba' token: #token position: 2.
!
+testAXorAXXstar_X
+ parser := ('ax' asParser / 'axx' asParser) plus, 'x' asParser.
+
+ self compile.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self failScan: 'x'.
+ self failScan: ''.
+
+ self scan: 'axx' token: #token position: 3.
+!
+
+testAXorA_X
+ parser := ('ax' asParser / 'a' asParser), $x asParser.
+ self compile.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self scan: 'axx' token: #token.
+
+ self failScan: 'ax'.
+ self failScan: 'ab'.
+ self failScan: 'x'.
+ self failScan: ''.
+!
+
testA_BCorCD_D
parser := $a asParser, ('bc' asParser / 'cd' asParser), $d asParser.
@@ -194,7 +196,8 @@
self assert: fsa isDeterministic.
self assert: fsa isWithoutEpsilons.
-
+ self assert: fsa hasDistinctRetvals.
+
self failScan: 'ab'.
self failScan: 'bb'.
@@ -273,7 +276,6 @@
testAorAX_X
parser := ('a' asParser / 'ax' asParser), $x asParser.
-
self compile.
self assert: fsa isDeterministic.
@@ -302,6 +304,20 @@
self scan: 'bb' token: #token position: 1.
!
+testAorEOF
+ parser := $a asParser / #eof asParser.
+
+ self compile.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self scan: 'a' token: #token position: 1.
+ self scan: '' token: #token position: 0.
+
+ self failScan: 'b'.
+!
+
testAplus_B
parser := $a asParser plus, $b asParser.
@@ -339,14 +355,18 @@
self assert: fsa isDeterministic.
self assert: fsa isWithoutEpsilons.
-
+ self assert: fsa hasDistinctRetvals.
+
+ self failScan: 'b'.
+ self failScan: 'ab'.
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.
+ self scan: '' token: #token.
+ self scan: 'a' token: #token.
+ self scan: 'aaa' token: #token.
+ self scan: 'c' token: #token position: 0.
+ self scan: 'ac' token: #token position: 1.
+ self scan: 'aaac' token: #token position: 3.
!
testFoo
@@ -374,10 +394,26 @@
self scan: '2312' token: #token position: 4.
!
+testRecursive
+ parser := PPDelegateParser new.
+
+ parser setParser: ($a asParser, parser) / $b asParser.
+
+ self compile.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self failScan: 'c'.
+
+ self scan: 'b' token: #token.
+ self scan: 'ab' token: #token.
+ self scan: 'aaaaab' token: #token.
+!
+
testSmalltalkIdentifier
parser := #letter asParser, #word asParser star, $: asParser not.
self compile.
-
self assert: fsa isDeterministic.
self assert: fsa isWithoutEpsilons.
@@ -390,3 +426,264 @@
self failScan: '123'.
! !
+!PEGFsaScannerIntegrationTest methodsFor:'multivalues'!
+
+testA
+ parser1 := 'a' asParser.
+ parser2 := 'a' asParser.
+
+ self compileMerge.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+ self assert: fsa hasDistinctRetvals not.
+
+ self failScan: ''.
+ self failScan: 'b'.
+
+ self scan: 'a' token: #token1 position: 1.
+ self scan: 'a' token: #token2 position: 1.
+ self scan: 'aaa' token: #token1 position: 1.
+ self scan: 'aaa' token: #token2 position: 1.
+!
+
+testAplus_BOrAplus_Bnot
+ parser1 := $a asParser plus, $b asParser.
+ parser2 := $a asParser plus, $b asParser not.
+
+ self compileMerge.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self failScan: 'aaa' token: #token1.
+ self scan: 'aaa' token: #token2 position: 3.
+
+ self scan: 'aaab' token: #token1 position: 4.
+ self failScan: 'aaab' token: #token2.
+!
+
+testAuorAplus
+ parser1 := 'a' asParser.
+ parser2 := 'a' asParser plus.
+
+ self compileMerge.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+ self assert: fsa hasDistinctRetvals not.
+
+ self failScan: 'b' token: #token1.
+ self failScan: 'b' token: #token2.
+
+ self failScan: '' token: #token1.
+ self failScan: '' token: #token2.
+
+ self scan: 'a' token: #token1 position: 1.
+ self scan: 'a' token: #token2 position: 1.
+
+ self scan: 'aaa' token: #token1 position: 1.
+ self scan: 'aaa' token: #token2 position: 3.
+!
+
+testKeywordOrUnary
+ parser1 := #letter asParser plus, $: asParser.
+ parser2 := #letter asParser plus, $: asParser not.
+
+ self compileMerge.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self failScan: 'false' token: #token1.
+ self scan: 'false' token: #token2 position: 5.
+
+ self scan: 'false:' token: #token1 position: 6.
+ self failScan: 'false:' token: #token2.
+!
+
+testTrueOrId
+ parser1 := 'true' asParser.
+ parser2 := #letter asParser plus.
+
+ self compileMerge.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+ self assert: fsa hasDistinctRetvals not.
+
+ self failScan: 'false' token: #token1.
+ self scan: 'false' token: #token2 position: 5.
+
+ self scan: 'true' token: #token1 position: 4.
+ self scan: 'true' token: #token2 position: 4.
+
+ self scan: 'truecrypt' token: #token1 position: 4.
+ self scan: 'truecrypt' token: #token2 position: 9.
+
+! !
+
+!PEGFsaScannerIntegrationTest methodsFor:'smalltalk'!
+
+testStIdentifier
+ parser := (PPPredicateObjectParser
+ on: [ :each | each isLetter or: [ each = $_ ] ]
+ message: 'letter expected') ,
+ (PPPredicateObjectParser
+ on: [ :each | each isAlphaNumeric or: [ each = $_ ] ]
+ message: 'letter or digit expected') star.
+
+ self compile.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self failScan: ''.
+ self failScan: '23ab'.
+
+ self scan: 'fooBar' token: #token.
+ self scan: 'foo_bar' token: #token.
+!
+
+testStKeyword
+ | identifier |
+ identifier := (PPPredicateObjectParser
+ on: [ :each | each isLetter or: [ each = $_ ] ]
+ message: 'letter expected') ,
+ (PPPredicateObjectParser
+ on: [ :each | each isAlphaNumeric or: [ each = $_ ] ]
+ message: 'letter or digit expected') star.
+ parser := identifier, $: asParser.
+
+ self compile.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self failScan: 'fooBar'.
+
+
+ self scan: 'fooBar:' token: #token.
+ self scan: 'foo_bar:' token: #token.
+!
+
+testStString
+ parser := $' asParser , ('''''' asParser / $' asParser negate) star , $' asParser.
+
+ self compile.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self failScan: ''.
+ self failScan: 'b'.
+
+ self scan: '''hi there''' token: #token.
+! !
+
+!PEGFsaScannerIntegrationTest methodsFor:'support'!
+
+compile
+ | ppcTree |
+ compiled ifTrue: [ ^ self ].
+
+ ppcTree := parser asCompilerTree.
+ fsa := ppcTree asFsa.
+ fsa retval: #token.
+ fsa determinize.
+
+ self generate
+!
+
+compileMerge
+ | ppcTree1 ppcTree2 fsa1 fsa2 |
+ compiled ifTrue: [ ^ self ].
+
+ ppcTree1 := parser1 asCompilerTree.
+ ppcTree2 := parser2 asCompilerTree.
+
+ fsa1 := ppcTree1 asFsa.
+ fsa1 retval: #token1.
+ fsa2 := ppcTree2 asFsa.
+ fsa2 retval: #token2.
+
+ fsa := self mergeFsa: fsa1 and: fsa2.
+
+ self generate.
+!
+
+failScan: stream
+ self compile.
+
+ scanner initialize.
+ scanner stream: stream asPetitStream.
+ scanner nextToken.
+
+ result := scanner polyResult.
+
+
+ self assert: result isEmpty
+!
+
+failScan: stream token: token
+ self compile.
+
+ scanner initialize.
+ scanner stream: stream asPetitStream.
+ scanner nextToken.
+
+ result := scanner polyResult.
+
+
+ self assert: ((result includesKey: token) not)
+!
+
+generate
+ fsa name: #nextToken.
+
+ scanner := ((PPCScannerCodeGenerator new)
+ generateAndCompile: fsa).
+
+ compiled := true
+!
+
+mergeFsa: fsa1 and: fsa2
+ | startState |
+ fsa := PEGFsa new.
+ startState := PEGFsaState new.
+
+ fsa addState: startState.
+ fsa startState: startState.
+
+ fsa adopt: fsa1.
+ fsa addTransitionFrom: startState to: fsa1 startState.
+
+ fsa adopt: fsa2.
+ fsa addTransitionFrom: startState to: fsa2 startState.
+
+ fsa determinizeStandard.
+ ^ fsa
+!
+
+scan: stream token: token
+ self scan: stream token: token position: stream size.
+!
+
+scan: stream token: token position: position
+ self compile.
+
+ scanner stream: stream asPetitStream.
+ scanner nextToken.
+
+ result := scanner polyResult.
+
+ 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.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PEGFsaSequenceDeterminizationTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,511 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PEGFsaSequenceDeterminizationTest
+ instanceVariableNames:'fsa a b c result d interpreter e t1 t2 state anotherState parser
+ generator'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-FSA'
+!
+
+!PEGFsaSequenceDeterminizationTest 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.
+
+ result := interpreter interpret: anFsa on: stream.
+
+ self assert: result size = 1.
+ self assert: ((result anyOne) = end) description: 'wrong position'.
+
+ ^ result anyOne
+!
+
+determinizator
+ ^ PEGFsaSequenceDeterminizator new
+!
+
+determinize: anFsa
+ ^ self determinizator determinize: anFsa
+!
+
+fsaFrom: aNode
+ ^ (aNode accept: generator)
+ yourself
+!
+
+joinState: s1 with: s2
+ ^ self determinizator joinState: s1 with: s2
+!
+
+setUp
+ a := PEGFsaState new name: #a; retval: #token; yourself.
+ b := PEGFsaState new name: #b; retval: #token; yourself.
+ c := PEGFsaState new name: #c; retval: #token; yourself.
+ d := PEGFsaState new name: #d; retval: #token; yourself.
+ e := PEGFsaState new name: #e; retval: #token; yourself.
+
+ state := PEGFsaState new name: #state; retval: #token; yourself.
+ anotherState := PEGFsaState new name: #anotherState; retval: #token; yourself.
+
+ t1 := PEGFsaCharacterTransition new.
+ t2 := PEGFsaCharacterTransition new.
+
+ fsa := PEGFsa new.
+ generator := PEGFsaGenerator new.
+
+ interpreter := PEGFsaInterpret new
+ yourself.
+! !
+
+!PEGFsaSequenceDeterminizationTest methodsFor:'tests'!
+
+testAAplusA
+ parser := 'aa' asParser plus, 'a' asParser.
+ fsa := self fsaFrom: parser asCompilerTree.
+
+ self determinize: fsa.
+
+ 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'.
+ self assert: fsa parse: 'aaaaa'.
+ self assert: fsa parse: 'aaaaaaa'.
+!
+
+testAB
+ parser := $a asParser, $b asParser.
+ fsa := self fsaFrom: parser asCompilerTree.
+
+ self determinize: fsa.
+
+ self assert: fsa states size = 3.
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+ self assert: fsa startState destination isFinal not.
+
+ self assert: fsa parse: 'ab'.
+ self assert: fsa parse: 'abc' end: 2.
+
+ self assert: fsa fail: 'ac'.
+!
+
+testAPlusA
+ parser := $a asParser plus, $a asParser.
+ fsa := self fsaFrom: parser asCompilerTree.
+
+ self determinize: fsa.
+
+" 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
+ parser := $a asParser plus, $b asParser.
+ fsa := self fsaFrom: parser asCompilerTree.
+
+ self determinize: fsa.
+
+
+ self assert: fsa states size = 3.
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self assert: fsa parse: 'ab'.
+ self assert: fsa parse: 'aaaab'.
+ self assert: fsa parse: 'aaaabc' end: 5.
+
+ self assert: fsa fail: 'b'.
+!
+
+testApriorityOrA
+ parser := $a asParser / $a asParser.
+ fsa := self fsaFrom: parser asCompilerTree.
+
+ self determinize: fsa.
+
+ self assert: fsa states size = 2.
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+ self assert: fsa finalStates size = 1.
+ self assert: fsa finalStates anyOne isMultivalue not.
+
+ self assert: fsa parse: 'a'.
+ self assert: fsa fail: 'b'.
+!
+
+testDeterminizeFsa
+ 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 determinize: fsa.
+
+ self assert: fsa states size = 2.
+ self assert: a transitions size = 1.
+!
+
+testDeterminizeFsa2
+ | |
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+
+ fsa startState: a.
+ fsa finalState: b.
+ fsa finalState: c.
+ fsa finalState: d.
+
+ a priority: 0.
+ b priority: 0.
+ c priority: 0.
+ d priority: 0.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: b to: c on: $a.
+ fsa addTransitionFrom: c to: d on: $a.
+
+ fsa addTransitionFrom: b to: a on: $a.
+ fsa addTransitionFrom: c to: a on: $a.
+ fsa addTransitionFrom: d to: a on: $a.
+
+ self determinize: fsa.
+ self assert: fsa isDeterministic.
+!
+
+testDeterminizeFsa3
+ | 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.
+
+ self determinize: fsa.
+
+ 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 ]]).
+!
+
+testDeterminizeFsa4
+ | 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.
+
+ b priority: -1.
+ a priority: 0.
+
+ self determinize: fsa.
+ merged := a 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 ]]).
+!
+
+testDeterminizeFsa5
+ | 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.
+ fsa addTransitionFrom: c to: d on: $a.
+ b priority: 0.
+ d priority: -1.
+
+ self determinize: fsa.
+
+ merged := b 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 ]).
+!
+
+testDeterminizeFsa6
+ | merged |
+ 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 priority: -1.
+
+ self determinize: fsa.
+ self assert: fsa isDeterministic.
+ self assert: fsa states size = 2.
+
+ self assert: a transitions size = 1.
+ self assert: a isFinal not.
+
+ merged := a destination.
+ self assert: merged isFinal.
+ self assert: merged priority = 0.
+!
+
+testDeterminizeFsa7
+ | merged |
+ 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 priority: -1.
+
+ b priority: 0.
+ c priority: -1.
+
+ self determinize: fsa.
+ self assert: fsa isDeterministic.
+ self assert: fsa states size = 2.
+
+ self assert: a transitions size = 1.
+ self assert: a isFinal not.
+
+ merged := a destination.
+ self assert: merged isFinal.
+ self assert: merged priority = 0.
+!
+
+testDeterminizeFsa8
+ | |
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+
+ fsa startState: a.
+ fsa finalState: b.
+ fsa finalState: c.
+
+ a priority: 0.
+ b priority: 0.
+ c priority: 0.
+
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: a to: c on: $a.
+
+ fsa addTransitionFrom: b to: a on: $a.
+ fsa addTransitionFrom: b to: c on: $a.
+
+ fsa addTransitionFrom: c to: a on: $a.
+ fsa addTransitionFrom: c to: b on: $a.
+
+
+ self determinize: fsa.
+ self assert: fsa isDeterministic.
+!
+
+testDeterminizeFsa9
+ | |
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+
+ fsa startState: a.
+ fsa finalState: b.
+ fsa finalState: c.
+ fsa finalState: d.
+
+ a priority: 0.
+ b priority: 0.
+ c priority: 0.
+ d priority: 0.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: b to: c on: $a.
+ fsa addTransitionFrom: c to: d on: $a.
+
+ fsa addTransitionFrom: b to: a on: $a.
+ fsa addTransitionFrom: c to: a on: $a.
+ fsa addTransitionFrom: d to: a on: $a.
+
+ self determinize: fsa.
+ self assert: fsa isDeterministic.
+! !
+
+!PEGFsaSequenceDeterminizationTest methodsFor:'tests - joining'!
+
+testJoinState
+ | newState |
+ state addTransition: t1.
+ anotherState addTransition: t2.
+ state final: true.
+
+ t1 destination: (PEGFsaState named: #t1).
+ t2 destination: (PEGFsaState named: #t2).
+
+ newState := self joinState: state with: anotherState.
+
+ self assert: (newState transitions contains: [ :t | t = t1 ]).
+ self assert: (newState transitions contains: [ :t | t = t2 ]).
+ self assert: (newState isFinal).
+!
+
+testJoinState2
+ | newState |
+ state addTransition: t1.
+ anotherState addTransition: t2.
+ state final: true.
+
+ t1 destination: (PEGFsaState named: #t1).
+ t2 destination: (PEGFsaState named: #t2).
+
+ newState := self joinState: anotherState with: state.
+
+ self assert: (newState transitions contains: [ :t | t = t1 ]).
+ self assert: (newState transitions contains: [ :t | t = t2 ]).
+ self assert: (newState isFinal).
+!
+
+testJoinState3
+ | newState |
+ state final: true.
+ state retval: #foo.
+ state priority: -1.
+
+ anotherState final: true.
+ anotherState retval: #foo.
+ anotherState failure: true.
+ anotherState priority: 0.
+
+ newState := self joinState: anotherState with: state.
+
+ self assert: (newState isMultivalue not).
+ self assert: (newState retval value = #foo).
+ self assert: (newState isFinal).
+ self assert: (newState priority = 0).
+ self assert: (newState isFsaFailure).
+!
+
+testJoinState5
+ | newState |
+ state final: true.
+ state retval: #foo.
+ state priority: 0.
+
+ anotherState final: true.
+ anotherState retval: #foo.
+ anotherState priority: -1.
+
+
+ newState := self joinState: anotherState with: state.
+
+ self assert: (newState retval = #foo).
+ self assert: (newState isFinal).
+ self assert: (newState priority = 0).
+!
+
+testJoinState6
+ | newState |
+ state final: true.
+ state priority: 0.
+
+ anotherState final: true.
+ anotherState priority: -1.
+ anotherState failure: true.
+
+
+ newState := self joinState: anotherState with: state.
+
+ self assert: (newState isMultivalue not).
+ self assert: (newState isFinal).
+ self assert: (newState priority = 0).
+ self assert: (newState isFsaFailure not).
+!
+
+testJoinState7
+ | newState |
+ state final: true.
+ state retval: #foo.
+ state priority: -1.
+
+ anotherState final: true.
+ anotherState retval: #foo.
+ anotherState failure: true.
+ anotherState priority: 0.
+
+ newState := self joinState: anotherState with: state.
+
+ self assert: (newState isMultivalue not).
+ self assert: (newState retval value = #foo).
+ self assert: (newState isFinal).
+ self assert: (newState priority = 0).
+ self assert: (newState isFsaFailure).
+! !
+
--- a/compiler/tests/PEGFsaStateTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/PEGFsaStateTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -15,10 +15,10 @@
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.
+ t1 := PEGFsaCharacterTransition new.
+ t2 := PEGFsaCharacterTransition new.
+ t3 := PEGFsaCharacterTransition new.
+ t4 := PEGFsaCharacterTransition new.
!
@@ -73,127 +73,43 @@
!
-testEquals
- state addTransition: t1.
- anotherState addTransition: t2.
-
- state retval: #baz.
- anotherState retval: #baz.
+testCopy4
+ anotherState := state copy.
- 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.
+ self assert: (state = anotherState).
+ self assert: (state == anotherState) not.
- t1 destination: #foo.
- t2 destination: #foo.
-
- self assert: (state equals: anotherState).
-!
+ state priority: -1.
+ self assert: (state = anotherState) not.
-testEquals3
- state addTransition: t1.
- anotherState addTransition: t2.
-
- state retval: #bar.
- anotherState retval: #baz.
+ anotherState priority: -1.
+ self assert: (state = anotherState).
- t1 destination: #foo.
- t2 destination: #foo.
-
- self assert: (state equals: anotherState) not
-!
+ anotherState final: true.
+ self assert: (state = anotherState) not.
-testEquals4
- state addTransition: t1.
- anotherState addTransition: t2.
-
- state retval: #bar.
- anotherState retval: #bar.
+ state final: true.
+ self assert: (state = anotherState).
- 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.
+testCopy5
- 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
-!
+ state retval: #foo.
+ state failure: true.
+ state final: true.
+ anotherState := state copy.
-testJoin
- | newState |
- state addTransition: t1.
- anotherState addTransition: t2.
- state final: true.
-
- t1 destination: #t1.
- t2 destination: #t2.
-
- newState := state join: anotherState.
+ self assert: (state = anotherState).
+ self assert: (state == anotherState) not.
+
+ anotherState retval: #bar.
+ self assert: state retval == #foo.
+ self assert: state isFsaFailure.
+ self assert: anotherState retval == #bar.
+ self assert: anotherState isFsaFailure.
- 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
--- a/compiler/tests/PEGFsaTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/PEGFsaTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -20,15 +20,237 @@
!
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.
+ a := PEGFsaState new name: #a; retval: #token; yourself.
+ b := PEGFsaState new name: #b; retval: #token; yourself.
+ c := PEGFsaState new name: #c; retval: #token; yourself.
+ d := PEGFsaState new name: #d; retval: #token; yourself.
+ e := PEGFsaState new name: #e; retval: #token; yourself.
fsa := PEGFsa new.
!
+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.
+!
+
+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.
+
+ 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.
+!
+
+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: c.
+ fsa addTransitionFrom: c to: d on: $b.
+ d priority: -1.
+
+ fsa removeEpsilons.
+
+ self assert: fsa isWithoutEpsilons.
+
+ self assert: a transitions size = 1.
+ self assert: b transitions size = 1.
+ self assert: a destination destination = d.
+ self assert: d priority = -1.
+!
+
+testRemoveEpsilons7
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: a.
+ fsa finalState: b.
+ fsa finalState: c.
+
+ fsa addTransitionFrom: a to: b.
+ fsa addTransitionFrom: b to: c on: $a.
+
+
+ a priority: -1.
+ b priority: -1.
+ c priority: -1.
+
+ a failure: true.
+ b retval: #b.
+
+ fsa removeEpsilons.
+
+ self assert: fsa isWithoutEpsilons.
+
+ self assert: a transitions size = 1.
+ self assert: a destination = c.
+ self assert: a isFinal.
+ self assert: a isFsaFailure not.
+ self assert: a retval = #b.
+ self assert: a priority = -1.
+ self assert: c priority = -1.
+
+!
+
+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: 0.
+ 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.
+! !
+
+!PEGFsaTest methodsFor:'tests - analysis'!
+
testBackTransitions
fsa addState: a.
fsa addState: b.
@@ -115,137 +337,28 @@
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 |
+testHasDistinctRetvals
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.
+ fsa finalState: d.
-
- self assert: a transitions size = 1.
- self assert: a isFinal not.
+ a retval: nil.
+ b retval: #b.
+ c retval: nil.
+ d retval: #c.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: a to: c on: $b.
+ fsa addTransitionFrom: c to: d on: $d.
+ fsa addTransitionFrom: d to: c on: $c.
- merged := a transitions anyOne destination.
- self assert: merged transitions size = 1.
- self assert: merged isFinal.
+ self assert: fsa hasDistinctRetvals.
+
!
testIsDeterministic
@@ -287,283 +400,6 @@
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.
@@ -594,7 +430,7 @@
fsa addTransitionFrom: a to: b on: $a.
fsa addTransitionFrom: b to: c on: $b priority: -1.
- fsa addTransitionFrom: c to: a priority: -2.
+ fsa addTransitionFrom: c to: a.
newFsa := fsa copy.
@@ -611,6 +447,6 @@
newC := newA destination destination.
self assert: (newC == c) not.
self assert: newC isFinal.
- self assert: newC retval = #c.
+ self assert: newC retval = #token.
! !
--- a/compiler/tests/PEGFsaTransitionTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/PEGFsaTransitionTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -3,7 +3,7 @@
"{ NameSpace: Smalltalk }"
TestCase subclass:#PEGFsaTransitionTest
- instanceVariableNames:'t1 t2 result'
+ instanceVariableNames:'t1 t2 result e1 e2'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Tests-FSA'
@@ -12,9 +12,14 @@
!PEGFsaTransitionTest methodsFor:'as yet unclassified'!
setUp
- t1 := PEGFsaTransition new.
- t2 := PEGFsaTransition new.
-!
+ t1 := PEGFsaCharacterTransition new.
+ t2 := PEGFsaCharacterTransition new.
+
+ e1 := PEGFsaEpsilonTransition new.
+ e2 := PEGFsaEpsilonTransition new.
+! !
+
+!PEGFsaTransitionTest methodsFor:'character'!
testCompare
t1 addCharacter: $a.
@@ -91,6 +96,12 @@
self assert: (result at: $c codePoint) not.
!
+testEpsilonIntersection
+ result := e1 intersection: e2.
+
+ self assert: (result isEpsilon)
+!
+
testIntersection
t1 addCharacter: $a.
t1 addCharacter: $b.
@@ -128,3 +139,37 @@
self assert: (result at: $d codePoint) not.
! !
+!PEGFsaTransitionTest methodsFor:'tests - epsilon'!
+
+testCompareEpsilon
+
+ self assert: e1 = e2.
+
+ e1 destination: #a.
+ e2 destination: #b.
+
+ self assert: (e1 = e2) not.
+
+!
+
+testCopyEpsilon
+
+ e2 := e1 copy.
+
+
+ self assert: e1 = e2.
+ self assert: (e1 == e2) not.
+
+ e2 destination: #foo.
+ self assert: (e1 = e2) not.
+
+ e1 destination: #foo.
+ self assert: (e1 = e2).
+
+ e1 priority: -1.
+ self assert: (e1 = e2) not.
+
+ e2 priority: -1.
+ self assert: (e1 = e2).
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCASTUtilitiesTests.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,117 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCASTUtilitiesTests
+ instanceVariableNames:''
+ classVariableNames:'SomeClassVariable'
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Support'
+!
+
+!PPCASTUtilitiesTests methodsFor:'methods under test'!
+
+methodSimple1
+ ^ 1
+
+ "Created: / 27-07-2015 / 13:27:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithArguments: arg1
+ (arg1 + 4) yourself isOdd ifTrue:[
+ ^ true
+ ].
+ ^ false not.
+
+ "Created: / 27-07-2015 / 13:35:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithClassReference
+ ^ PPCASTUtilities new
+
+ "Created: / 27-07-2015 / 13:28:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithClassVariableReference
+ ^ SomeClassVariable
+
+ "Created: / 27-07-2015 / 14:02:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithInstanceVariableReference
+ ^ testSelector
+
+ "Created: / 27-07-2015 / 13:29:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithSelfSend1
+ ^ self methodSimple1
+
+ "Created: / 27-07-2015 / 13:28:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithSelfSend2
+ ^ self methodWithSelfSend1
+
+ "Created: / 27-07-2015 / 13:34:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithSelfSend3
+ ^ self methodWithInstanceVariableReference
+
+ "Created: / 27-07-2015 / 14:01:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithSuperSend
+ ^ super yourself
+
+ "Created: / 27-07-2015 / 14:02:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithTemporaries
+ | tmp1 |
+
+ tmp1 := 3.
+ (tmp1 + 4) yourself isOdd ifTrue:[
+ | tmp2 |
+
+ tmp2 := tmp1 + 1.
+ ^ tmp1 + tmp2.
+ ].
+ ^ tmp1
+
+ "Created: / 27-07-2015 / 13:33:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCASTUtilitiesTests methodsFor:'tests'!
+
+test_checkNodeIsFunctional_1
+ self shouldnt: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodSimple1) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+ self shouldnt: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithSelfSend1) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+ self shouldnt: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithSelfSend2) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+ self shouldnt: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithClassReference) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+ self shouldnt: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithTemporaries) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+ self shouldnt: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithArguments:) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+
+ "Created: / 27-07-2015 / 14:00:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_checkNodeIsFunctional_2
+ self should: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithInstanceVariableReference) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+ self should: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithClassVariableReference) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+ self should: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithSelfSend3) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+ self should: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithSuperSend) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+
+ "Created: / 27-07-2015 / 14:00:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- a/compiler/tests/PPCCodeGeneratorTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/PPCCodeGeneratorTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -28,7 +28,7 @@
configuration arguments: arguments.
- compiler := PPCCompiler new.
+ compiler := PPCCodeGen new.
compiler arguments: arguments.
visitor := PPCCodeGenerator new.
@@ -142,6 +142,20 @@
"Created: / 16-06-2015 / 07:22:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+testActionNode7
+ node := ((#letter asParser , #letter asParser)
+ ==> [:nodes | self createStringFromCharacters: nodes ]) asCompilerTree.
+ node child markForInline.
+
+ self compileTree:node.
+
+ self assert:parser parse:'ab' to:'ab'.
+ self assert:parser parse:'cz' to:'cz'.
+ self assert:parser fail:''.
+
+ "Created: / 27-07-2015 / 15:48:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
testAnyNode
node := PPCForwardNode new
child: PPCAnyNode new;
@@ -460,7 +474,7 @@
self compileTree: node.
self assert: parser class methodDictionary size = 1.
- self assert: (parser class methodDictionary includesKey: #lit_0).
+ self assert: (parser class methodDictionary includesKey: #lit).
self assert: parser parse: 'foo' to: 'foo'.
self assert: parser parse: 'foobar' to: 'foo' end: 3.
self assert: parser fail: 'boo'.
@@ -1108,3 +1122,11 @@
self assert: parser parse: '' to: nil.
! !
+!PPCCodeGeneratorTest methodsFor:'utilities'!
+
+createStringFromCharacters: characters
+ ^ String withAll: characters
+
+ "Created: / 27-07-2015 / 15:47:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- a/compiler/tests/PPCCompilerTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/PPCCompilerTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -114,86 +114,6 @@
self assert: parser parse: ' ab'.
! !
-!PPCCompilerTest methodsFor:'tests - ids'!
-
-testId1
- node := PPCNode new
- name: 'foo'.
- compiler := PPCCompiler new.
-
- id := compiler idFor: node.
-
- self assert: compiler ids size = 1.
- self assert: id = 'foo'.
-!
-
-testId2
- node1 := PPCNode new
- name: 'foo'.
-
- node2 := PPCNode new
- name: 'foo'.
- compiler := PPCCompiler new.
-
- id1 := compiler idFor: node1.
- self assert: compiler ids size = 1.
- self assert: id1 = 'foo'.
-
- id2 := compiler idFor: node2.
- self assert: compiler ids size = 2.
- self assert: id2 = 'foo_1'.
-
- self assert: (id1 = id2) not.
-!
-
-testId3
- node1 := PPCNode new
- name: 'foo'.
-
- node2 := node1.
- compiler := PPCCompiler new.
-
- id1 := compiler idFor: node1.
- self assert: compiler ids size = 1.
- self assert: id1 = 'foo'.
-
- id2 := compiler idFor: node2.
- self assert: compiler ids size = 1.
- self assert: id2 = 'foo'.
-
- self assert: (id1 == id2).
-!
-
-testId4
- node1 := PPCNode new
- name: 'foo+='.
-
- node2 := PPCNode new
- name: 'foo+='.
- compiler := PPCCompiler new.
-
- id1 := compiler idFor: node1.
- self assert: compiler ids size = 1.
- self assert: id1 = 'foo'.
-
- id2 := compiler idFor: node2.
- self assert: compiler ids size = 2.
- self assert: id2 = 'foo_1'.
-
- self assert: (id1 = id2) not.
-!
-
-testId5
- node1 := PPCNode new
- name: 'foo_bar'.
-
- compiler := PPCCompiler new.
-
- id1 := compiler idFor: node1.
- self assert: compiler ids size = 1.
- self assert: id1 = 'foo_bar'.
-! !
-
!PPCCompilerTest class methodsFor:'documentation'!
version_HG
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCIdGeneratorTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,109 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPAbstractParserTest subclass:#PPCIdGeneratorTest
+ instanceVariableNames:'node id idGen node1 node2 codeGen id1 id2 compiler'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Core'
+!
+
+!PPCIdGeneratorTest methodsFor:'tests - ids'!
+
+testId1
+ node := PPCNode new
+ name: 'foo'.
+ idGen := PPCIdGenerator new.
+
+ id := idGen idFor: node.
+
+ self assert: idGen ids size = 1.
+ self assert: id = 'foo'.
+!
+
+testId2
+ node1 := PPCNode new
+ name: 'foo'.
+
+ node2 := PPCNode new
+ name: 'foo'.
+ codeGen := PPCCodeGen new.
+
+ id1 := codeGen idFor: node1.
+ self assert: codeGen ids size = 1.
+ self assert: id1 = 'foo'.
+
+ id2 := codeGen idFor: node2.
+ self assert: codeGen ids size = 2.
+ self assert: id2 = 'foo_2'.
+
+ self assert: (id1 = id2) not.
+!
+
+testId3
+ node1 := PPCNode new
+ name: 'foo'.
+
+ node2 := node1.
+ codeGen := PPCCodeGen new.
+
+ id1 := codeGen idFor: node1.
+ self assert: codeGen ids size = 1.
+ self assert: id1 = 'foo'.
+
+ id2 := codeGen idFor: node2.
+ self assert: codeGen ids size = 1.
+ self assert: id2 = 'foo'.
+
+ self assert: (id1 == id2).
+!
+
+testId4
+ node1 := PPCNode new
+ name: 'foo+='.
+
+ node2 := PPCNode new
+ name: 'foo+='.
+ codeGen := PPCCodeGen new.
+
+ id1 := codeGen idFor: node1.
+ self assert: codeGen ids size = 1.
+ self assert: id1 = 'foo'.
+
+ id2 := codeGen idFor: node2.
+ self assert: codeGen ids size = 2.
+ self assert: id2 = 'foo_2'.
+
+ self assert: (id1 = id2) not.
+!
+
+testId5
+ node1 := PPCNode new
+ name: 'foo_bar'.
+
+ codeGen := PPCCodeGen new.
+
+ id1 := codeGen idFor: node1.
+ self assert: codeGen ids size = 1.
+ self assert: id1 = 'foo_bar'.
+!
+
+testId6
+ node1 := PPCNode new
+ name: '$''nextToken'.
+
+ node2 := PPCNode new
+ name: '$"nextToken'.
+
+ codeGen := PPCCodeGen new.
+
+ id1 := codeGen idFor: node1.
+ self assert: codeGen ids size = 1.
+ self assert: id1 = 'nextToken'.
+
+ id2 := codeGen idFor: node2.
+ self assert: codeGen ids size = 2.
+ self assert: id2 = 'nextToken_2'.
+! !
+
--- a/compiler/tests/PPCLTokenizingOptimizationTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/PPCLTokenizingOptimizationTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -43,7 +43,7 @@
self assert: result type: PPCTokenizingParserNode.
self assert: result parser type: PPCTokenConsumeNode.
self assert: result parser child type: PPCTrimmingTokenNode.
- self assert: result parser child whitespace type: PPCTokenStarSeparatorNode.
+ self assert: result whitespace type: PPCTokenStarSeparatorNode.
!
testCompileTrimmingToken
@@ -53,10 +53,10 @@
self assert: result type: PPCTokenizingParserNode.
self assert: result parser type: PPCTokenConsumeNode.
self assert: result parser child type: PPCTrimmingTokenNode.
- self assert: result parser child whitespace type: PPCTokenStarSeparatorNode.
+ self assert: result whitespace type: PPCTokenStarSeparatorNode.
- self assert: result tokenizer children size = 2.
- self assert: (result tokenizer children anySatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ])
+ self assert: result tokens children size = 1.
+ self assert: (result tokens children anySatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ])
!
testCompileTrimmingToken2
@@ -70,11 +70,11 @@
self assert: result type: PPCTokenizingParserNode.
self assert: result parser type: PPCTokenConsumeNode.
self assert: result parser name = 'fooToken'.
- self assert: result parser child name = 'token_fooToken'.
+ self assert: result parser child name = 'fooToken'.
- self assert: result tokenizer children size = 2.
- self assert: (result tokenizer children anySatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]).
- self assert: (result tokenizer children anySatisfy: [ :e | e name = 'token_fooToken']).
+ self assert: result tokens children size = 1.
+ self assert: (result tokens children anySatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]).
+ self assert: (result tokens children anySatisfy: [ :e | e name = 'fooToken']).
! !
!PPCLTokenizingOptimizationTest class methodsFor:'documentation'!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCOverlappingTokensTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,192 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPAbstractParserTest subclass:#PPCOverlappingTokensTest
+ instanceVariableNames:'parser result context node arguments configuration fooToken
+ idToken keywordToken p unaryToken assignmentToken'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Core-Tokenizing'
+!
+
+!PPCOverlappingTokensTest methodsFor:'as yet unclassified'!
+
+assert: p parse: whatever
+ ^ result := super assert: p parse: whatever.
+!
+
+assert: p parse: whatever end: end
+ ^ result := super assert: p parse: whatever end: end
+!
+
+cleanClass
+ | parserClass scannerClass |
+ parserClass := (Smalltalk at: arguments parserName ifAbsent: [nil]).
+ parserClass notNil ifTrue:[
+ parserClass removeFromSystem
+ ].
+
+ scannerClass := (Smalltalk at: arguments scannerName ifAbsent: [nil]).
+ scannerClass notNil ifTrue:[
+ scannerClass removeFromSystem
+ ].
+!
+
+compile: aPPParser
+ parser := aPPParser compileWithConfiguration: configuration
+!
+
+context
+ ^ context := PPCProfilingContext new
+!
+
+setUp
+ arguments := PPCArguments default
+ profile: true;
+ yourself.
+
+ configuration := PPCTokenizingConfiguration new
+ arguments: arguments;
+ yourself.
+
+ self cleanClass.
+
+ fooToken := 'foo' asParser token trim name: 'foo'; yourself.
+ idToken := (#word asParser plus) token trim name: 'id'; yourself.
+ unaryToken := (#word asParser plus, $: asParser not) token trim name: 'unary'; yourself.
+ keywordToken := (#word asParser plus, $: asParser) token trim name: 'kw'; yourself.
+ assignmentToken := (':=' asParser) token trim name: 'assignment'; yourself.
+!
+
+tearDown
+ "self cleanClass"
+!
+
+testOverlappingSmalltalkLike
+ p := (keywordToken, idToken) star, idToken, assignmentToken, idToken.
+ self compile: p.
+
+ self assert: parser parse: 'foo: bar
+ id := another'.
+ self assert: result first size = 1..
+ self assert: result second inputValue = 'id'.
+ self assert: result third inputValue = ':='.
+ self assert: result last inputValue = 'another'.
+!
+
+testOverlappingSmalltalkLike2
+ p := (keywordToken, idToken) star, idToken, assignmentToken, idToken.
+ self compile: p.
+
+ self assert: parser parse: 'foo: bar
+ id:=another'.
+ self assert: result first size = 1..
+ self assert: result second inputValue = 'id'.
+ self assert: result third inputValue = ':='.
+ self assert: result last inputValue = 'another'.
+
+ self assert: context tokenReadCount == 2 description: 'too many token reads?'.
+!
+
+testOverlappingToken
+ p := (unaryToken ==> [ :e | #unary ]) / (keywordToken ==> [:e | #kw ]).
+ self compile: p.
+
+ self assert: parser parse: 'foo:'.
+ self assert: result == #kw.
+
+ self assert: parser parse: 'foo '.
+ self assert: result == #unary.
+!
+
+testOverlappingToken2
+ p := (idToken ==> [ :e | #id ]) / (keywordToken ==> [:e | #kw ]).
+ self compile: p.
+
+ self assert: parser parse: 'foo:' end: 3.
+ self assert: result == #id.
+
+ self assert: parser parse: 'foo '.
+ self assert: result == #id.
+!
+
+testOverlappingToken3
+ p := (unaryToken ==> [ :e | #unary ]) / (keywordToken ==> [:e | #kw ]).
+ self compile: p.
+
+ self assert: parser parse: 'foo:'.
+ self assert: result == #kw.
+
+ self assert: parser parse: 'foo '.
+ self assert: result == #unary.
+!
+
+testOverlappingTokenStar
+ p := (fooToken ==> [ :e | #foo ]) / (idToken ==> [:e | #id ]).
+ self compile: p star.
+
+ self assert: parser parse: 'foo bar foo bar'.
+ self assert: result first = #foo.
+ self assert: result second = #id.
+ self assert: result third = #foo.
+ self assert: result last = #id.
+
+ self assert: context tokenReadCount == 1 description: 'too many token reads?'.
+!
+
+testOverlappingTokenStar2
+ p := (fooToken / idToken).
+ self compile: p star.
+
+ self assert: parser parse: ' foo bar foo bar'.
+ self assert: result first inputValue = 'foo'.
+ self assert: result second inputValue = 'bar'.
+ self assert: result third inputValue = 'foo'.
+ self assert: result last inputValue = 'bar'.
+
+ self assert: context tokenReadCount == 1 description: 'too many token reads?'.
+!
+
+testSanityAsignment
+ self compile: assignmentToken.
+ self assert: parser parse: ':='.
+ self assert: result inputValue = ':='.
+ self assert: parser fail: ':f'
+!
+
+testSanityFoo
+ self compile: fooToken.
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+ self assert: parser parse: 'foobar' end: 3.
+ self assert: result inputValue = 'foo'.
+ self assert: parser fail: 'bar'.
+!
+
+testSanityId
+ self compile: idToken.
+ self assert: parser parse: 'hi'.
+ self assert: result inputValue = 'hi'.
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+ self assert: parser parse: 'hi:' end: 2.
+ self assert: result inputValue = 'hi'.
+!
+
+testSanityKeyword
+ self compile: keywordToken .
+ self assert: parser parse: 'hi:'.
+ self assert: result inputValue = 'hi:'.
+ self assert: parser fail: 'hi'.
+!
+
+testSanityUnary
+ self compile: unaryToken.
+ self assert: parser parse: 'hi'.
+ self assert: result inputValue = 'hi'.
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+ self assert: parser fail: 'hi:'
+! !
+
--- a/compiler/tests/PPCScannerCodeGeneratorTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/PPCScannerCodeGeneratorTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -14,7 +14,9 @@
fail: stream rule: rule
scanner initialize.
scanner stream: stream asPetitStream.
- result := scanner perform: rule.
+ scanner perform: rule.
+
+ result := scanner polyResult.
self assert: result isEmpty
!
@@ -26,7 +28,8 @@
parse: stream token: token rule: rule position: position
scanner initialize.
scanner stream: stream asPetitStream.
- result := scanner perform: rule.
+ scanner perform: rule.
+ result := scanner polyResult.
self assert: (result at: token) = position.
!
@@ -41,8 +44,76 @@
fsa := PEGFsa new.
codeGenerator := PPCScannerCodeGenerator new.
+! !
+
+!PPCScannerCodeGeneratorTest methodsFor:'caching'!
+
+testDuplicities
+ 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.
+
+ codeGenerator generate: fsa.
+ codeGenerator generate: fsa copy.
+ scanner := codeGenerator compile.
+
+ self assert: scanner class methodDictionary size = 1.
+
+ 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.
!
+testDuplicities2
+ | copy |
+ 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.
+
+ b retval: nil.
+
+ copy := fsa copy.
+ copy name: #nextTokenFooBar.
+ copy retval: #FooBar.
+
+ fsa name: #nextTokenAstarB.
+ fsa retval: #AstarB.
+
+
+ codeGenerator generate: fsa.
+ codeGenerator generate: copy.
+ scanner := codeGenerator compile.
+
+ self assert: scanner class methodDictionary size = 2.
+
+ 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.
+
+ self parse: 'ab' token: #FooBar rule: #nextTokenFooBar.
+ self parse: 'b' token: #FooBar rule: #nextTokenFooBar.
+ self parse: 'aaab' token: #FooBar rule: #nextTokenFooBar.
+
+ self fail: 'c' rule: #nextTokenFooBar.
+! !
+
+!PPCScannerCodeGeneratorTest methodsFor:'tests'!
+
testA
fsa addState: a.
fsa addState: b.
@@ -54,7 +125,7 @@
fsa name: #nextTokenA.
b retval: #a.
- scanner := (codeGenerator generate: fsa).
+ scanner := (codeGenerator generateAndCompile: fsa).
self parse: 'aaa' token: #a rule: #nextTokenA position: 1.
self fail: 'b' rule: #nextTokenA.
@@ -66,17 +137,19 @@
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.
fsa addTransitionFrom: c to: b on: $a.
fsa name: #nextTokenAAstarA.
- b priority: -1.
- c priority: 0.
b retval: #AAstarA.
+ c retval: #AAstarA.
+ c final: true.
+ c failure: true.
- scanner := (codeGenerator generate: fsa).
+ scanner := (codeGenerator generateAndCompile: fsa).
self parse: 'a' token: #AAstarA rule: #nextTokenAAstarA.
self parse: 'aaa' token: #AAstarA rule: #nextTokenAAstarA.
@@ -100,7 +173,7 @@
fsa name: #nextTokenAB.
c retval: #ab.
- scanner := (codeGenerator generate: fsa).
+ scanner := (codeGenerator generateAndCompile: fsa).
self parse: 'ab' token: #ab rule: #nextTokenAB position: 2.
!
@@ -126,7 +199,7 @@
c retval: #ab.
e retval: #bc.
- scanner := (codeGenerator generate: fsa).
+ scanner := (codeGenerator generateAndCompile: fsa).
self parse: 'ab' token: #ab rule: #nextTokenABorBC position: 2.
self parse: 'abbc' token: #ab rule: #nextTokenABorBC position: 2.
@@ -149,7 +222,7 @@
fsa name: #nextTokenABstarA.
b retval: #ABstarA.
- scanner := (codeGenerator generate: fsa).
+ scanner := (codeGenerator generateAndCompile: fsa).
self parse: 'a' token: #ABstarA rule: #nextTokenABstarA position: 1.
self parse: 'aa' token: #ABstarA rule: #nextTokenABstarA position: 1.
@@ -162,6 +235,32 @@
self fail: '' rule: #nextTokenABstarA.
!
+testAStar
+ fsa addState: a.
+ fsa addState: b.
+
+ fsa startState: a.
+ fsa finalState: b.
+
+ fsa addTransitionFrom: a to: a on: $a.
+
+ fsa name: #nextTokenA.
+ a retval: #a.
+ a final: true.
+ a priority: 0.
+
+ scanner := (codeGenerator generateAndCompile: fsa).
+
+ self assert: scanner class methodDictionary size == 1.
+
+ self parse: '' token: #a rule: #nextTokenA.
+ self parse: 'a' token: #a rule: #nextTokenA.
+ self parse: 'aa' token: #a rule: #nextTokenA.
+ self parse: 'ab' token: #a rule: #nextTokenA position: 1.
+ self parse: 'aaa' token: #a rule: #nextTokenA.
+ self parse: 'b' token: #a rule: #nextTokenA position: 0.
+!
+
testA_Bstar_A
fsa addState: a.
fsa addState: b.
@@ -176,7 +275,7 @@
fsa name: #nextTokenA_Bstar_A.
c retval: #A_Bstar_A.
- scanner := (codeGenerator generate: fsa).
+ scanner := (codeGenerator generateAndCompile: fsa).
self parse: 'aa' token: #A_Bstar_A rule: #nextTokenA_Bstar_A.
self parse: 'aba' token: #A_Bstar_A rule: #nextTokenA_Bstar_A.
@@ -200,7 +299,7 @@
b retval: #a.
c retval: #b.
- scanner := (codeGenerator generate: fsa).
+ scanner := (codeGenerator generateAndCompile: fsa).
self parse: 'a' token: #a rule: #nextTokenAorB.
self parse: 'b' token: #b rule: #nextTokenAorB.
@@ -221,7 +320,7 @@
fsa name: #nextTokenAstarA.
b retval: #AstarA.
- self should: [codeGenerator generate: fsa ] raise: Exception.
+ self should: [codeGenerator generateAndCompile: fsa ] raise: Exception.
!
testAstarB
@@ -236,7 +335,7 @@
fsa name: #nextTokenAstarB.
b retval: #AstarB.
- scanner := (codeGenerator generate: fsa).
+ scanner := (codeGenerator generateAndCompile: fsa).
self parse: 'ab' token: #AstarB rule: #nextTokenAstarB.
self parse: 'b' token: #AstarB rule: #nextTokenAstarB.
--- a/compiler/tests/PPCTokenizingCodeGeneratorTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/PPCTokenizingCodeGeneratorTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -12,21 +12,35 @@
!PPCTokenizingCodeGeneratorTest methodsFor:'setup'!
+cleanClass
+ | parserClass scannerClass |
+ parserClass := (Smalltalk at: arguments parserName ifAbsent: [nil]).
+ parserClass notNil ifTrue:[
+ parserClass removeFromSystem
+ ].
+
+ scannerClass := (Smalltalk at: arguments scannerName ifAbsent: [nil]).
+ scannerClass notNil ifTrue:[
+ scannerClass removeFromSystem
+ ].
+!
+
compileTokenizer: aNode
tokenizer := visitor visit: aNode
!
compileTree: root
- | configuration |
+ | configuration |
configuration := PPCPluggableConfiguration on: [ :_self |
- result := (visitor visit: _self ir).
- compiler compileParser startSymbol: result methodName.
- parser := compiler compileParser new.
- _self ir: parser
+ _self cacheFirstFollow.
+ _self generateScanner.
+ _self generate.
+
].
configuration arguments: arguments.
+ configuration base: PPCConfiguration tokenizing.
parser := configuration compile: root.
!
@@ -43,8 +57,10 @@
arguments := PPCArguments default
profile: true;
yourself.
-
- compiler := PPCTokenizingCompiler new.
+
+ self cleanClass.
+
+ compiler := PPCTokenizingCodeGen new.
compiler arguments: arguments.
visitor := PPCTokenizingCodeGenerator new.
@@ -53,12 +69,7 @@
!
tearDown
- | class |
-
- class := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]).
- class notNil ifTrue:[
- class removeFromSystem
- ].
+ "nothing to do now"
! !
!PPCTokenizingCodeGeneratorTest methodsFor:'support'!
@@ -138,7 +149,7 @@
!PPCTokenizingCodeGeneratorTest methodsFor:'testing'!
testSimpleChoice1
- | token1 token2 token1Consume token2Consume tokenizerNode eof choiceNode wsNode |
+ | token1 token2 token1Consume token2Consume tokenNode eof choiceNode wsNode |
token1 := (self tokenNodeForLiteral: 'foo') yourself.
token2 := (self tokenNodeForLiteral: 'bar') yourself.
@@ -155,28 +166,33 @@
children: { token1Consume . token2Consume };
yourself.
- tokenizerNode := PPCTokenChoiceNode new
+ tokenNode := PPCListNode new
children: { token1 . token2 . eof };
name: 'nextToken';
yourself.
wsNode := PPCTokenStarSeparatorNode new
name: 'consumeWhitespace';
+ child: PPCNilNode new;
+ yourself.
+
+ node := PPCTokenizingParserNode new
+ tokens: tokenNode;
+ whitespace: wsNode;
+ parser: choiceNode;
yourself.
- self compileWs: wsNode.
- self compileTokenizer: tokenizerNode.
- self compileTree: choiceNode.
+ self compileTree: node.
- parser := compiler compiledParser new.
+ parser := parser class new.
self assert: parser parse: 'foo'.
self assert: result inputValue = 'foo'.
- parser := compiler compiledParser new.
+ parser := parser class new.
self assert: parser parse: 'bar'.
self assert: result inputValue = 'bar'.
- parser := compiler compiledParser new.
+ parser := parser class new.
self assert: parser fail: 'baz'.
!
@@ -185,7 +201,7 @@
tokenNode := (self tokenNodeForLiteral: 'bar') yourself.
eof := (self tokenNodeForEOF) yourself.
- tokenizerNode := PPCTokenChoiceNode new
+ tokenizerNode := PPCListNode new
children: { tokenNode . eof };
name: 'nextToken';
yourself.
@@ -199,23 +215,23 @@
node := PPCTokenizingParserNode new
parser: consumeNode;
- tokenizer: tokenizerNode;
+ tokens: tokenizerNode;
whitespace: wsNode;
yourself.
self compileTree: node.
- parser := compiler compiledParser new.
+ parser := parser class new.
self assert: parser parse: 'bar'.
self assert: result inputValue = 'bar'.
- parser := compiler compiledParser new.
+ parser := parser class new.
self assert: parser fail: 'foo'.
!
testTrimmingToken1
- | token tokenConsume tokenizerNode eof wsNode |
+ | token tokenConsume tokensNode eof wsNode |
token := self trimmingTokenNode: (self literalNode: 'foo').
eof := (self tokenNodeForEOF) yourself.
@@ -224,31 +240,37 @@
child: token;
yourself.
- tokenizerNode := PPCTokenChoiceNode new
+ tokensNode := PPCListNode new
children: { token . eof };
name: 'nextToken';
yourself.
wsNode := PPCTokenStarSeparatorNode new
name: 'consumeWhitespace';
+ child: PPCNilNode new;
+ yourself.
+
+ node := PPCTokenizingParserNode new
+ tokens: tokensNode;
+ whitespace: wsNode;
+ parser: tokenConsume;
yourself.
- self compileWs: wsNode.
- self compileTokenizer: tokenizerNode.
- self compileTree: tokenConsume.
+
+ self compileTree: node.
- parser := compiler compiledParser new.
+ parser := parser class new.
self assert: parser parse: ' foo'.
self assert: result inputValue = 'foo'.
- parser := compiler compiledParser new.
+ parser := parser class new.
self assert: parser parse: ' foo '.
self assert: result inputValue = 'foo'.
- parser := compiler compiledParser new.
+ parser := parser class new.
self assert: parser fail: 'baz'.
! !
--- a/compiler/tests/PPCTokenizingTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/PPCTokenizingTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -21,11 +21,15 @@
!
cleanClass
- | parserClass |
- parserClass := (Smalltalk at: arguments name ifAbsent: [nil]).
+ | parserClass scannerClass |
+ parserClass := (Smalltalk at: arguments parserName ifAbsent: [nil]).
parserClass notNil ifTrue:[
- self flag: 'uncomment'.
-" parserClass removeFromSystem"
+ parserClass removeFromSystem
+ ].
+
+ scannerClass := (Smalltalk at: arguments scannerName ifAbsent: [nil]).
+ scannerClass notNil ifTrue:[
+ scannerClass removeFromSystem
].
!
@@ -50,7 +54,34 @@
!
tearDown
- self cleanClass
+ "self cleanClass"
+!
+
+testChoice
+ | p1 p2 a1 a2 |
+ a1 := 'a' asParser token name: 't1'; yourself.
+ a2 := 'b' asParser token name: 't2'; yourself.
+
+ p1 := a1 star.
+ p2 := a2.
+
+ parser := p1 / p2 compileWithConfiguration: configuration.
+
+ self assert: parser parse: ''.
+ self assert: result isEmpty.
+
+ self assert: parser parse: 'a'.
+ self assert: result first inputValue = 'a'.
+
+ self assert: parser parse: 'aa'.
+ self assert: result first inputValue = 'a'.
+ self assert: result second inputValue = 'a'.
+
+ self assert: parser parse: 'b' end: 0.
+ self assert: result isEmpty.
+
+ self assert: parser parse: 'c' end: 0.
+
!
testChoiceOrder
@@ -203,6 +234,21 @@
!
+testCompileEmptytoken
+ | start stop epsilon |
+ start := $( asParser token.
+ stop := $) asParser token.
+ epsilon := '' asParser token.
+
+ self should: [
+ (start, epsilon, stop) compileWithConfiguration: configuration.
+ ] raise: Exception.
+"
+ self assert: parser parse: '()'.
+ self assert: parser fail: '('.
+"
+!
+
testCompileLiteral
parser := 'foo' asParser token compileWithConfiguration: configuration.
@@ -220,6 +266,39 @@
self assert: result second inputValue = 'bar'.
!
+testCompileSequence2
+ parser := ('foo' asParser trimmingToken), ('bar' asParser trimmingToken)
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foobar'.
+ self assert: result first inputValue = 'foo'.
+ self assert: result second inputValue = 'bar'.
+
+ self assert: parser parse: 'foo bar'.
+ self assert: result first inputValue = 'foo'.
+ self assert: result second inputValue = 'bar'.
+
+ self assert: parser parse: ' foo bar'.
+ self assert: result first inputValue = 'foo'.
+ self assert: result second inputValue = 'bar'.
+!
+
+testCompileSequence3
+ parser := ('foo' asParser trimmingToken),
+ ('bar' asParser trimmingToken),
+ ('baz' asParser trimmingToken)
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foobarbaz'.
+ self assert: result first inputValue = 'foo'.
+ self assert: result second inputValue = 'bar'.
+
+ self assert: parser parse: ' foo bar baz '.
+ self assert: result first inputValue = 'foo'.
+ self assert: result second inputValue = 'bar'.
+ self assert: result third inputValue = 'baz'.
+!
+
testCompileStar
parser := 'foo' asParser token star compileWithConfiguration: configuration.
@@ -234,7 +313,7 @@
parser := ('foo' asParser token, 'bar' asParser token) star compileWithConfiguration: configuration.
self assert: parser parse: 'foobar'.
- self assert: context tokenReads size = 3.
+ self assert: context tokenReads size = 1.
self assert: parser parse: 'bar' end: 0.
self assert: result isEmpty.
@@ -256,7 +335,6 @@
parser := argumentsWith compileWithConfiguration: configuration.
self assert: parser parse: '|'.
- parser := argumentsWith compileWithConfiguration: configuration.
self assert: parser parse: ']'.
!
@@ -283,16 +361,41 @@
parser := tricky compileWithConfiguration: configuration.
self assert: parser parse: '||'.
- parser := tricky compileWithConfiguration: configuration.
self assert: parser parse: '|]'.
- parser := tricky compileWithConfiguration: configuration.
self assert: parser parse: ']|'.
- parser := tricky compileWithConfiguration: configuration.
self assert: parser parse: ']]'.
!
+testCompileTokenComplex4
+ | symbol symbolLiteralArray symbolLiteral arrayItem arrayLiteral |
+ "based on symbolLiteral symbolLiteralArray in SmalltalkGrammar"
+
+ symbol := PPDelegateParser new.
+ symbol setParser: 'foo' asParser.
+ symbol name: 'symbol'.
+
+ symbolLiteralArray := PPDelegateParser new.
+ symbolLiteralArray setParser: symbol token.
+ symbolLiteralArray name: 'symbolLiteralArray'.
+
+ symbolLiteral := PPDelegateParser new.
+ symbolLiteral setParser: $# asParser token, symbol token ==> [:e | e].
+ symbolLiteral name: 'symbolLiteral'.
+
+ arrayLiteral := PPDelegateParser new.
+ arrayLiteral setParser: '#(' asParser token, symbolLiteralArray, ')' asParser token.
+ arrayLiteral name: 'arrayLiteral'.
+
+ arrayItem := arrayLiteral / symbolLiteral.
+
+ parser := arrayItem compileWithConfiguration: configuration.
+
+ self assert: parser parse: '#(foo)'.
+ self assert: parser parse: '#foo'.
+!
+
testCompileTrim
parser := 'foo' asParser token trim end compileWithConfiguration: configuration.
@@ -320,7 +423,10 @@
self assert: parser parse: 'a'.
self assert: result first inputValue = 'a'.
- self assert: context invocations size = 5.
+ self assert: context tokenReads size = 1.
+
+ self flag: 'add the assertion here?'.
+" self assert: context invocations size = 5."
!
testTokenCharacter2
@@ -333,7 +439,10 @@
self assert: result first inputValue = 'a'.
self assert: result second inputValue = 'a'.
self assert: result third inputValue = 'a'.
- self assert: context invocations size = 7.
+
+ self assert: context tokenReads size = 1.
+ self flag: 'Add the assertion here?'.
+" self assert: context invocations size = 7."
!
testTokenName
@@ -364,7 +473,7 @@
self assert: parser parse: ' foo '.
self assert: result first inputValue = 'foo'.
- self assert: (context invocations select: [:e | e = #consumeWhitespace ]) size = 2.
+ self assert: (context invocations select: [:e | e = #consumeWhitespace ]) size = 3.
!
testWhitespace2
@@ -384,6 +493,27 @@
self assert: result first inputValue = 'foo'.
self assert: result second inputValue = 'foo'.
- self assert: (context invocations select: [:e | e = #consumeWhitespace ]) size = 3.
+ self assert: (context invocations select: [:e | e = #consumeWhitespace ]) size = 4.
+!
+
+testWhitespace3
+ | token ws trimmingToken |
+ configuration arguments inline: false.
+
+ token := 'foo' asParser token.
+ ws := #blank asParser star name: 'consumeWhitespace'; yourself.
+ trimmingToken := ((ws, token, ws) ==> #second)
+ propertyAt: 'trimmingToken' put: true;
+ yourself.
+
+ parser := trimmingToken plus
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: ' foo foo foo '.
+ self assert: result first inputValue = 'foo'.
+ self assert: result second inputValue = 'foo'.
+ self assert: result third inputValue = 'foo'.
+
+ self assert: (context invocations select: [:e | e = #consumeWhitespace ]) size = 5.
! !
--- a/compiler/tests/PPCTokenizingVisitorTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/PPCTokenizingVisitorTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -21,7 +21,7 @@
testTokenNode1
| nilNode |
- nilNode := PPCNilNode new.
+ nilNode := PPCCharacterNode new.
node := PPCTokenNode new
child: nilNode.
result := visitor visit: node.
@@ -30,8 +30,8 @@
self assert: result parser type: PPCTokenConsumeNode.
self assert: result parser child = node.
- self assert: result tokenizer children size = 2.
- self assert: (result tokenizer children anySatisfy: [ :e | e = node ]).
+ self assert: result tokens children size = 1.
+ self assert: (result tokens children anySatisfy: [ :e | e = node ]).
!
testTokenizingParserNode
@@ -40,12 +40,12 @@
self assert: result type: PPCTokenizingParserNode.
self assert: result parser = node.
- self assert: result tokenizer children size = 1.
+ self assert: result tokens children size = 0.
!
testTokenizingParserNode2
| nilNode |
- nilNode := PPCNilNode new.
+ nilNode := PPCCharacterNode new.
node := PPCTokenNode new
child: nilNode.
result := visitor visit: node.
@@ -54,8 +54,8 @@
self assert: result parser type: PPCTokenConsumeNode.
self assert: result parser child = node.
- self assert: result tokenizer children size = 2.
- self assert: (result tokenizer children anySatisfy: [ :e | e = node ]).
+ self assert: result tokens children size = 1.
+ self assert: (result tokens children anySatisfy: [ :e | e = node ]).
!
testTrimmingTokenNode1
@@ -73,7 +73,7 @@
self assert: result parser type: PPCTokenConsumeNode.
self assert: result parser child = node.
- self assert: result tokenizer children size = 2.
- self assert: (result tokenizer children anySatisfy: [ :e | e = node ]).
+ self assert: result tokens children size = 1.
+ self assert: (result tokens children anySatisfy: [ :e | e = node ]).
! !
--- a/compiler/tests/PPCUniversalTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/PPCUniversalTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -29,10 +29,12 @@
tearDown
| parserClass |
- parserClass := (Smalltalk at: arguments name ifAbsent: [nil]).
+ parserClass := (Smalltalk at: arguments parserName ifAbsent: [nil]).
parserClass notNil ifTrue:[
parserClass removeFromSystem
].
+
+ "Modified: / 24-07-2015 / 19:21:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCUniversalTest methodsFor:'tests - compiling'!
--- a/compiler/tests/abbrev.stc Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/abbrev.stc Mon Aug 17 12:13:16 2015 +0100
@@ -2,13 +2,18 @@
# 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
+PEGFsaChoiceDeterminizationTest PEGFsaChoiceDeterminizationTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-FSA' 1
PEGFsaDeterminizationTest PEGFsaDeterminizationTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-FSA' 1
PEGFsaGeneratorTest PEGFsaGeneratorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-FSA' 1
+PEGFsaIntegrationTest PEGFsaIntegrationTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-FSA' 1
PEGFsaInterpretTest PEGFsaInterpretTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-FSA' 1
+PEGFsaMinimizationTest PEGFsaMinimizationTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-FSA' 1
PEGFsaScannerIntegrationTest PEGFsaScannerIntegrationTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Scanner' 1
+PEGFsaSequenceDeterminizationTest PEGFsaSequenceDeterminizationTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-FSA' 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
+PPCASTUtilitiesTests PPCASTUtilitiesTests stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Support' 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
@@ -16,6 +21,7 @@
PPCContextTest PPCContextTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Context' 1
PPCCopyVisitorTest PPCCopyVisitorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
PPCGuardTest PPCGuardTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Guards' 1
+PPCIdGeneratorTest PPCIdGeneratorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 1
PPCInliningVisitorTest PPCInliningVisitorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
PPCLL1VisitorTest PPCLL1VisitorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
PPCLTokenizingOptimizationTest PPCLTokenizingOptimizationTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core-Tokenizing' 1
@@ -24,6 +30,7 @@
PPCNodeFirstFollowNextTests PPCNodeFirstFollowNextTests stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Nodes' 2
PPCNodeTest PPCNodeTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Nodes' 1
PPCOptimizeChoicesTest PPCOptimizeChoicesTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
+PPCOverlappingTokensTest PPCOverlappingTokensTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core-Tokenizing' 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
--- a/compiler/tests/bc.mak Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/bc.mak Mon Aug 17 12:13:16 2015 +0100
@@ -75,13 +75,18 @@
# 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)PEGFsaChoiceDeterminizationTest.$(O) PEGFsaChoiceDeterminizationTest.$(H): PEGFsaChoiceDeterminizationTest.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)PEGFsaIntegrationTest.$(O) PEGFsaIntegrationTest.$(H): PEGFsaIntegrationTest.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)PEGFsaMinimizationTest.$(O) PEGFsaMinimizationTest.$(H): PEGFsaMinimizationTest.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)PEGFsaSequenceDeterminizationTest.$(O) PEGFsaSequenceDeterminizationTest.$(H): PEGFsaSequenceDeterminizationTest.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)PPCASTUtilitiesTests.$(O) PPCASTUtilitiesTests.$(H): PPCASTUtilitiesTests.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)
@@ -89,6 +94,7 @@
$(OUTDIR)PPCContextTest.$(O) PPCContextTest.$(H): PPCContextTest.st $(INCLUDE_TOP)\stx\goodies\petitparser\tests\PPContextTest.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCCopyVisitorTest.$(O) PPCCopyVisitorTest.$(H): PPCCopyVisitorTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCGuardTest.$(O) PPCGuardTest.$(H): PPCGuardTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCIdGeneratorTest.$(O) PPCIdGeneratorTest.$(H): PPCIdGeneratorTest.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)PPCInliningVisitorTest.$(O) PPCInliningVisitorTest.$(H): PPCInliningVisitorTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCLL1VisitorTest.$(O) PPCLL1VisitorTest.$(H): PPCLL1VisitorTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCLTokenizingOptimizationTest.$(O) PPCLTokenizingOptimizationTest.$(H): PPCLTokenizingOptimizationTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
@@ -97,6 +103,7 @@
$(OUTDIR)PPCNodeFirstFollowNextTests.$(O) PPCNodeFirstFollowNextTests.$(H): PPCNodeFirstFollowNextTests.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCNodeTest.$(O) PPCNodeTest.$(H): PPCNodeTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(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)PPCOverlappingTokensTest.$(O) PPCOverlappingTokensTest.$(H): PPCOverlappingTokensTest.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)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)
--- a/compiler/tests/extras/Make.proto Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/extras/Make.proto Mon Aug 17 12:13:16 2015 +0100
@@ -34,7 +34,7 @@
# add the path(es) here:,
# ********** OPTIONAL: MODIFY the next lines ***
# LOCALINCLUDES=-Ifoo -Ibar
-LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/compiler -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/java -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk -I$(INCLUDE_TOP)/stx/goodies/petitparser/tests -I$(INCLUDE_TOP)/stx/goodies/sunit -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2
+LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/compiler -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/java -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk/tests -I$(INCLUDE_TOP)/stx/goodies/petitparser/tests -I$(INCLUDE_TOP)/stx/goodies/sunit -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2
# if you need any additional defines for embedded C code,
@@ -109,6 +109,7 @@
cd ../../../../sunit && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
cd ../../../tests && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
cd ../../../parsers/java && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../../parsers/smalltalk/tests && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
@@ -128,9 +129,27 @@
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)PPCLRPNode.$(O) PPCLRPNode.$(H): PPCLRPNode.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPParser.$(O) PPCLRPParser.$(H): PPCLRPParser.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPCompositeParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPExpressionGrammar.$(O) PPExpressionGrammar.$(H): PPExpressionGrammar.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPCompositeParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPLL1ExpressionGrammar.$(O) PPLL1ExpressionGrammar.$(H): PPLL1ExpressionGrammar.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPCompositeParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)stx_goodies_petitparser_compiler_tests_extras.$(O) stx_goodies_petitparser_compiler_tests_extras.$(H): stx_goodies_petitparser_compiler_tests_extras.st $(INCLUDE_TOP)/stx/libbasic/LibraryDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProjectDefinition.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPAction.$(O) PPCLRPAction.$(H): PPCLRPAction.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPContainedElement.$(O) PPCLRPContainedElement.$(H): PPCLRPContainedElement.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPSpawn.$(O) PPCLRPSpawn.$(H): PPCLRPSpawn.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPComment.$(O) PPCLRPComment.$(H): PPCLRPComment.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPContainedElement.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPErrorNode.$(O) PPCLRPErrorNode.$(H): PPCLRPErrorNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPContainedElement.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPEvent.$(O) PPCLRPEvent.$(H): PPCLRPEvent.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPContainedElement.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPMachine.$(O) PPCLRPMachine.$(H): PPCLRPMachine.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPContainedElement.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPOnEntry.$(O) PPCLRPOnEntry.$(H): PPCLRPOnEntry.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPAction.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPOnExit.$(O) PPCLRPOnExit.$(H): PPCLRPOnExit.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPAction.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPRunning.$(O) PPCLRPRunning.$(H): PPCLRPRunning.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPAction.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPState.$(O) PPCLRPState.$(H): PPCLRPState.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPContainedElement.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPTransition.$(O) PPCLRPTransition.$(H): PPCLRPTransition.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPContainedElement.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPVariable.$(O) PPCLRPVariable.$(H): PPCLRPVariable.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPContainedElement.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPEpsilonTransition.$(O) PPCLRPEpsilonTransition.$(H): PPCLRPEpsilonTransition.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPContainedElement.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPTransition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPTimeoutTransition.$(O) PPCLRPTimeoutTransition.$(H): PPCLRPTimeoutTransition.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPContainedElement.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPTransition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPWildcardTransition.$(O) PPCLRPWildcardTransition.$(H): PPCLRPWildcardTransition.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPContainedElement.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/tests/extras/PPCLRPTransition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
# ENDMAKEDEPEND --- do not remove this line
--- a/compiler/tests/extras/Make.spec Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/extras/Make.spec Mon Aug 17 12:13:16 2015 +0100
@@ -51,17 +51,53 @@
STCWARNINGS=-warnNonStandard
COMMON_CLASSES= \
+ PPCLRPNode \
+ PPCLRPParser \
PPExpressionGrammar \
PPLL1ExpressionGrammar \
stx_goodies_petitparser_compiler_tests_extras \
+ PPCLRPAction \
+ PPCLRPContainedElement \
+ PPCLRPSpawn \
+ PPCLRPComment \
+ PPCLRPErrorNode \
+ PPCLRPEvent \
+ PPCLRPMachine \
+ PPCLRPOnEntry \
+ PPCLRPOnExit \
+ PPCLRPRunning \
+ PPCLRPState \
+ PPCLRPTransition \
+ PPCLRPVariable \
+ PPCLRPEpsilonTransition \
+ PPCLRPTimeoutTransition \
+ PPCLRPWildcardTransition \
COMMON_OBJS= \
+ $(OUTDIR_SLASH)PPCLRPNode.$(O) \
+ $(OUTDIR_SLASH)PPCLRPParser.$(O) \
$(OUTDIR_SLASH)PPExpressionGrammar.$(O) \
$(OUTDIR_SLASH)PPLL1ExpressionGrammar.$(O) \
$(OUTDIR_SLASH)stx_goodies_petitparser_compiler_tests_extras.$(O) \
+ $(OUTDIR_SLASH)PPCLRPAction.$(O) \
+ $(OUTDIR_SLASH)PPCLRPContainedElement.$(O) \
+ $(OUTDIR_SLASH)PPCLRPSpawn.$(O) \
+ $(OUTDIR_SLASH)PPCLRPComment.$(O) \
+ $(OUTDIR_SLASH)PPCLRPErrorNode.$(O) \
+ $(OUTDIR_SLASH)PPCLRPEvent.$(O) \
+ $(OUTDIR_SLASH)PPCLRPMachine.$(O) \
+ $(OUTDIR_SLASH)PPCLRPOnEntry.$(O) \
+ $(OUTDIR_SLASH)PPCLRPOnExit.$(O) \
+ $(OUTDIR_SLASH)PPCLRPRunning.$(O) \
+ $(OUTDIR_SLASH)PPCLRPState.$(O) \
+ $(OUTDIR_SLASH)PPCLRPTransition.$(O) \
+ $(OUTDIR_SLASH)PPCLRPVariable.$(O) \
+ $(OUTDIR_SLASH)PPCLRPEpsilonTransition.$(O) \
+ $(OUTDIR_SLASH)PPCLRPTimeoutTransition.$(O) \
+ $(OUTDIR_SLASH)PPCLRPWildcardTransition.$(O) \
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCAbstractParserTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,121 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPAbstractParserTest subclass:#PPCAbstractParserTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Support'
+!
+
+!PPCAbstractParserTest class methodsFor:'resources'!
+
+resources
+ ^ Array with: (PPCSetUpBeforeTearDownAfterResource for: self)
+! !
+
+!PPCAbstractParserTest class methodsFor:'testing'!
+
+isAbstract
+ ^ self == PPCAbstractParserTest
+
+ "Modified: / 30-07-2015 / 07:28:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCAbstractParserTest methodsFor:'accessing'!
+
+compiledParser
+ ^ self compiledParserClass new
+
+ "Created: / 29-07-2015 / 17:00:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compiledParserClass
+ ^ Smalltalk at: self compiledParserClassName
+
+ "Created: / 29-07-2015 / 16:54:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compiledParserClassName
+ "Return the name of the compiled parser"
+
+ ^ (self petitParserClass name , 'C_' ,
+ "This is bit hacky!!"
+ ((self compilerConfiguration isKindOf: PPCTokenizingConfiguration) ifTrue:[ 'Tokenizing' ] ifFalse:[ 'Universal' ])) asSymbol
+
+ "Created: / 29-07-2015 / 16:54:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compiledScannerClassName
+ "Return the name of the compiled parser"
+
+ ^ (self petitParserClass name , 'C_Scanner') asSymbol
+ "Created: / 29-07-2015 / 16:54:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compilerConfiguration
+ "Return configuration to use when compiling parser (as instance of PPCConfiguration)"
+
+ ^ self subclassResponsibility
+
+ "Created: / 29-07-2015 / 16:53:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parserClass
+ ^ self compiledParserClass
+
+ "Modified: / 29-07-2015 / 18:43:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parserInstanceFor: aSymbol
+ ^ self parserClass new startSymbol: aSymbol
+
+ "Modified: / 29-07-2015 / 18:43:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+petitParser
+ ^ self petitParserClass new
+
+ "Created: / 29-07-2015 / 17:01:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+petitParserClass
+ "Return the name of the petit parser to compile"
+
+ ^ self subclassResponsibility
+
+ "Created: / 29-07-2015 / 17:01:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCAbstractParserTest methodsFor:'context'!
+
+context
+
+ ^ PPCContext new
+! !
+
+!PPCAbstractParserTest methodsFor:'setup & teardown'!
+
+setUpBefore
+ "Called before any of my tests is run (when resources are set up)"
+ | time configuration |
+
+ configuration := self compilerConfiguration.
+ configuration arguments parserName: self compiledParserClassName.
+ configuration arguments scannerName: self compiledScannerClassName.
+ time := Time millisecondsToRun: [
+ self petitParser compileWithConfiguration: configuration.
+ ].
+ Transcript show: self petitParserClass name ; show:' compiled in: '; show: time asString; show: 'ms'; cr.
+
+ "Created: / 29-07-2015 / 16:29:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 29-07-2015 / 18:40:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+tearDownAfter
+ "Called after all my tests are ryn(when resources are torn down)"
+
+ "Created: / 29-07-2015 / 16:33:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCCompositeParserTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,189 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCompositeParserTest subclass:#PPCCompositeParserTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Support'
+!
+
+!PPCCompositeParserTest class methodsFor:'accessing'!
+
+resources
+ ^ Array with: (PPCSetUpBeforeTearDownAfterResource for: self)
+
+ "Created: / 29-07-2015 / 16:28:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCompositeParserTest class methodsFor:'queries'!
+
+isAbstract
+ "Return if this class is an abstract class.
+ True is returned here for myself only; false for subclasses.
+ Abstract subclasses must redefine again."
+
+ ^ self == PPCCompositeParserTest.
+! !
+
+!PPCCompositeParserTest class methodsFor:'utilities'!
+
+generateTestsFor: baseTestClass
+ | compiledBaseTestClassName |
+
+ compiledBaseTestClassName := (baseTestClass name startsWith: 'PP')
+ ifTrue:[ 'PPC' , (baseTestClass name copyFrom: 3 to: baseTestClass name size) ]
+ ifFalse:[ 'PPC' , baseTestClass name ].
+ compiledBaseTestClassName := compiledBaseTestClassName asSymbol.
+
+ ^ self generateTestsFor: baseTestClass compiledBaseTestCaseName: compiledBaseTestClassName
+
+ "Created: / 30-07-2015 / 07:10:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 31-07-2015 / 07:27:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+generateTestsFor: baseTestClass compiledBaseTestCaseName: compiledBaseTestClassName
+ | compiledBaseTestClass compiledUniversalTestClass compiledTokenizedTestClass |
+
+
+
+ compiledBaseTestClass := baseTestClass subclass:compiledBaseTestClassName
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category: 'PetitCompiler-Extras-Tests-Misc'.
+
+ compiledBaseTestClass class compile:
+'isAbstract
+ ^ self == ', compiledBaseTestClassName
+ classified: 'testing'.
+
+ compiledBaseTestClass class compile:
+'resources
+ ^ Array with: (PPCSetUpBeforeTearDownAfterResource for: self)'
+ classified: 'resources'.
+
+ self methodDictionary do:[:method |
+ compiledBaseTestClass compile: method source classified: method category
+ ].
+
+ compiledBaseTestClass compile:
+'petitParserClass
+ ^ ' , baseTestClass new parserClass name
+ classified: 'accessing'.
+
+ compiledUniversalTestClass := compiledBaseTestClass subclass: (compiledBaseTestClassName , '_Universal') asSymbol
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category: 'PetitCompiler-Extras-Tests-Misc'.
+
+ compiledUniversalTestClass compile:
+'compilerConfiguration
+ ^ PPCConfiguration universal'
+ classified: 'accessing'.
+
+
+ compiledTokenizedTestClass := compiledBaseTestClass subclass: (compiledBaseTestClassName , '_Tokenized') asSymbol
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category: 'PetitCompiler-Extras-Tests-Misc'.
+
+ compiledTokenizedTestClass compile:
+'compilerConfiguration
+ ^ PPCConfiguration tokenizing'
+ classified: 'accessing'.
+
+ "Created: / 31-07-2015 / 07:26:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCompositeParserTest methodsFor:'accessing'!
+
+compiledParser
+ ^ self compiledParserClass new
+
+ "Created: / 29-07-2015 / 17:00:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compiledParserClass
+ ^ Smalltalk at: self compiledParserClassName
+
+ "Created: / 29-07-2015 / 16:54:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compiledParserClassName
+ "Return the name of the compiled parser"
+
+ ^ (self petitParserClass name , 'C_' ,
+ "This is bit hacky!!"
+ ((self compilerConfiguration isKindOf: PPCTokenizingConfiguration) ifTrue:[ 'Tokenizing' ] ifFalse:[ 'Universal' ])) asSymbol
+
+ "Created: / 29-07-2015 / 16:54:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compilerConfiguration
+ "Return configuration to use when compiling parser (as instance of PPCConfiguration)"
+
+ ^ self subclassResponsibility
+
+ "Created: / 29-07-2015 / 16:53:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parserClass
+ ^ self compiledParserClass
+
+ "Modified: / 29-07-2015 / 18:43:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parserInstanceFor: aSymbol
+ ^ self parserClass new startSymbol: aSymbol
+
+ "Modified: / 29-07-2015 / 18:43:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+petitParser
+ ^ self petitParserClass new
+
+ "Created: / 29-07-2015 / 17:01:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+petitParserClass
+ "Return the name of the petit parser to compile"
+
+ ^ self subclassResponsibility
+
+ "Created: / 29-07-2015 / 17:01:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCompositeParserTest methodsFor:'context'!
+
+context
+
+ ^ PPCContext new
+! !
+
+!PPCCompositeParserTest methodsFor:'setup & teardown'!
+
+setUpBefore
+ "Called before any of my tests is run (when resources are set up)"
+ | time configuration |
+
+ configuration := self compilerConfiguration.
+ configuration arguments parserName: self compiledParserClassName.
+ time := Time millisecondsToRun: [
+ self petitParser compileWithConfiguration: configuration.
+ ].
+ Transcript show: self petitParserClass name ; show:' compiled in: '; show: time asString; show: 'ms'; cr.
+
+ "Created: / 29-07-2015 / 16:29:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 29-07-2015 / 18:40:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+tearDownAfter
+ "Called after all my tests are ryn(when resources are torn down)"
+
+ "Created: / 29-07-2015 / 16:33:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCExpressionGrammarTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,107 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPExpressionGrammarTest subclass:#PPCExpressionGrammarTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Expressions'
+!
+
+!PPCExpressionGrammarTest class methodsFor:'resources'!
+
+resources
+ ^ Array with: (PPCSetUpBeforeTearDownAfterResource for: self)
+! !
+
+!PPCExpressionGrammarTest class methodsFor:'testing'!
+
+isAbstract
+ ^ self == PPCExpressionGrammarTest
+! !
+
+!PPCExpressionGrammarTest methodsFor:'accessing'!
+
+compiledParser
+ ^ self compiledParserClass new
+
+ "Created: / 29-07-2015 / 17:00:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compiledParserClass
+ ^ Smalltalk at: self compiledParserClassName
+
+ "Created: / 29-07-2015 / 16:54:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compiledParserClassName
+ "Return the name of the compiled parser"
+
+ ^ (self petitParserClass name , 'C_' ,
+ "This is bit hacky!!"
+ ((self compilerConfiguration isKindOf: PPCTokenizingConfiguration) ifTrue:[ 'Tokenizing' ] ifFalse:[ 'Universal' ])) asSymbol
+
+ "Created: / 29-07-2015 / 16:54:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compilerConfiguration
+ "Return configuration to use when compiling parser (as instance of PPCConfiguration)"
+
+ ^ self subclassResponsibility
+
+ "Created: / 29-07-2015 / 16:53:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parserClass
+ ^ self compiledParserClass
+
+ "Modified: / 29-07-2015 / 18:43:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parserInstanceFor: aSymbol
+ ^ self parserClass new startSymbol: aSymbol
+
+ "Modified: / 29-07-2015 / 18:43:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+petitParser
+ ^ self petitParserClass new
+
+ "Created: / 29-07-2015 / 17:01:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+petitParserClass
+ ^ PPExpressionGrammar
+! !
+
+!PPCExpressionGrammarTest methodsFor:'context'!
+
+context
+
+ ^ PPCContext new
+! !
+
+!PPCExpressionGrammarTest methodsFor:'setup & teardown'!
+
+setUpBefore
+ "Called before any of my tests is run (when resources are set up)"
+ | time configuration |
+
+ configuration := self compilerConfiguration.
+ configuration arguments parserName: self compiledParserClassName.
+ time := Time millisecondsToRun: [
+ self petitParser compileWithConfiguration: configuration.
+ ].
+ Transcript show: self petitParserClass name ; show:' compiled in: '; show: time asString; show: 'ms'; cr.
+
+ "Created: / 29-07-2015 / 16:29:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 29-07-2015 / 18:40:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+tearDownAfter
+ "Called after all my tests are ryn(when resources are torn down)"
+
+ "Created: / 29-07-2015 / 16:33:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCExpressionGrammarTest_Tokenized.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,17 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCExpressionGrammarTest subclass:#PPCExpressionGrammarTest_Tokenized
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Expressions'
+!
+
+!PPCExpressionGrammarTest_Tokenized methodsFor:'accessing'!
+
+compilerConfiguration
+ ^ PPCConfiguration tokenizing
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCExpressionGrammarTest_Universal.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,17 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCExpressionGrammarTest subclass:#PPCExpressionGrammarTest_Universal
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Expressions'
+!
+
+!PPCExpressionGrammarTest_Universal methodsFor:'accessing'!
+
+compilerConfiguration
+ ^ PPCConfiguration universal
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCExpressionGrammarVerificationTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,100 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCAbstractParserTest subclass:#PPCExpressionGrammarVerificationTest
+ instanceVariableNames:'parser result context resource fileResources'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Expressions'
+!
+
+!PPCExpressionGrammarVerificationTest class methodsFor:'accessing'!
+
+resources
+ ^ (OrderedCollection with: PPCResources)
+ addAll: super resources;
+ yourself
+! !
+
+!PPCExpressionGrammarVerificationTest class methodsFor:'testing'!
+
+isAbstract
+ ^ self == PPCExpressionGrammarVerificationTest
+
+ "Modified: / 29-07-2015 / 18:50:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCExpressionGrammarVerificationTest methodsFor:'accessing'!
+
+petitParserClass
+ "Return the name of the petit parser to compile"
+
+ ^ PPExpressionGrammar
+
+ "Modified: / 29-07-2015 / 17:08:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCExpressionGrammarVerificationTest methodsFor:'setup'!
+
+setUp
+ super setUp.
+ fileResources := (self resources detect: [:e | e = PPCResources ]) current.
+!
+
+tearDown
+ super tearDown.
+ "
+ self compiledSmalltalkGrammarClass isNil ifFalse:[
+ self compiledSmalltalkGrammarClass removeFromSystem
+ ].
+ "
+! !
+
+!PPCExpressionGrammarVerificationTest methodsFor:'tests'!
+
+testExpressions
+ | compiledParser petitParser expected actual |
+ petitParser := self petitParser.
+ compiledParser := self compiledParser.
+
+ fileResources expressionSourcesMedium do: [ :source |
+ expected := petitParser parse: source.
+ expected isPetitFailure ifFalse: [
+ actual := (compiledParser parse: source withContext: self context).
+ self assert: expected equals: actual.
+ ]
+ ].
+
+ "Modified: / 29-07-2015 / 17:03:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testSanity
+ | compiledParser petitParser source |
+ petitParser := self petitParser.
+ compiledParser := self compiledParser.
+
+ source := fileResources expressionOfSize: 100.
+ result := petitParser parse: source.
+
+ self assert: (((self deepFlattened: result) select: [ :e | e isNumber ]) size) = 100.
+ self assert: (((self deepFlattened: result)select: [ :e | e isNumber ]) size) = 100.
+
+ "Modified: / 29-07-2015 / 17:03:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCExpressionGrammarVerificationTest 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.
+! !
+
--- a/compiler/tests/extras/PPCExpressionsVerificationTest.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,96 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPAbstractParserTest subclass:#PPCExpressionsVerificationTest
- instanceVariableNames:'parser result context resource fileResources'
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Extras-Tests-Expressions'
-!
-
-!PPCExpressionsVerificationTest class methodsFor:'as yet unclassified'!
-
-isAbstract
- ^ self name = #PPCExpressionsVerificationTest
-!
-
-resources
- ^ (OrderedCollection with: PPCResources)
- addAll: super resources;
- yourself
-! !
-
-!PPCExpressionsVerificationTest methodsFor:'accessing'!
-
-compiledGrammar
- ^ self compiledGrammarClass new
-!
-
-compiledGrammarClass
- self subclassResponsibility
-!
-
-grammar
- ^ PPExpressionGrammar new
-! !
-
-!PPCExpressionsVerificationTest methodsFor:'setup'!
-
-setUp
- super setUp.
- fileResources := (self resources detect: [:e | e = PPCResources ]) current.
-!
-
-tearDown
- super tearDown.
- "
- self compiledSmalltalkGrammarClass isNil ifFalse:[
- self compiledSmalltalkGrammarClass removeFromSystem
- ].
- "
-! !
-
-!PPCExpressionsVerificationTest methodsFor:'tests'!
-
-testExpressions
- | compiledParser normalParser expected actual |
- normalParser := self grammar.
- compiledParser := self compiledGrammar.
-
- fileResources expressionSourcesMedium do: [ :source |
- expected := normalParser parse: source.
- expected isPetitFailure ifFalse: [
- actual := (compiledParser parse: source withContext: self context).
- self assert: expected equals: actual.
- ]
- ].
-!
-
-testSanity
- | compiledParser normalParser source |
- normalParser := self grammar.
- compiledParser := self compiledGrammar.
-
- source := fileResources expressionOfSize: 100.
- result := normalParser parse: source.
-
- 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.
-! !
-
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLL1ExpressionGrammarTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,107 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPLL1ExpressionGrammarTest subclass:#PPCLL1ExpressionGrammarTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Expressions'
+!
+
+!PPCLL1ExpressionGrammarTest class methodsFor:'resources'!
+
+resources
+ ^ Array with: (PPCSetUpBeforeTearDownAfterResource for: self)
+! !
+
+!PPCLL1ExpressionGrammarTest class methodsFor:'testing'!
+
+isAbstract
+ ^ self == PPCLL1ExpressionGrammarTest
+! !
+
+!PPCLL1ExpressionGrammarTest methodsFor:'accessing'!
+
+compiledParser
+ ^ self compiledParserClass new
+
+ "Created: / 29-07-2015 / 17:00:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compiledParserClass
+ ^ Smalltalk at: self compiledParserClassName
+
+ "Created: / 29-07-2015 / 16:54:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compiledParserClassName
+ "Return the name of the compiled parser"
+
+ ^ (self petitParserClass name , 'C_' ,
+ "This is bit hacky!!"
+ ((self compilerConfiguration isKindOf: PPCTokenizingConfiguration) ifTrue:[ 'Tokenizing' ] ifFalse:[ 'Universal' ])) asSymbol
+
+ "Created: / 29-07-2015 / 16:54:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compilerConfiguration
+ "Return configuration to use when compiling parser (as instance of PPCConfiguration)"
+
+ ^ self subclassResponsibility
+
+ "Created: / 29-07-2015 / 16:53:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parserClass
+ ^ self compiledParserClass
+
+ "Modified: / 29-07-2015 / 18:43:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parserInstanceFor: aSymbol
+ ^ self parserClass new startSymbol: aSymbol
+
+ "Modified: / 29-07-2015 / 18:43:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+petitParser
+ ^ self petitParserClass new
+
+ "Created: / 29-07-2015 / 17:01:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+petitParserClass
+ ^ PPLL1ExpressionGrammar
+! !
+
+!PPCLL1ExpressionGrammarTest methodsFor:'context'!
+
+context
+
+ ^ PPCContext new
+! !
+
+!PPCLL1ExpressionGrammarTest methodsFor:'setup & teardown'!
+
+setUpBefore
+ "Called before any of my tests is run (when resources are set up)"
+ | time configuration |
+
+ configuration := self compilerConfiguration.
+ configuration arguments parserName: self compiledParserClassName.
+ time := Time millisecondsToRun: [
+ self petitParser compileWithConfiguration: configuration.
+ ].
+ Transcript show: self petitParserClass name ; show:' compiled in: '; show: time asString; show: 'ms'; cr.
+
+ "Created: / 29-07-2015 / 16:29:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 29-07-2015 / 18:40:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+tearDownAfter
+ "Called after all my tests are ryn(when resources are torn down)"
+
+ "Created: / 29-07-2015 / 16:33:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLL1ExpressionGrammarTest_Tokenized.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,17 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLL1ExpressionGrammarTest subclass:#PPCLL1ExpressionGrammarTest_Tokenized
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Expressions'
+!
+
+!PPCLL1ExpressionGrammarTest_Tokenized methodsFor:'accessing'!
+
+compilerConfiguration
+ ^ PPCConfiguration tokenizing
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLL1ExpressionGrammarTest_Universal.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,17 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLL1ExpressionGrammarTest subclass:#PPCLL1ExpressionGrammarTest_Universal
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Expressions'
+!
+
+!PPCLL1ExpressionGrammarTest_Universal methodsFor:'accessing'!
+
+compilerConfiguration
+ ^ PPCConfiguration universal
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPAction.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,63 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPNode subclass:#PPCLRPAction
+ instanceVariableNames:'block textBlock interpretedBlock keywordEnd'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPAction class methodsFor:'instance creation'!
+
+block: aBlock
+ |retval|
+ retval := self new.
+ retval block: aBlock.
+ retval textBlock: aBlock copy.
+ ^ retval
+! !
+
+!PPCLRPAction methodsFor:'accessing'!
+
+block
+ ^ block
+!
+
+block: anObject
+ block := anObject
+!
+
+keywordEnd
+ keywordEnd ifNil: [ self halt: 'Error in setting up range info for styling' ].
+ ^ keywordEnd
+!
+
+keywordEnd: anObject
+ keywordEnd := anObject
+!
+
+textBlock
+ ^ textBlock
+!
+
+textBlock: anObject
+ textBlock := anObject
+! !
+
+!PPCLRPAction methodsFor:'printing'!
+
+printOn: aStream
+
+ aStream nextPutAll: self class name.
+ aStream nextPutAll: ' : '.
+ aStream nextPutAll: self block asString.
+! !
+
+!PPCLRPAction methodsFor:'visiting'!
+
+acceptVisitor: aLRPNodeVisitor
+ aLRPNodeVisitor visitActionNode: self.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPComment.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,34 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPContainedElement subclass:#PPCLRPComment
+ instanceVariableNames:'text'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPComment class methodsFor:'instance creation'!
+
+text: aString
+ ^ self new text: aString
+! !
+
+!PPCLRPComment methodsFor:'accessing'!
+
+text
+ ^ text
+!
+
+text: anObject
+ text := anObject
+! !
+
+!PPCLRPComment methodsFor:'as yet unclassified'!
+
+printOn: aStream
+ aStream nextPutAll: 'PPCLRPComment : '.
+ aStream nextPutAll: self text asString.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPContainedElement.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,21 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPNode subclass:#PPCLRPContainedElement
+ instanceVariableNames:'container'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPContainedElement methodsFor:'accessing'!
+
+container
+ ^ container
+!
+
+container: anObject
+ container := anObject
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPEpsilonTransition.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,39 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPTransition subclass:#PPCLRPEpsilonTransition
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPEpsilonTransition class methodsFor:'instance creation'!
+
+from: startState to: endState name: aString
+ |retval|
+ retval := self new.
+ retval from: startState.
+ retval to: endState.
+ retval name: aString.
+ ^ retval.
+!
+
+on: anEvent from: startState to: endState name: aString
+
+ self error: 'Epsilon Transitions have no events. Use from:to:name: instead.'
+! !
+
+!PPCLRPEpsilonTransition methodsFor:'printing'!
+
+printOn: aStream
+
+ aStream nextPutAll: 'PPCLRPEpsilonTransition '.
+ aStream nextPutAll: self name.
+ aStream nextPutAll: ' : '.
+ aStream nextPutAll: self from.
+ aStream nextPutAll: '->'.
+ aStream nextPutAll: self to.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPErrorNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,30 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPContainedElement subclass:#PPCLRPErrorNode
+ instanceVariableNames:'block interpretedBlock'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPErrorNode methodsFor:'error handing'!
+
+onErrorNode: aBlock parser: aLRPParser
+
+ aLRPParser failWithValue: (aBlock value: self)
+! !
+
+!PPCLRPErrorNode methodsFor:'testing'!
+
+isError
+ ^true
+! !
+
+!PPCLRPErrorNode methodsFor:'visiting'!
+
+acceptVisitor: aLRPNodeVisitor
+ aLRPNodeVisitor visitErrorNode: self.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPEvent.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,55 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPContainedElement subclass:#PPCLRPEvent
+ instanceVariableNames:'name trigger triggerBlock'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPEvent class methodsFor:'instance creation'!
+
+named: aString trigger: aBlock
+ |retval|
+ retval := self new.
+ retval name: aString.
+ retval trigger: aBlock.
+ ^ retval
+! !
+
+!PPCLRPEvent methodsFor:'accessing'!
+
+name
+ ^ name
+!
+
+name: anObject
+ name := anObject
+!
+
+trigger
+ ^ trigger
+!
+
+trigger: anObject
+ trigger := anObject
+! !
+
+!PPCLRPEvent methodsFor:'printing'!
+
+printOn: aStream
+ aStream nextPutAll: 'PPCLRPEvent '.
+ aStream nextPutAll: self name.
+ aStream nextPutAll: ' : '.
+ aStream nextPutAll: self trigger asString.
+
+! !
+
+!PPCLRPEvent methodsFor:'visiting'!
+
+acceptVisitor: aPPCLRPNodeVisitor
+ aPPCLRPNodeVisitor visitEventNode: self
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPMachine.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,124 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPContainedElement subclass:#PPCLRPMachine
+ instanceVariableNames:'initState name body currentState scope triggeredTransition
+ compareStates compareTransitions'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPMachine class methodsFor:'instance creation'!
+
+name: aString body: anArray
+ |retval|
+ retval := self new.
+ retval name: aString.
+ retval body: anArray.
+ ^retval
+! !
+
+!PPCLRPMachine methodsFor:'accessing'!
+
+allTransitions
+ ^self body select:[:item | item isKindOf: PPCLRPTransition]
+!
+
+body
+ ^ body
+!
+
+body: anObject
+ body := anObject.
+ body do: [ :aBodyElement| aBodyElement container: self ].
+!
+
+containerMachine
+ self container isNil
+ ifTrue: [ ^nil ]
+ ifFalse: [ ^self container container ]
+!
+
+eps
+ ^self body select:[:item | item isMemberOf: PPCLRPEpsilonTransition]
+!
+
+events
+ ^self body select:[:item | item class = PPCLRPEvent]
+!
+
+machines
+ ^self body select:[:item | item class = PPCLRPMachine]
+!
+
+myVarsAndParentVars
+
+ |recblock |
+ recblock := [ ].
+ recblock := [ :aMachine| |variables|
+ aMachine ifNil:[
+ OrderedCollection new.
+ ] ifNotNil: [
+ variables := recblock value: aMachine containerMachine.
+ variables addAll: (aMachine variables collect:[:aVarNode| aVarNode name]).
+ variables
+ ]
+ ].
+
+ ^recblock value: self.
+
+!
+
+name
+ ^ name
+!
+
+name: anObject
+ name := anObject
+!
+
+ontime
+ ^self body select:[:item | item isMemberOf: PPCLRPTimeoutTransition]
+!
+
+states
+ ^self body select:[:item | item class = PPCLRPState]
+!
+
+transitions
+ ^self body select:[:item | item isMemberOf: PPCLRPTransition]
+!
+
+variables
+ ^self body select:[:item | item class = PPCLRPVariable]
+!
+
+wildtrans
+ ^self body select:[:item | item class = PPCLRPWildcardTransition]
+! !
+
+!PPCLRPMachine methodsFor:'error handing'!
+
+onErrorNode: aBlock parser: aPPCLRPParser
+
+ ^body do: [ :aNode| aNode onErrorNode: aBlock parser: aPPCLRPParser]
+! !
+
+!PPCLRPMachine methodsFor:'printing'!
+
+printOn: aStream
+ aStream nextPutAll: 'PPCLRPMachine '.
+ aStream nextPutAll: self name.
+ aStream nextPutAll: ' : '.
+ aStream nextPutAll: self body asString.
+
+! !
+
+!PPCLRPMachine methodsFor:'visiting'!
+
+acceptVisitor: aPPCLRPNodeVisitor
+ aPPCLRPNodeVisitor visitMachineNode: self.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPNode.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,63 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCLRPNode
+ instanceVariableNames:'start stop nameRange'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPNode methodsFor:'accessing'!
+
+nameRange
+ nameRange ifNil: [self halt: 'Error in setting up range info for styling.' ].
+ ^ nameRange
+!
+
+nameRange: anObject
+ nameRange := anObject
+!
+
+start
+ ^ start
+!
+
+start: anObject
+ start := anObject
+!
+
+start: aNumber stop: anotherNumber
+
+ start := aNumber.
+ stop := anotherNumber.
+!
+
+stop
+ ^ stop
+!
+
+stop: anObject
+ stop := anObject
+! !
+
+!PPCLRPNode methodsFor:'error handing'!
+
+onErrorNode: aBlock parser: aPPCLRPParser
+ "do nothing"
+! !
+
+!PPCLRPNode methodsFor:'testing'!
+
+isError
+
+ ^false.
+! !
+
+!PPCLRPNode methodsFor:'visiting'!
+
+acceptVisitor: aPPCLRPNodeVisitor
+ aPPCLRPNodeVisitor visitAnyNode: self.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPOnEntry.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,11 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPAction subclass:#PPCLRPOnEntry
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPOnExit.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,11 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPAction subclass:#PPCLRPOnExit
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPParser.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,383 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCompositeParser subclass:#PPCLRPParser
+ instanceVariableNames:'program variable smalltalkBlock bra ket identifier machine body
+ event transition epsilon wildcard state onentry running onexit
+ comment lineTerminator statebody spawn integer errorNode success
+ failed lastError styler timeoutIdentifier timeoutInteger
+ endOfComment'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPParser class methodsFor:'accessing'!
+
+ignoredNames
+
+ ^super ignoredNames , #(styler failed lastError)
+! !
+
+!PPCLRPParser methodsFor:'accessing'!
+
+error
+ ^super error
+
+ "Modified: / 30-07-2015 / 17:12:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+failed
+ ^failed
+!
+
+lastError
+ ^lastError
+!
+
+start
+ ^program end
+!
+
+styler: aSHStyler
+
+ styler := aSHStyler.
+!
+
+success
+ ^success
+! !
+
+!PPCLRPParser methodsFor:'block creation'!
+
+createSTBlockFrom: aBlockNode withVariables: aDictionary
+ |compiled retval keys|
+
+ keys := OrderedCollection new: aDictionary size.
+ aDictionary associations do: [:asoc|
+ keys add: asoc key.
+ ].
+
+ compiled := (self methodizeBlock: aBlockNode withArguments: keys) compiledMethod.
+ retval := compiled valueWithReceiver: Object new arguments: {aDictionary}.
+
+ ^retval.
+!
+
+methodizeBlock: parsedBlock withArguments: anArray
+
+ |method retval inspoint|
+
+ method := 'captureV: PPCLRPScopeVariables'.
+
+ retval := PPSmalltalkParser new method parse: method , '^[1]'.
+ inspoint := retval body statements first.
+ parsedBlock scope: inspoint value scope.
+ parsedBlock parent: inspoint.
+ inspoint value: parsedBlock.
+ retval source: retval asString.
+
+ anArray do: [:aVarName|
+ retval := retval rewritePPCLRPVarNamedWrite: aVarName.
+ retval := retval rewritePPCLRPVarNamedRead: aVarName.
+ ].
+ ^retval
+! !
+
+!PPCLRPParser methodsFor:'error handing'!
+
+failWithValue: anObject
+
+ failed := true.
+ lastError := anObject.
+! !
+
+!PPCLRPParser methodsFor:'grammar'!
+
+body
+ ^(variable / event / state / transition / timeoutIdentifier / timeoutInteger / epsilon / wildcard / comment / errorNode) star
+!
+
+errorNode
+ ^(bra, (bra/ket)negate star , ket)
+ ==> [ :tokens |
+ PPCLRPErrorNode new start: tokens first start stop: tokens last stop; yourself.
+ ]
+!
+
+event
+ ^ (bra, 'event' asParser trim, identifier, smalltalkBlock, ket)
+ ==> [:tokens | | ident |
+ ident := (tokens at: 3).
+ (PPCLRPEvent named: ident inputValue
+ trigger: (tokens at: 4))
+ start: tokens first start stop: tokens last stop;
+ nameRange: (ident start to: ident stop);
+ yourself.
+ ]
+!
+
+integer
+ ^(#digit asParser) plus token trim
+!
+
+machine
+ ^(bra , 'machine' asParser trim , identifier , body , ket)
+ ==> [:tokens | | ident bod stop |
+ ident := (tokens at: 3).
+ bod := (tokens at: 4).
+ bod isEmpty
+ ifTrue: [ stop := tokens last stop - 1 ]
+ ifFalse: [ stop := (bod at: 1) start - 1 ].
+ (PPCLRPMachine name: ident inputValue body: bod)
+ start: (tokens first start) stop: (tokens last stop);
+ nameRange: (ident start to: stop);
+ yourself.
+ ]
+!
+
+onentry
+ ^ (bra, 'onentry' asParser trim, (smalltalkBlock/spawn) , ket )
+ ==> [:tokens |
+ (PPCLRPOnEntry block: (tokens at: 3))
+ start: (tokens first start) stop: (tokens last stop);
+ keywordEnd: (tokens at: 3) start -1;
+ yourself.
+ ]
+!
+
+onexit
+ ^ (bra, 'onexit' asParser trim, (smalltalkBlock/spawn), ket)
+ ==> [:tokens |
+ (PPCLRPOnExit block: (tokens at: 3))
+ start: (tokens first start) stop: (tokens last stop);
+ keywordEnd: (tokens at: 3) start -1;
+ yourself.
+ ]
+!
+
+program
+ ^ (variable / machine / comment / spawn / errorNode) star
+!
+
+running
+ ^ (bra, 'running' asParser trim, (smalltalkBlock/spawn), ket)
+ ==> [:tokens |
+ (PPCLRPRunning block: (tokens at: 3))
+ start: (tokens first start) stop: (tokens last stop);
+ keywordEnd: (tokens at: 3) start -1;
+ yourself.
+ ]
+!
+
+spawn
+ ^(bra , 'spawn' asParser trim , identifier , identifier , ket)
+ ==> [ :tokens |
+ (PPCLRPSpawn
+ machine: (tokens at: 3) inputValue
+ state: (tokens at: 4) inputValue)
+ start: (tokens first start) stop: (tokens last stop);
+ nameRange: ((tokens at: 3) start to: (tokens at: 4) stop)
+ yourself.
+ ]
+
+!
+
+state
+ ^(bra , 'state' asParser trim , identifier , statebody , ket)
+ ==> [ :tokens | | ident |
+ ident := (tokens at: 3).
+ (PPCLRPState name: ident inputValue
+ body: (tokens at: 4))
+ start: (tokens first start) stop: (tokens last stop);
+ nameRange: (ident start to: ident stop);
+ yourself.
+ ]
+
+!
+
+statebody
+ ^(onentry / running / onexit / machine / comment / errorNode) star
+
+!
+
+variable
+ ^ (bra , 'var' asParser trim , identifier , ':=' asParser trim , smalltalkBlock , ket)
+ ==> [ :tokens | |ident|
+ ident := (tokens at: 3).
+ (PPCLRPVariable name: ident inputValue value: (tokens at: 5))
+ start: (tokens first start) stop: (tokens last stop);
+ nameRange: (ident start to: ident stop);
+ yourself.
+ ]
+! !
+
+!PPCLRPParser methodsFor:'grammar-comments'!
+
+comment
+ ^ ($; asParser, (endOfComment negate star), endOfComment) token trim
+ ==> [ :token | |text|
+ text := token inputValue.
+ (PPCLRPComment text: (text copyFrom: 1 to: text size -1) trim)
+ start: (token start) stop: (token stop);
+ yourself.
+ ]
+!
+
+endOfComment
+ ^ #eof asParser / lineTerminator
+!
+
+lineTerminator
+
+ ^ (Character lf asParser) / (Character cr asParser , (Character lf asParser ) optional )
+! !
+
+!PPCLRPParser methodsFor:'grammar-common'!
+
+bra
+ ^ $( asParser token trim
+!
+
+identifier
+ ^(#letter asParser , (#word asParser / $_ asParser) star) token trim
+!
+
+ket
+ ^ $) asParser token trim
+!
+
+smalltalkBlock
+ ^PPSmalltalkParser new productionAt: #block
+! !
+
+!PPCLRPParser methodsFor:'grammar-transitions'!
+
+epsilon
+ ^ (bra, 'eps' asParser trim, identifier, '->' asParser trim, identifier, identifier optional, ket)
+ ==> [ :tokens | | trans name |
+ name := (tokens at: 6).
+ name ifNil: [name := '' ] ifNotNil: [ name := name inputValue ].
+ trans :=
+ (PPCLRPEpsilonTransition
+ from: (tokens at: 3) inputValue
+ to: (tokens at: 5) inputValue
+ name: name).
+ self setTransitionRangesIn: trans for: tokens withArrowAt: 3.
+ trans
+ ]
+!
+
+timeoutIdentifier
+ ^ (bra, 'ontime' asParser trim, identifier , identifier, '->' asParser trim, identifier, identifier optional, ket)
+ ==> [:tokens | self transitionActionHandlerFor: PPCLRPTimeoutTransition tokens: tokens ].
+
+ "Modified: / 30-07-2015 / 17:14:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+timeoutInteger
+ ^ (bra, 'ontime' asParser trim, integer, identifier, '->' asParser trim, identifier, identifier optional, ket)
+ ==> [ :tokens | | trans name |
+ name := (tokens at: 7).
+ name ifNil: [name := '' ] ifNotNil: [ name := name inputValue ].
+ trans :=
+ (PPCLRPTimeoutTransition
+ on: (Integer readFrom: (tokens at: 3) inputValue)
+ from: (tokens at: 4) inputValue
+ to: (tokens at: 6) inputValue
+ name: name).
+ self setTransitionRangesIn: trans for: tokens withArrowAt: 4.
+ trans.
+ ]
+!
+
+transition
+ ^ (bra, 'on' asParser trim, identifier, identifier, '->' asParser trim, identifier, identifier optional , ket)
+ ==> [ :tokens | self transitionActionHandlerFor: PPCLRPTransition tokens: tokens ]
+
+ "Modified: / 30-07-2015 / 17:15:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+wildcard
+ ^ (bra, 'on' asParser trim, identifier, '*->' asParser trim, identifier, identifier optional, ket)
+ ==> [ :tokens | | trans name |
+ name := (tokens at: 6).
+ name ifNil: [name := '' ] ifNotNil: [ name := name inputValue ].
+ trans :=
+ (PPCLRPWildcardTransition
+ on: (tokens at: 3) inputValue
+ to: (tokens at: 5) inputValue
+ name: name ).
+ self setTransitionRangesIn: trans for: tokens withArrowAt: 3.
+ trans
+ ]
+
+! !
+
+!PPCLRPParser methodsFor:'parsing'!
+
+parse: aText styleOn: aViewOrMorph
+ |parsedProgram|
+
+ parsedProgram := self parsePPCLRP: aText.
+ self styler view: aViewOrMorph; parser: self; nodes: parsedProgram; style: aText.
+
+ ^parsedProgram.
+!
+
+parsePPCLRP: aString
+
+ |parsedProgram |
+ failed := false.
+ parsedProgram := self parse: aString.
+
+ parsedProgram isPetitFailure ifTrue:[
+ parsedProgram :=
+ {PPCLRPErrorNode new
+ start: 1;
+ stop: aString size;
+ yourself.
+ }
+ ].
+
+ "visit pattern?"
+ parsedProgram do:[:aNode|
+ (aNode onErrorNode: [:anErrorNode| ] parser: self)
+ ].
+
+ ^parsedProgram.
+! !
+
+!PPCLRPParser methodsFor:'transitions'!
+
+setTransitionRangesIn: aTransition for: aTokenArray withArrowAt: index
+ | ident |
+ ident := (aTokenArray at: index + 3).
+ ident
+ ifNil: [ aTransition nameRange: (1 to: 1) ]
+ ifNotNil: [ aTransition nameRange: (ident start to: ident stop) ].
+ aTransition
+ start: (aTokenArray first start) stop: (aTokenArray last stop);
+ arrowRange:
+ ((aTokenArray at: index) stop + 1
+ to: (aTokenArray at: index + 2) start -1);
+ keywordEnd: (aTokenArray at: 3) start -1
+!
+
+transitionActionHandlerFor: class tokens: tokens
+ | trans name|
+ name := (tokens at: 7).
+ name isNil ifTrue:[ name := '' ] ifFalse:[ name := name inputValue ].
+ trans :=
+ (class
+ on: (tokens at: 3) inputValue
+ from: (tokens at: 4) inputValue
+ to: (tokens at: 6) inputValue
+ name: name).
+ self setTransitionRangesIn: trans for: tokens withArrowAt: 4.
+ ^ trans.
+
+ "Created: / 30-07-2015 / 17:12:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPParserSmokeTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,41 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCompositeParserTest subclass:#PPCLRPParserSmokeTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPParserSmokeTest class methodsFor:'accessing'!
+
+resources
+ ^ (OrderedCollection with: PPCLRPSourcesResource)
+ addAll: super resources;
+ yourself
+
+ "Created: / 30-07-2015 / 19:07:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCLRPParserSmokeTest methodsFor:'accessing'!
+
+parserClass
+ "superclass PPCompositeParserTest says that I am responsible to implement this method"
+
+ ^ PPCLRPParser
+
+ "Modified: / 30-07-2015 / 19:07:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCLRPParserSmokeTest methodsFor:'tests'!
+
+testSmoke1
+ PPCLRPSourcesResource current sources do:[:source |
+ self parse: source
+ ].
+
+ "Created: / 30-07-2015 / 19:07:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPParserVerificationTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,124 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCAbstractParserTest subclass:#PPCLRPParserVerificationTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPParserVerificationTest class methodsFor:'resources'!
+
+resources
+ ^ Array with: (PPCSetUpBeforeTearDownAfterResource for: self)
+! !
+
+!PPCLRPParserVerificationTest class methodsFor:'testing'!
+
+isAbstract
+ ^ self == PPCLRPParserVerificationTest
+
+ "Modified: / 31-07-2015 / 07:53:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCLRPParserVerificationTest methodsFor:'accessing'!
+
+compiledParser
+ ^ self compiledParserClass new
+
+ "Created: / 29-07-2015 / 17:00:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compiledParserClass
+ ^ Smalltalk at: self compiledParserClassName
+
+ "Created: / 29-07-2015 / 16:54:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compiledParserClassName
+ "Return the name of the compiled parser"
+
+ ^ (self petitParserClass name , 'C_' ,
+ "This is bit hacky!!"
+ ((self compilerConfiguration isKindOf: PPCTokenizingConfiguration) ifTrue:[ 'Tokenizing' ] ifFalse:[ 'Universal' ])) asSymbol
+
+ "Created: / 29-07-2015 / 16:54:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compilerConfiguration
+ "Return configuration to use when compiling parser (as instance of PPCConfiguration)"
+
+ ^ self subclassResponsibility
+
+ "Created: / 29-07-2015 / 16:53:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parserClass
+ ^ self compiledParserClass
+
+ "Modified: / 29-07-2015 / 18:43:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parserInstanceFor: aSymbol
+ ^ self parserClass new startSymbol: aSymbol
+
+ "Modified: / 29-07-2015 / 18:43:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+petitParser
+ ^ self petitParserClass new
+
+ "Created: / 29-07-2015 / 17:01:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+petitParserClass
+ ^ PPCLRPParser
+! !
+
+!PPCLRPParserVerificationTest methodsFor:'context'!
+
+context
+
+ ^ PPCContext new
+! !
+
+!PPCLRPParserVerificationTest methodsFor:'setup & teardown'!
+
+setUpBefore
+ "Called before any of my tests is run (when resources are set up)"
+ | time configuration |
+
+ configuration := self compilerConfiguration.
+ configuration arguments parserName: self compiledParserClassName.
+ time := Time millisecondsToRun: [
+ self petitParser compileWithConfiguration: configuration.
+ ].
+ Transcript show: self petitParserClass name ; show:' compiled in: '; show: time asString; show: 'ms'; cr.
+
+ "Created: / 29-07-2015 / 16:29:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 29-07-2015 / 18:40:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+tearDownAfter
+ "Called after all my tests are ryn(when resources are torn down)"
+
+ "Created: / 29-07-2015 / 16:33:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCLRPParserVerificationTest methodsFor:'testing'!
+
+testSmoke1
+ | compiledParser normalParser |
+ normalParser := self petitParser.
+ compiledParser := self compiledParser.
+
+ PPCLRPSourcesResource current sources do:[:source |
+ self assert: (normalParser parse: source) asString
+ equals: (compiledParser parse: source withContext: self context) asString.
+ ].
+
+ "Created: / 30-07-2015 / 19:07:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPParserVerificationTest_Tokenized.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,17 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPParserVerificationTest subclass:#PPCLRPParserVerificationTest_Tokenized
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPParserVerificationTest_Tokenized methodsFor:'accessing'!
+
+compilerConfiguration
+ ^ PPCConfiguration tokenizing
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPParserVerificationTest_Universal.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,17 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPParserVerificationTest subclass:#PPCLRPParserVerificationTest_Universal
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPParserVerificationTest_Universal methodsFor:'accessing'!
+
+compilerConfiguration
+ ^ PPCConfiguration universal
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPRunning.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,11 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPAction subclass:#PPCLRPRunning
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPSourcesResource.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,425 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestResource subclass:#PPCLRPSourcesResource
+ instanceVariableNames:'sources'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+
+!PPCLRPSourcesResource methodsFor:'accessing'!
+
+sources
+ sources isNil ifTrue:[
+ sources := #(
+ doranewbridge
+ doraultratouch
+ escapament
+ follower
+ linebounderfollower
+ linecrossfollower
+ rtimer
+ stairsclimber
+ stopwatch
+ timer
+ ) collect:[:e | self perform: e].
+ ].
+ ^ sources
+
+ "Created: / 30-07-2015 / 19:04:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCLRPSourcesResource methodsFor:'sources - individual'!
+
+doranewbridge
+^ ';; A Random Space Explorer behavior for a differential drive robot
+;; Wall collisions are detected with the ultrasonic sensor
+
+(var speed :=[20])
+(var timeout := [1000 atRandom])
+(machine Dora
+ (state forward
+ (onentry [
+ robot motorA startAtSpeed: speed.
+ robot motorD startAtSpeed: speed.
+ ])
+ (onexit [robot fullStop]))
+ (state shock
+ (onentry [
+ robot motorA startAtSpeed: speed negated.
+ robot motorD startAtSpeed: speed negated.
+ ])
+ (onexit [robot fullStop]))
+ (state turn
+ (onentry [
+ robot motorA startAtSpeed: speed.
+ robot motorD startAtSpeed: speed negated
+ ])
+ (onexit [
+ robot fullStop.
+ timeout := 1000 atRandom
+ ]))
+ (ontime 500 shock -> turn st)
+ (ontime timeout turn -> forward tf)
+ (on tooclose forward -> shock fs)
+ (event tooclose [robot sensor2 read < 200])
+)
+(spawn Dora forward)
+'
+
+ "Created: / 30-07-2015 / 17:39:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+doraultratouch
+^ ';; A Random Space Explorer behavior for a differential drive robot
+;; Wall collisions are detected with the ultrasonic sensor and touch sensors
+
+(var speed :=[20])
+(var timeout := [1000 atRandom])
+(machine Dora
+ (state forward
+ (onentry [
+ robot motorA startAtSpeed: speed.
+ robot motorD startAtSpeed: speed.
+ ])
+ (onexit [robot fullStop]))
+ (state shock
+ (onentry [
+ robot motorA startAtSpeed: speed negated.
+ robot motorD startAtSpeed: speed negated.
+ ])
+ (onexit [robot fullStop]))
+ (state turn
+ (onentry [
+ robot motorA startAtSpeed: speed.
+ robot motorD startAtSpeed: speed negated
+ ])
+ (onexit [
+ robot fullStop.
+ timeout := 1000 atRandom
+ ]))
+ (ontime 500 shock -> turn st)
+ (ontime timeout turn -> forward tf)
+ (on tooclose forward -> shock fs)
+ (on shockLeft forward -> shock sl)
+ (on shockRight forward -> shock sf)
+ (event tooclose [robot sensor2 read < 200])
+ (event shockLeft [robot sensor4 read = 1])
+ (event shockRight [robot sensor1 read = 1])
+)
+(spawn Dora forward)
+
+'
+
+ "Created: / 30-07-2015 / 17:40:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+escapament
+^ ';;; A simple escapement
+(machine esc
+ (state tick)
+ (state tock)
+ (ontime 500 tick -> tock tito)
+ (ontime 500 tock -> tick toti)
+)
+(spawn esc tick)'
+
+ "Created: / 30-07-2015 / 17:37:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+follower
+^ ';; A line follower for a differential drive robot
+;; Uses the Lego color sensor,
+;; position is front and center, and pointed to the line (down)
+(var sensor := [robot sensor3])
+(var mright := [robot motorA])
+(var mleft := [robot motorD])
+(var speed := [4])
+(machine follower
+ (state init
+ (onentry [sensor setMode: #Mode2])
+ )
+ (state moving
+ (onentry [
+ mright startAtSpeed: speed * 2.
+ mleft startAtSpeed: speed * 2.
+ ])
+ (onexit [robot fullStop])
+ )
+ (state looking
+ (machine lookalgo
+ (var looktime := [1000])
+ (state lookright
+ (onentry
+ [mright startAtSpeed: speed negated.
+ mleft startAtSpeed: speed.]))
+ (state lookleft
+ )
+ (state centerfromright
+ (onentry
+ [mright startAtSpeed: speed.
+ mleft startAtSpeed: speed negated.]))
+ (state centerfromleft
+ (onentry
+ [mright startAtSpeed: speed negated.
+ mleft startAtSpeed: speed.])
+ (onexit [looktime := looktime * 2]))
+ (ontime looktime lookright -> centerfromright tlrb)
+ (ontime looktime centerfromright -> lookleft tlr)
+ (ontime looktime lookleft -> centerfromleft tfail)
+ (ontime looktime centerfromleft -> lookright tfailb)
+ )
+ (onentry (spawn lookalgo lookright))
+ )
+ (eps init -> moving tinit)
+ (on out moving -> looking tms)
+ (event out [(sensor read = 1) not])
+ (event in [sensor read = 1])
+ (on in looking -> moving tsm)
+)
+(spawn follower init)
+
+'
+
+ "Created: / 30-07-2015 / 17:40:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+linebounderfollower
+^ ';; Line following robot for a differential drive robot
+;;; that "bounces" off the left hand side of the line
+;; Uses the Lego color sensor,
+;; position is front and center, and pointed to the line (down)
+(var sensor := [robot sensor3])
+(var mright := [robot motorA])
+(var mleft := [robot motorD])
+(machine linebounce
+ (state init
+ (onentry [sensor setMode: #Mode2.]))
+ (eps init -> white iw)
+ (state white
+ (onentry [
+ mright startAtSpeed: 4.
+ mleft startAtSpeed: 18])
+ (onexit [mright stop. mleft stop]))
+ (state black
+ (onentry [
+ mright startAtSpeed: 10.
+ mleft startAtSpeed: -4])
+ (onexit [mright stop. mleft stop]))
+ (on seeblack white -> black wb)
+ (on seewhite black -> white bw)
+ (event seeblack [sensor read = 1])
+ (event seewhite [(sensor read = 1) not])
+)
+(spawn linebounce init)
+
+'
+
+ "Created: / 30-07-2015 / 17:41:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+linecrossfollower
+^ ';;; Line following for a differential drive robot
+;;; goes forward by always crossing the line
+;; Uses the Lego color sensor,
+;; position is front and center, and pointed to the line (down)
+(var sensor := [robot sensor3])
+(var mright := [robot motorA])
+(var mleft := [robot motorD])
+(var speed := [15])
+(machine linecross
+ (state left
+ (onentry [mright startAtSpeed: speed]))
+ (state crossfl
+ (onexit [mright stop]))
+ (state right
+ (onentry [mleft startAtSpeed: speed]))
+ (state crossfr
+ (onexit [mleft stop]))
+ (on black right -> crossfr rlx)
+ (on black left -> crossfl lrx)
+ (on white crossfr -> left rl)
+ (on white crossfl -> right lr)
+ (event black [sensor read = 1])
+ (event white [(sensor read = 1) not])
+)
+(spawn linecross left)
+
+'
+
+ "Created: / 30-07-2015 / 17:41:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+rtimer
+^ ';;a resettable timer with 10 sec intervals
+(var minute := [0])
+(machine rtimer
+ (state zero)
+ (state ten)
+ (state twenty)
+ (state thirty)
+ (state fourty)
+ (state fifty
+ (onexit [minute := minute + 1]))
+ (ontime 10000 zero -> ten toten)
+ (ontime 10000 ten -> twenty totwenty)
+ (ontime 10000 twenty -> thirty tothirty)
+ (ontime 10000 thirty -> fourty tofourty)
+ (ontime 10000 fourty -> fifty tofifty)
+ (ontime 10000 fifty -> zero tozero)
+ (var doreset := [0])
+ (state init
+ (onentry [minute := 0.
+ doreset := 0]))
+ (on resetting *-> init reset)
+ (eps init -> zero go)
+ (event resetting [doreset = 1])
+)
+(spawn rtimer zero)
+'
+
+ "Created: / 30-07-2015 / 17:38:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+stairsclimber
+^ ';;; A stairs climber building using the MindStorm expansion set
+;;; Use the new JetStorm Bridge funcionality
+;;; Use ontime transition to estimate the second step of the climbing
+;;; Watch example in: http://youtu.be/6HXcKwMO8Fo
+
+(var backWheelsSpeed := [-50])
+(var frontWheelsSpeed := [-50])
+(var climbSpeed := [-50])
+(var startGyro := [0])
+(var deltaGyro := [4])
+(machine Stair
+ (state forward
+ (onentry [
+ robot motorA startAtSpeed: backWheelsSpeed.
+ robot motorB startAtSpeed: frontWheelsSpeed.
+ startGyro := robot sensor2 read.
+ ]
+ )
+ (onexit [
+ robot fullStop.
+ ]
+ )
+ )
+
+ (state climb
+ (onentry [
+ robot motorD startAtSpeed: climbSpeed.
+ robot motorB startAtSpeed: frontWheelsSpeed.
+ ]
+ )
+ (onexit [
+ robot fullStop.
+ ]
+ )
+ )
+
+ (state forward2
+ (onentry [
+ robot motorA startAtSpeed: backWheelsSpeed.
+ robot motorB startAtSpeed: frontWheelsSpeed.
+ ]
+ )
+ )
+
+ (state climb2
+ (onentry [
+ robot motorD startAtSpeed: climbSpeed negated.
+ ]
+ )
+ (onexit [
+ robot fullStop
+ ]
+ )
+ )
+
+ (state stop
+ (onentry [robot fullStop])
+ )
+
+ (on incline forward -> climb incline)
+ (on finishClimb climb -> forward2 finishClimb)
+ (event finishClimb [robot sensor3 read == 1])
+ (event incline [robot sensor2 read > (deltaGyro + startGyro)])
+
+ (ontime 3000 forward2 -> climb2 for2)
+ (ontime 6000 climb2 -> forward loop)
+)
+(spawn Stair forward)
+
+'
+
+ "Created: / 30-07-2015 / 17:42:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+stopwatch
+^ ';; A stopwatch.
+;; Inspect the variables start and reset,
+;; and from the inspectors change the values
+(machine stopwatch
+ (var start := [false])
+ (var reset := [false])
+ (var seconds := [0])
+ (state waiting )
+ (on e_starting waiting -> tick t_st)
+ (event e_starting [start])
+ (state tick)
+ (state tock (onexit [seconds := seconds + 1]))
+ (ontime 500 tick -> tock t_tito)
+ (ontime 500 tock -> tick t_toti)
+
+ (on e_reset *-> resetting t_reset)
+ (event e_reset [reset])
+ (state resetting
+ (onentry [reset := false. seconds := 0] ))
+ (eps resetting -> tick t_et)
+
+ (on e_stop *-> waiting t_es)
+ (event e_stop [start not])
+)
+(spawn stopwatch waiting)
+'
+
+ "Created: / 30-07-2015 / 17:38:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+timer
+^ ';; a timer with 10 sec intervals
+
+(var minute := [0])
+(machine timer
+ (state zero)
+ (state ten)
+ (state twenty)
+ (state thirty)
+ (state fourty)
+ (state fifty
+ (onexit [minute := minute + 1]))
+ (ontime 10000 zero -> ten toten)
+ (ontime 10000 ten -> twenty totwenty)
+ (ontime 10000 twenty -> thirty tothirty)
+ (ontime 10000 thirty -> fourty tofourty)
+ (ontime 10000 fourty -> fifty tofifty)
+ (ontime 10000 fifty -> zero tozero)
+)
+(spawn timer zero)
+
+'
+
+ "Created: / 30-07-2015 / 17:39:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCLRPSourcesResource class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPSpawn.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,48 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPNode subclass:#PPCLRPSpawn
+ instanceVariableNames:'machine state'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPSpawn class methodsFor:'instance creation'!
+
+machine: machineName state: stateName
+ |retval|
+ retval := self new.
+ retval machine: machineName.
+ retval state: stateName.
+ ^retval
+! !
+
+!PPCLRPSpawn methodsFor:'accessing'!
+
+machine
+ ^ machine
+!
+
+machine: anObject
+ machine := anObject
+!
+
+state
+ ^ state
+!
+
+state: anObject
+ state := anObject
+! !
+
+!PPCLRPSpawn methodsFor:'printing'!
+
+printOn: aStream
+ aStream nextPutAll: 'PPCLRPSpawn '.
+ aStream nextPutAll: machine asString.
+ aStream nextPutAll: ' : '.
+ aStream nextPutAll: state asString.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPState.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,73 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPContainedElement subclass:#PPCLRPState
+ instanceVariableNames:'name body nestedMachine startTime compareMachines'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPState class methodsFor:'instance creation'!
+
+name: aString body: anArray
+ |retval|
+ retval := self new.
+ retval name: aString.
+ retval body: anArray.
+ ^retval
+! !
+
+!PPCLRPState methodsFor:'accessing'!
+
+body
+ ^ body
+!
+
+body: anObject
+ body := anObject.
+ body do: [ :aBodyElement|
+ (aBodyElement isKindOf: PPCLRPContainedElement)
+ ifTrue: [aBodyElement container: self] ].
+!
+
+fullName
+ ^self container fullName, '/', self name
+!
+
+machines
+ ^self body select:[:item | item class = PPCLRPMachine]
+!
+
+name
+ ^ name
+!
+
+name: anObject
+ name := anObject
+! !
+
+!PPCLRPState methodsFor:'error handing'!
+
+onErrorNode: aBlock parser: aPPCLRPParser
+
+ ^body do:[:aNode| aNode onErrorNode: aBlock parser: aPPCLRPParser]
+! !
+
+!PPCLRPState methodsFor:'printing'!
+
+printOn: aStream
+ aStream nextPutAll: 'PPCLRPState '.
+ aStream nextPutAll: self name.
+ aStream nextPutAll: ' : '.
+ aStream nextPutAll: self body asString.
+
+! !
+
+!PPCLRPState methodsFor:'visiting'!
+
+acceptVisitor: aPPCLRPNodeVisitor
+ aPPCLRPNodeVisitor visitStateNode: self.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPTimeoutTransition.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,25 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPTransition subclass:#PPCLRPTimeoutTransition
+ instanceVariableNames:'maxTime'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPTimeoutTransition methodsFor:'printing'!
+
+printOn: aStream
+
+ aStream nextPutAll: 'PPCLRPTimeoutTransition '.
+ aStream nextPutAll: self name.
+ aStream nextPutAll: ' : '.
+ aStream nextPutAll: self from.
+ aStream nextPutAll: '->'.
+ aStream nextPutAll: self to.
+ aStream nextPutAll: ' on '.
+ aStream nextPutAll: self eventname asString.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPTransition.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,99 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPContainedElement subclass:#PPCLRPTransition
+ instanceVariableNames:'name from to eventname arrowRange keywordEnd'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPTransition class methodsFor:'instance creation'!
+
+on: anEvent from: startState to: endState name: aString
+ |retval|
+ retval := self new.
+ retval eventname: anEvent.
+ retval from: startState.
+ retval to: endState.
+ retval name: aString.
+ ^ retval.
+! !
+
+!PPCLRPTransition methodsFor:'accessing'!
+
+arrowRange
+ arrowRange ifNil: [ self halt: 'Error in setting up range info for styling' ].
+ ^ arrowRange
+!
+
+arrowRange: anObject
+ arrowRange := anObject
+!
+
+eventname
+ ^ eventname
+!
+
+eventname: anObject
+ eventname := anObject
+!
+
+from
+ ^ from
+!
+
+from: anObject
+ from := anObject
+!
+
+identifier
+ ^self className , self from , self to , self name.
+!
+
+keywordEnd
+ ^ keywordEnd
+!
+
+keywordEnd: anObject
+ keywordEnd := anObject
+!
+
+name
+ ^ name
+!
+
+name: anObject
+ name := anObject
+!
+
+to
+ ^ to
+!
+
+to: anObject
+ to := anObject
+! !
+
+!PPCLRPTransition methodsFor:'printing'!
+
+printOn: aStream
+
+ aStream nextPutAll: 'PPCLRPTransition '.
+ aStream nextPutAll: self name.
+ aStream nextPutAll: ' : '.
+ aStream nextPutAll: self from.
+ aStream nextPutAll: '->'.
+ aStream nextPutAll: self to.
+ aStream nextPutAll: ' on '.
+ aStream nextPutAll: self eventname.
+
+! !
+
+!PPCLRPTransition methodsFor:'visiting'!
+
+acceptVisitor: aPPCLRPNodeVisitor
+ aPPCLRPNodeVisitor visitTransitionNode: self.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPVariable.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,55 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPContainedElement subclass:#PPCLRPVariable
+ instanceVariableNames:'name value'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPVariable class methodsFor:'installation'!
+
+name: aString value: aValue
+ |retval|
+ retval := self new.
+ retval name: aString.
+ retval value: aValue.
+ ^retval
+! !
+
+!PPCLRPVariable methodsFor:'accessing'!
+
+name
+ ^ name
+!
+
+name: anObject
+ name := anObject
+!
+
+value
+ ^ value
+!
+
+value: anObject
+ value := anObject
+! !
+
+!PPCLRPVariable methodsFor:'printing'!
+
+printOn: aStream
+ aStream nextPutAll: 'PPCLRPVariable '.
+ aStream nextPutAll: self name.
+ aStream nextPutAll: ' : '.
+ aStream nextPutAll: self value asString.
+
+! !
+
+!PPCLRPVariable methodsFor:'visiting'!
+
+acceptVisitor: aPPCLRPNodeVisitor
+ aPPCLRPNodeVisitor visitVariableNode: self
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCLRPWildcardTransition.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,41 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCLRPTransition subclass:#PPCLRPWildcardTransition
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-LRP'
+!
+
+!PPCLRPWildcardTransition class methodsFor:'instance creation'!
+
+on: anEvent from: startState to: endState name: aString
+
+ self error: 'Wildcard transitions have no from state. Use on:to:name: instead.'
+!
+
+on: anEvent to: endState name: aString
+ |retval|
+ retval := self new.
+ retval eventname: anEvent.
+ retval from: '*'.
+ retval to: endState.
+ retval name: aString.
+ ^ retval.
+! !
+
+!PPCLRPWildcardTransition methodsFor:'printing'!
+
+printOn: aStream
+
+ aStream nextPutAll: 'PPCLRPWildcardTransition '.
+ aStream nextPutAll: self name.
+ aStream nextPutAll: ' : *->'.
+ aStream nextPutAll: self to.
+ aStream nextPutAll: ' on '.
+ aStream nextPutAll: self eventname.
+
+! !
+
--- a/compiler/tests/extras/PPCResources.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/extras/PPCResources.st Mon Aug 17 12:13:16 2015 +0100
@@ -124,6 +124,18 @@
]
! !
+!PPCResources methodsFor:'others'!
+
+idsOfSize: size
+ | stream |
+ stream := WriteStream on: (String new: size).
+
+ [stream size < size] whileTrue: [
+ stream nextPutAll: 'Lorem ipsum dolor sit amet consectetur adipiscing elit sed do eiusmod tempor incididunt ut labore et dolore magna aliqua Ut enim ad minim veniam quis nostrud exercitation ullamco'.
+ ].
+ ^ stream contents
+! !
+
!PPCResources methodsFor:'private utilities'!
files: files withExtension: extension
@@ -176,6 +188,10 @@
^ self smalltalkInDirectory: '../smalltalk-src/'
!
+smalltalkSourcesMedium
+ ^ (self smalltalkInDirectory: '../smalltalk-src/') copyFrom: 1 to: 10*1000.
+!
+
smalltalkSourcesSmall
^ (self smalltalkInDirectory: '../smalltalk-src/') copyFrom: 1 to: 1000.
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCSetUpBeforeTearDownAfterResource.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,125 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestResource subclass:#PPCSetUpBeforeTearDownAfterResource
+ instanceVariableNames:''
+ classVariableNames:'CachedResources'
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Support'
+!
+
+PPCSetUpBeforeTearDownAfterResource class instanceVariableNames:'testCaseClass'
+
+"
+ The following class instance variables are inherited by this class:
+
+ TestResource - current
+ TestAsserter -
+ Object -
+"
+!
+
+!PPCSetUpBeforeTearDownAfterResource class methodsFor:'initialization'!
+
+initialize
+ "Invoked at system start or when the class is dynamically loaded."
+
+ CachedResources := Dictionary new
+
+ "Modified: / 30-07-2015 / 07:47:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCSetUpBeforeTearDownAfterResource class methodsFor:'accessing'!
+
+testCaseClass
+ ^ testCaseClass
+
+ "Created: / 29-07-2015 / 16:19:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testCaseClass: aClass
+ testCaseClass := aClass
+
+ "Created: / 29-07-2015 / 16:19:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCSetUpBeforeTearDownAfterResource class methodsFor:'queries'!
+
+isAbstract
+ "Return if this class is an abstract class.
+ True is returned here for myself only; false for subclasses.
+ Abstract subclasses must redefine again."
+
+ ^ self == PPCSetUpBeforeTearDownAfterResource.
+! !
+
+!PPCSetUpBeforeTearDownAfterResource class methodsFor:'running'!
+
+availableFor: aTestAsserter
+ aTestAsserter
+ assert: self isAvailable
+ description: 'Unavailable resource ', PPCSetUpBeforeTearDownAfterResource name ,' for: ', testCaseClass name , ' requested by ', aTestAsserter printString.
+
+ "Created: / 29-07-2015 / 16:42:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCSetUpBeforeTearDownAfterResource class methodsFor:'subclass creation'!
+
+for: aClass
+ ^ CachedResources at: aClass ifAbsentPut:[
+ | resourceMeta resourceClass |
+
+ ((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifTrue:[
+ resourceMeta := Metaclass new.
+ resourceMeta setSuperclass: self class.
+ resourceMeta instSize: self class instSize.
+ resourceClass := resourceMeta new.
+ resourceClass setSuperclass: self.
+ resourceClass instSize: self instSize.
+ ] ifFalse:[
+ " Assumes Pharo 5.0"
+ resourceMeta := Metaclass new.
+ resourceMeta
+ superclass: self class
+ withLayoutType: FixedLayout
+ slots: #().
+ resourceClass := resourceMeta new.
+ resourceClass superclass: self
+ withLayoutType: FixedLayout
+ slots: #().
+ ].
+ resourceClass testCaseClass: aClass.
+ resourceClass
+ ]
+
+ "Created: / 29-07-2015 / 16:17:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 30-07-2015 / 07:48:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCSetUpBeforeTearDownAfterResource methodsFor:'setup & teardown'!
+
+setUp
+ | testCaseClass |
+
+ testCaseClass := self class testCaseClass.
+ (testCaseClass lookupSelector: #setUpBefore) notNil ifTrue:[
+ testCaseClass new setUpBefore.
+ ].
+
+ "Created: / 29-07-2015 / 16:33:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+tearDown
+ | testCaseClass |
+
+ testCaseClass := self class testCaseClass.
+ (testCaseClass lookupSelector: #tearDownAfter) notNil ifTrue:[
+ testCaseClass new tearDownAfter
+ ].
+
+ "Created: / 29-07-2015 / 16:33:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+
+PPCSetUpBeforeTearDownAfterResource initialize!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCSmalltalkGrammarTests.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,115 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPSmalltalkGrammarTests subclass:#PPCSmalltalkGrammarTests
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+!PPCSmalltalkGrammarTests class methodsFor:'resources'!
+
+resources
+ ^ Array with: (PPCSetUpBeforeTearDownAfterResource for: self)
+! !
+
+!PPCSmalltalkGrammarTests class methodsFor:'testing'!
+
+isAbstract
+ ^ self == PPCSmalltalkGrammarTests
+! !
+
+!PPCSmalltalkGrammarTests methodsFor:'accessing'!
+
+compiledParser
+ ^ self compiledParserClass new
+
+ "Created: / 29-07-2015 / 17:00:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compiledParserClass
+ ^ Smalltalk at: self compiledParserClassName
+
+ "Created: / 29-07-2015 / 16:54:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compiledParserClassName
+ "Return the name of the compiled parser"
+
+ ^ (self petitParserClass name , 'C_' ,
+ "This is bit hacky!!"
+ ((self compilerConfiguration isKindOf: PPCTokenizingConfiguration) ifTrue:[ 'Tokenizing' ] ifFalse:[ 'Universal' ])) asSymbol
+
+ "Created: / 29-07-2015 / 16:54:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compiledScannerClassName
+ "Return the name of the compiled parser"
+
+ ^ (self petitParserClass name , 'C_Scanner') asSymbol
+!
+
+compilerConfiguration
+ "Return configuration to use when compiling parser (as instance of PPCConfiguration)"
+
+ ^ self subclassResponsibility
+
+ "Created: / 29-07-2015 / 16:53:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parserClass
+ ^ self compiledParserClass
+
+ "Modified: / 29-07-2015 / 18:43:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parserInstanceFor: aSymbol
+ ^ self parserClass new startSymbol: aSymbol
+
+ "Modified: / 29-07-2015 / 18:43:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+petitParser
+ ^ self petitParserClass new
+
+ "Created: / 29-07-2015 / 17:01:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+petitParserClass
+ ^ PPSmalltalkGrammar
+! !
+
+!PPCSmalltalkGrammarTests methodsFor:'context'!
+
+context
+
+ ^ PPCContext new
+! !
+
+!PPCSmalltalkGrammarTests methodsFor:'setup & teardown'!
+
+setUpBefore
+ "Called before any of my tests is run (when resources are set up)"
+ | time configuration |
+
+ configuration := self compilerConfiguration.
+ configuration arguments parserName: self compiledParserClassName.
+ configuration arguments scannerName: self compiledScannerClassName.
+
+ time := Time millisecondsToRun: [
+ self petitParser compileWithConfiguration: configuration.
+ ].
+ Transcript show: self petitParserClass name ; show:' compiled in: '; show: time asString; show: 'ms'; cr.
+
+ "Created: / 29-07-2015 / 16:29:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 29-07-2015 / 18:40:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+tearDownAfter
+ "Called after all my tests are ryn(when resources are torn down)"
+
+ "Created: / 29-07-2015 / 16:33:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCSmalltalkGrammarTests_Tokenized.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,17 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCSmalltalkGrammarTests subclass:#PPCSmalltalkGrammarTests_Tokenized
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+!PPCSmalltalkGrammarTests_Tokenized methodsFor:'accessing'!
+
+compilerConfiguration
+ ^ PPCConfiguration tokenizing
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCSmalltalkGrammarTests_Universal.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,17 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCSmalltalkGrammarTests subclass:#PPCSmalltalkGrammarTests_Universal
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+!PPCSmalltalkGrammarTests_Universal methodsFor:'accessing'!
+
+compilerConfiguration
+ ^ PPCConfiguration universal
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCSmalltalkGrammarVerificationTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,93 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCAbstractParserTest subclass:#PPCSmalltalkGrammarVerificationTest
+ instanceVariableNames:'parser result context resource fileResources'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+!PPCSmalltalkGrammarVerificationTest class methodsFor:'as yet unclassified'!
+
+resources
+ ^ (OrderedCollection with: PPCResources)
+ addAll: super resources;
+ yourself
+! !
+
+!PPCSmalltalkGrammarVerificationTest class methodsFor:'queries'!
+
+isAbstract
+ "Return if this class is an abstract class.
+ True is returned here for myself only; false for subclasses.
+ Abstract subclasses must redefine again."
+
+ ^ self == PPCSmalltalkGrammarVerificationTest.
+! !
+
+!PPCSmalltalkGrammarVerificationTest methodsFor:'accessing'!
+
+petitParserClass
+ "Return the name of the petit parser to compile"
+
+ ^ PPSmalltalkGrammar
+
+ "Created: / 29-07-2015 / 19:52:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCSmalltalkGrammarVerificationTest methodsFor:'setup'!
+
+setUp
+ super setUp.
+ fileResources := (self resources detect: [:e | e = PPCResources ]) current.
+!
+
+tearDown
+ super tearDown.
+ "
+ self compiledSmalltalkGrammarClass isNil ifFalse:[
+ self compiledSmalltalkGrammarClass removeFromSystem
+ ].
+ "
+! !
+
+!PPCSmalltalkGrammarVerificationTest methodsFor:'tests'!
+
+testSmalltalk
+ | compiledParser normalParser expected actual |
+ normalParser := self petitParser.
+ compiledParser := self compiledParser.
+
+ fileResources smalltalkSourcesBig do: [ :source |
+ expected := normalParser parse: source.
+ expected isPetitFailure ifFalse: [
+ actual := (compiledParser parse: source withContext: self context).
+ self assert: expected equals: actual.
+ ]
+ ].
+!
+
+testSmalltalkClass
+ | compiledParser normalParser |
+ normalParser := self petitParser.
+ compiledParser := self compiledParser.
+
+ fileResources smalltalkClassMethods do: [ :source |
+ self assert: (normalParser parse: source)
+ equals: (compiledParser parse: source withContext: self context).
+ ].
+!
+
+testSmalltalkObject
+ | compiledParser normalParser |
+ normalParser := self petitParser.
+ compiledParser := self compiledParser.
+
+ fileResources smalltalkObjectMethods do: [ :source |
+ self assert: (normalParser parse: source)
+ equals: (compiledParser parse: source withContext: self context).
+ ].
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCSmalltalkGrammarVerificationTest_Tokenized.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,21 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCSmalltalkGrammarVerificationTest subclass:#PPCSmalltalkGrammarVerificationTest_Tokenized
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+!PPCSmalltalkGrammarVerificationTest_Tokenized methodsFor:'accessing'!
+
+compilerConfiguration
+ "Return configuration to use when compiling parser (as instance of PPCConfiguration)"
+
+ ^ PPCConfiguration tokenizing
+
+ "Created: / 29-07-2015 / 19:54:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCSmalltalkGrammarVerificationTest_Universal.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,21 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCSmalltalkGrammarVerificationTest subclass:#PPCSmalltalkGrammarVerificationTest_Universal
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+!PPCSmalltalkGrammarVerificationTest_Universal methodsFor:'accessing'!
+
+compilerConfiguration
+ "Return configuration to use when compiling parser (as instance of PPCConfiguration)"
+
+ ^ PPCConfiguration universal
+
+ "Created: / 29-07-2015 / 19:54:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCSmalltalkParserTests.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,107 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPSmalltalkParserTests subclass:#PPCSmalltalkParserTests
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+!PPCSmalltalkParserTests class methodsFor:'resources'!
+
+resources
+ ^ Array with: (PPCSetUpBeforeTearDownAfterResource for: self)
+! !
+
+!PPCSmalltalkParserTests class methodsFor:'testing'!
+
+isAbstract
+ ^ self == PPCSmalltalkParserTests
+! !
+
+!PPCSmalltalkParserTests methodsFor:'accessing'!
+
+compiledParser
+ ^ self compiledParserClass new
+
+ "Created: / 29-07-2015 / 17:00:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compiledParserClass
+ ^ Smalltalk at: self compiledParserClassName
+
+ "Created: / 29-07-2015 / 16:54:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compiledParserClassName
+ "Return the name of the compiled parser"
+
+ ^ (self petitParserClass name , 'C_' ,
+ "This is bit hacky!!"
+ ((self compilerConfiguration isKindOf: PPCTokenizingConfiguration) ifTrue:[ 'Tokenizing' ] ifFalse:[ 'Universal' ])) asSymbol
+
+ "Created: / 29-07-2015 / 16:54:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compilerConfiguration
+ "Return configuration to use when compiling parser (as instance of PPCConfiguration)"
+
+ ^ self subclassResponsibility
+
+ "Created: / 29-07-2015 / 16:53:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parserClass
+ ^ self compiledParserClass
+
+ "Modified: / 29-07-2015 / 18:43:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parserInstanceFor: aSymbol
+ ^ self parserClass new startSymbol: aSymbol
+
+ "Modified: / 29-07-2015 / 18:43:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+petitParser
+ ^ self petitParserClass new
+
+ "Created: / 29-07-2015 / 17:01:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+petitParserClass
+ ^ PPSmalltalkParser
+! !
+
+!PPCSmalltalkParserTests methodsFor:'context'!
+
+context
+
+ ^ PPCContext new
+! !
+
+!PPCSmalltalkParserTests methodsFor:'setup & teardown'!
+
+setUpBefore
+ "Called before any of my tests is run (when resources are set up)"
+ | time configuration |
+
+ configuration := self compilerConfiguration.
+ configuration arguments parserName: self compiledParserClassName.
+ time := Time millisecondsToRun: [
+ self petitParser compileWithConfiguration: configuration.
+ ].
+ Transcript show: self petitParserClass name ; show:' compiled in: '; show: time asString; show: 'ms'; cr.
+
+ "Created: / 29-07-2015 / 16:29:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 29-07-2015 / 18:40:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+tearDownAfter
+ "Called after all my tests are ryn(when resources are torn down)"
+
+ "Created: / 29-07-2015 / 16:33:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCSmalltalkParserTests_Tokenized.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,17 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCSmalltalkParserTests subclass:#PPCSmalltalkParserTests_Tokenized
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+!PPCSmalltalkParserTests_Tokenized methodsFor:'accessing'!
+
+compilerConfiguration
+ ^ PPCConfiguration tokenizing
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCSmalltalkParserTests_Universal.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,17 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCSmalltalkParserTests subclass:#PPCSmalltalkParserTests_Universal
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+!PPCSmalltalkParserTests_Universal methodsFor:'accessing'!
+
+compilerConfiguration
+ ^ PPCConfiguration universal
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCSmalltalkParserVerificationTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,93 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCAbstractParserTest subclass:#PPCSmalltalkParserVerificationTest
+ instanceVariableNames:'parser result context resource fileResources'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+!PPCSmalltalkParserVerificationTest class methodsFor:'as yet unclassified'!
+
+resources
+ ^ (OrderedCollection with: PPCResources)
+ addAll: super resources;
+ yourself
+! !
+
+!PPCSmalltalkParserVerificationTest class methodsFor:'queries'!
+
+isAbstract
+ "Return if this class is an abstract class.
+ True is returned here for myself only; false for subclasses.
+ Abstract subclasses must redefine again."
+
+ ^ self == PPCSmalltalkParserVerificationTest.
+! !
+
+!PPCSmalltalkParserVerificationTest methodsFor:'accessing'!
+
+petitParserClass
+ "Return the name of the petit parser to compile"
+
+ ^ PPSmalltalkGrammar
+
+ "Created: / 29-07-2015 / 19:52:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCSmalltalkParserVerificationTest methodsFor:'setup'!
+
+setUp
+ super setUp.
+ fileResources := (self resources detect: [:e | e = PPCResources ]) current.
+!
+
+tearDown
+ super tearDown.
+ "
+ self compiledSmalltalkGrammarClass isNil ifFalse:[
+ self compiledSmalltalkGrammarClass removeFromSystem
+ ].
+ "
+! !
+
+!PPCSmalltalkParserVerificationTest methodsFor:'tests'!
+
+testSmalltalk
+ | compiledParser normalParser expected actual |
+ normalParser := self petitParser.
+ compiledParser := self compiledParser.
+
+ fileResources smalltalkSourcesBig do: [ :source |
+ expected := normalParser parse: source.
+ expected isPetitFailure ifFalse: [
+ actual := (compiledParser parse: source withContext: self context).
+ self assert: expected equals: actual.
+ ]
+ ].
+!
+
+testSmalltalkClass
+ | compiledParser normalParser |
+ normalParser := self petitParser.
+ compiledParser := self compiledParser.
+
+ fileResources smalltalkClassMethods do: [ :source |
+ self assert: (normalParser parse: source)
+ equals: (compiledParser parse: source withContext: self context).
+ ].
+!
+
+testSmalltalkObject
+ | compiledParser normalParser |
+ normalParser := self petitParser.
+ compiledParser := self compiledParser.
+
+ fileResources smalltalkObjectMethods do: [ :source |
+ self assert: (normalParser parse: source)
+ equals: (compiledParser parse: source withContext: self context).
+ ].
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCSmalltalkParserVerificationTest_Tokenized.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,21 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCSmalltalkParserVerificationTest subclass:#PPCSmalltalkParserVerificationTest_Tokenized
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+!PPCSmalltalkParserVerificationTest_Tokenized methodsFor:'accessing'!
+
+compilerConfiguration
+ "Return configuration to use when compiling parser (as instance of PPCConfiguration)"
+
+ ^ PPCConfiguration tokenizing
+
+ "Created: / 29-07-2015 / 19:54:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCSmalltalkParserVerificationTest_Universal.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,21 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCSmalltalkParserVerificationTest subclass:#PPCSmalltalkParserVerificationTest_Universal
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+!PPCSmalltalkParserVerificationTest_Universal methodsFor:'accessing'!
+
+compilerConfiguration
+ "Return configuration to use when compiling parser (as instance of PPCConfiguration)"
+
+ ^ PPCConfiguration universal
+
+ "Created: / 29-07-2015 / 19:54:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- a/compiler/tests/extras/PPCSmalltalkTests.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/extras/PPCSmalltalkTests.st Mon Aug 17 12:13:16 2015 +0100
@@ -11,6 +11,16 @@
!PPCSmalltalkTests methodsFor:'as yet unclassified'!
+configuration
+ arguments := PPCArguments default
+ profile: true;
+ yourself.
+
+ ^ PPCTokenizingConfiguration new
+ arguments: arguments;
+ yourself.
+!
+
setUp
arguments := PPCArguments default
profile: true;
@@ -22,13 +32,12 @@
!
testSmalltakToken
- | token1 token2 |
- arguments generate: false.
+ | token1 |
+ configuration := self configuration.
token1 := 'a' asParser smalltalkToken compileWithConfiguration: configuration.
- token2 := 'b' asParser smalltalkToken compileWithConfiguration: configuration.
- self assert: token1 tokenizer children first tokenClass = PPSmalltalkToken.
- self assert: token1 tokenizer children first whitespace = token1 tokenizer children first whitespace.
+ self assert: ((token1 parse: 'a') class == PPSmalltalkToken).
+ self assert: (token1 parse: '"comment" a "another comment"') inputValue = 'a'
!
testSmalltakWhitespace
@@ -37,8 +46,10 @@
ws2 := PPSmalltalkWhitespaceParser new.
self assert: ws1 = ws2.
- self assert: (ws1 == ws2) not.
+ self assert: ws1 ~~ ws2.
self assert: ws1 hash = ws2 hash.
+
+ "Modified: / 30-07-2015 / 06:56:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
--- a/compiler/tests/extras/PPCSmalltalkVerificationTest.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,91 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPAbstractParserTest subclass:#PPCSmalltalkVerificationTest
- instanceVariableNames:'parser result context resource fileResources'
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Extras-Tests-Smalltalk'
-!
-
-!PPCSmalltalkVerificationTest class methodsFor:'as yet unclassified'!
-
-isAbstract
- ^ self name = #PPCSmalltalkVerificationTest
-!
-
-resources
- ^ (OrderedCollection with: PPCResources)
- addAll: super resources;
- yourself
-! !
-
-!PPCSmalltalkVerificationTest methodsFor:'accessing'!
-
-compiledSmalltalkGrammar
- ^ self compiledSmalltalkGrammarClass new
-!
-
-compiledSmalltalkGrammarClass
- self subclassResponsibility
-!
-
-smalltalkGrammar
- ^ PPSmalltalkGrammar new
-! !
-
-!PPCSmalltalkVerificationTest methodsFor:'setup'!
-
-setUp
- super setUp.
- fileResources := (self resources detect: [:e | e = PPCResources ]) current.
-!
-
-tearDown
- super tearDown.
- "
- self compiledSmalltalkGrammarClass isNil ifFalse:[
- self compiledSmalltalkGrammarClass removeFromSystem
- ].
- "
-! !
-
-!PPCSmalltalkVerificationTest methodsFor:'tests'!
-
-testSmalltalk
- | compiledParser normalParser expected actual |
- normalParser := self smalltalkGrammar.
- compiledParser := self compiledSmalltalkGrammar.
-
- fileResources smalltalkSourcesBig do: [ :source |
- expected := normalParser parse: source.
- expected isPetitFailure ifFalse: [
- actual := (compiledParser parse: source withContext: self context).
- self assert: expected equals: actual.
- ]
- ].
-!
-
-testSmalltalkClass
- | compiledParser normalParser |
- normalParser := self smalltalkGrammar.
- compiledParser := self compiledSmalltalkGrammar.
-
- fileResources smalltalkClassMethods do: [ :source |
- self assert: (normalParser parse: source)
- equals: (compiledParser parse: source withContext: self context).
- ].
-!
-
-testSmalltalkObject
- | compiledParser normalParser |
- normalParser := self smalltalkGrammar.
- compiledParser := self compiledSmalltalkGrammar.
-
- fileResources smalltalkObjectMethods do: [ :source |
- self assert: (normalParser parse: source)
- equals: (compiledParser parse: source withContext: self context).
- ].
-! !
-
--- a/compiler/tests/extras/PPCompiledExpressionGrammarResource.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,26 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
-
-"{ NameSpace: Smalltalk }"
-
-TestResource subclass:#PPCompiledExpressionGrammarResource
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Extras-Tests-Expressions'
-!
-
-!PPCompiledExpressionGrammarResource methodsFor:'as yet unclassified'!
-
-setUp
- | time configuration |
- configuration := PPCConfiguration universal.
- configuration arguments parserName: #PPCompiledExpressionGrammar.
-
-
- time := Time millisecondsToRun: [
- PPExpressionGrammar new compileWithConfiguration: configuration.
- ].
- Transcript show: 'Expression grammar compiled in: ', time asString, 'ms'; cr.
-
-! !
-
--- a/compiler/tests/extras/PPCompiledExpressionGrammarTest.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,124 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCompositeParserTest subclass:#PPCompiledExpressionGrammarTest
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Extras-Tests-Expressions'
-!
-
-!PPCompiledExpressionGrammarTest class methodsFor:'as yet unclassified'!
-
-resources
- ^ (OrderedCollection with: PPCompiledExpressionGrammarResource)
- addAll: super resources;
- yourself
-! !
-
-!PPCompiledExpressionGrammarTest methodsFor:'as yet unclassified'!
-
-compilerArguments
- ^ PPCArguments default
- profile: true;
- ll: true;
- yourself
-!
-
-context
-
- ^ PPCContext new
-!
-
-parserClass
- ^ Smalltalk at: #PPCompiledExpressionGrammar
-!
-
-parserInstanceFor: aSymbol
- ^ (Smalltalk at: #PPCompiledExpressionGrammar) new startSymbol: aSymbol
-!
-
-testAdd
- result := self parse: '1+2' rule: #add.
- self assert: result isArray.
- self assert: result first = 1.
- self assert: result second inputValue = '+'.
- self assert: result third = 2.
-!
-
-testMul
- result := self parse: '1 * 2' rule: #mul.
- self assert: result isArray.
- self assert: result first = 1.
- self assert: result second inputValue = '*'.
- self assert: result third = 2.
-!
-
-testNumber
- result := self parse: '1' rule: #number.
- self assert: result = 1.
-!
-
-testParens
- result := self parse: '(1)' rule: #parens.
- self assert: result size = 3.
- self assert: result first inputValue = '('.
- self assert: result second = 1.
- self assert: result third inputValue = ')'.
-
-!
-
-testPrim
- result := self parse: '1' rule: #prim.
- self assert: result = 1.
-!
-
-testPrim2
- result := self parse: '(1)' rule: #prim.
- self assert: result size = 3.
- self assert: result second = 1.
-!
-
-testProd
- result := self parse: '1' rule: #prod.
- self assert: result = 1.
-!
-
-testTerm
- result := self parse: '1' rule: #term.
- self assert: result = 1.
-
-!
-
-testTerm11
- result := self parse: '1 + 2' rule: #term.
- self assert: result size = 3.
- self assert: result first = 1.
- self assert: result second inputValue = '+'.
- self assert: result third = 2.
-
-!
-
-testTerm12
- result := self parse: '1 + 2 * 3' rule: #term.
- self assert: result size = 3.
- self assert: result second inputValue = '+'.
- self assert: result first = 1.
- self assert: result third isArray.
- self assert: result third first = 2.
- self assert: result third second inputValue = '*'.
- self assert: result third third = 3.
-!
-
-testTerm13
- result := self parse: '1 * 2 + 3' rule: #term.
- self assert: result size = 3.
- self assert: result first isArray.
- self assert: result first first = 1.
- self assert: result first second inputValue = '*'.
- self assert: result first third = 2.
- self assert: result second inputValue = '+'.
- self assert: result third = 3.
-! !
-
--- a/compiler/tests/extras/PPCompiledExpressionsVerificationTest.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,35 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCExpressionsVerificationTest subclass:#PPCompiledExpressionsVerificationTest
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Extras-Tests-Expressions'
-!
-
-!PPCompiledExpressionsVerificationTest class methodsFor:'as yet unclassified'!
-
-resources
- ^ (OrderedCollection with: PPCompiledExpressionGrammarResource)
- addAll: super resources;
- yourself
-! !
-
-!PPCompiledExpressionsVerificationTest methodsFor:'as yet unclassified'!
-
-compiledGrammarClass
- ^ (Smalltalk at: #PPCompiledExpressionGrammar)
-! !
-
-!PPCompiledExpressionsVerificationTest methodsFor:'testing'!
-
-testExpressions
- ^ super testExpressions
-!
-
-testSanity
- ^ super testSanity
-! !
-
--- a/compiler/tests/extras/PPCompiledSmalltalkGrammarResource.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,26 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
-
-"{ NameSpace: Smalltalk }"
-
-TestResource subclass:#PPCompiledSmalltalkGrammarResource
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Extras-Tests-Smalltalk'
-!
-
-!PPCompiledSmalltalkGrammarResource methodsFor:'as yet unclassified'!
-
-setUp
- | time configuration |
- configuration := PPCConfiguration universal.
- configuration arguments parserName:#PPCompiledSmalltalkGrammar.
-
- time := Time millisecondsToRun: [
- PPSmalltalkGrammar new compileWithConfiguration: configuration.
- ].
- Transcript show: 'Smalltalk Grammar compiled in: '; show: time asString; show: 'ms'; cr.
-
- "Modified: / 10-05-2015 / 07:57:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
--- a/compiler/tests/extras/PPCompiledSmalltalkGrammarTests.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,930 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCompositeParserTest subclass:#PPCompiledSmalltalkGrammarTests
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Extras-Tests-Smalltalk'
-!
-
-
-!PPCompiledSmalltalkGrammarTests class methodsFor:'accessing'!
-
-resources
- ^ (OrderedCollection with: PPCompiledSmalltalkGrammarResource)
- addAll: super resources;
- yourself
-! !
-
-!PPCompiledSmalltalkGrammarTests methodsFor:'accessing'!
-
-context
- ^ PPCContext new
-!
-
-parserClass
- ^ Smalltalk at: #PPCompiledSmalltalkGrammar
-!
-
-parserInstanceFor: aSymbol
- ^ (Smalltalk at: #PPCompiledSmalltalkGrammar) new startSymbol: aSymbol
-! !
-
-!PPCompiledSmalltalkGrammarTests 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
-!
-
-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 ]
-! !
-
-!PPCompiledSmalltalkGrammarTests 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
-! !
-
-!PPCompiledSmalltalkGrammarTests 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
-! !
-
-!PPCompiledSmalltalkGrammarTests 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
-! !
-
-!PPCompiledSmalltalkGrammarTests methodsFor:'testing-pragmas'!
-
-testPragma1
- self
- parse: 'method <foo>'
- rule: #method
-!
-
-testPragma10
- self
- parse: 'method <foo: bar>'
- rule: #method
-!
-
-testPragma11
- self
- parse: 'method <foo: true>'
- rule: #method
-!
-
-testPragma12
- self
- parse: 'method <foo: false>'
- rule: #method
-!
-
-testPragma13
- self
- parse: 'method <foo: nil>'
- rule: #method
-!
-
-testPragma14
- self
- parse: 'method <foo: ()>'
- rule: #method
-!
-
-testPragma15
- self
- parse: 'method <foo: #()>'
- rule: #method
-!
-
-testPragma16
- self
- parse: 'method < + 1 >'
- rule: #method
-!
-
-testPragma2
- self
- parse: 'method <foo> <bar>'
- rule: #method
-!
-
-testPragma3
- self
- parse: 'method | a | <foo>'
- rule: #method
-!
-
-testPragma4
- self
- parse: 'method <foo> | a |'
- rule: #method
-!
-
-testPragma5
- self
- parse: 'method <foo> | a | <bar>'
- rule: #method
-!
-
-testPragma6
- self
- parse: 'method <foo: 1>'
- rule: #method
-!
-
-testPragma7
- self
- parse: 'method <foo: 1.2>'
- rule: #method
-!
-
-testPragma8
- self
- parse: 'method <foo: ''bar''>'
- rule: #method
-!
-
-testPragma9
- self
- parse: 'method <foo: #''bar''>'
- rule: #method
-! !
-
-!PPCompiledSmalltalkGrammarTests class methodsFor:'documentation'!
-
-version_HG
-
- ^ '$Changeset: <not expanded> $'
-! !
-
--- a/compiler/tests/extras/PPCompiledSmalltalkParserResource.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,26 +0,0 @@
-"{ 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 <jan.vrany@fit.cvut.cz>"
-! !
-
--- a/compiler/tests/extras/PPCompiledSmalltalkParserTests.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,39 +0,0 @@
-"{ 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
-! !
-
--- a/compiler/tests/extras/PPCompiledSmalltalkVerificationTest.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,39 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCSmalltalkVerificationTest subclass:#PPCompiledSmalltalkVerificationTest
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Extras-Tests-Smalltalk'
-!
-
-!PPCompiledSmalltalkVerificationTest class methodsFor:'as yet unclassified'!
-
-resources
- ^ (OrderedCollection with: PPCompiledSmalltalkGrammarResource)
- addAll: super resources;
- yourself
-! !
-
-!PPCompiledSmalltalkVerificationTest methodsFor:'accessing'!
-
-compiledSmalltalkGrammarClass
- ^ (Smalltalk at: #PPCompiledSmalltalkGrammar)
-! !
-
-!PPCompiledSmalltalkVerificationTest methodsFor:'tests'!
-
-testSmalltalk
- super testSmalltalk
-!
-
-testSmalltalkClass
- super testSmalltalkClass
-!
-
-testSmalltalkObject
- super testSmalltalkObject
-! !
-
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPExpressionGrammarVerificationTest_Tokenized.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,21 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCExpressionGrammarVerificationTest subclass:#PPExpressionGrammarVerificationTest_Tokenized
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Expressions'
+!
+
+!PPExpressionGrammarVerificationTest_Tokenized methodsFor:'accessing'!
+
+compilerConfiguration
+ "Return configuration to use when compiling parser (as instance of PPCConfiguration)"
+
+ ^ PPCConfiguration tokenizing
+
+ "Modified: / 29-07-2015 / 17:07:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPExpressionGrammarVerificationTest_Universal.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,21 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCExpressionGrammarVerificationTest subclass:#PPExpressionGrammarVerificationTest_Universal
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Expressions'
+!
+
+!PPExpressionGrammarVerificationTest_Universal methodsFor:'accessing'!
+
+compilerConfiguration
+ "Return configuration to use when compiling parser (as instance of PPCConfiguration)"
+
+ ^PPCConfiguration universal
+
+ "Modified: / 29-07-2015 / 17:06:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- a/compiler/tests/extras/PPLL1ExpressionGrammar.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/extras/PPLL1ExpressionGrammar.st Mon Aug 17 12:13:16 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 <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 26-05-2015 / 07:23:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
addPrime
@@ -30,12 +30,12 @@
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 <jan.vrany@fit.cvut.cz>"
!
--- a/compiler/tests/extras/PPLL1ExpressionGrammarTest.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/extras/PPLL1ExpressionGrammarTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -16,7 +16,7 @@
!
testAdd
- result := self parse: '1+2' rule: #add.
+ result := self parse: '1+2' rule: #term.
self assert: result isArray.
self assert: result first = 1.
self assert: result second inputValue = '+'.
--- a/compiler/tests/extras/PPTokenizedExpressionGrammarResource.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,35 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
-
-"{ NameSpace: Smalltalk }"
-
-TestResource subclass:#PPTokenizedExpressionGrammarResource
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Extras-Tests-Expressions'
-!
-
-
-!PPTokenizedExpressionGrammarResource methodsFor:'as yet unclassified'!
-
-setUp
- | time configuration |
- configuration := PPCTokenizingConfiguration new.
- configuration arguments parserName:#PPTokenizedExpressionGrammar.
-
-
- time := Time millisecondsToRun: [
- PPExpressionGrammar new compileWithConfiguration: configuration.
- ].
- Transcript show: 'Expression grammar tokenized in: '; show: time asString; show: 'ms'; cr.
-
- "Modified: / 26-05-2015 / 07:25:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
-!PPTokenizedExpressionGrammarResource class methodsFor:'documentation'!
-
-version_HG
-
- ^ '$Changeset: <not expanded> $'
-! !
-
--- a/compiler/tests/extras/PPTokenizedExpressionGrammarTest.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,122 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCompositeParserTest subclass:#PPTokenizedExpressionGrammarTest
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Extras-Tests-Expressions'
-!
-
-!PPTokenizedExpressionGrammarTest class methodsFor:'as yet unclassified'!
-
-resources
- ^ (OrderedCollection with: PPTokenizedExpressionGrammarResource)
- addAll: super resources;
- yourself
-! !
-
-!PPTokenizedExpressionGrammarTest methodsFor:'as yet unclassified'!
-
-compilerArguments
- ^ PPCArguments default
- profile: true;
- yourself
-!
-
-context
- ^ PPCContext new
-!
-
-parserClass
- ^ Smalltalk at: #PPTokenizedExpressionGrammar
-!
-
-parserInstanceFor: aSymbol
- ^ (Smalltalk at: #PPTokenizedExpressionGrammar) new startSymbol: aSymbol
-!
-
-testAdd
- result := self parse: '1+2' rule: #add.
- self assert: result isArray.
- self assert: result first = 1.
- self assert: result second inputValue = '+'.
- self assert: result third = 2.
-!
-
-testMul
- result := self parse: '1 * 2' rule: #mul.
- self assert: result isArray.
- self assert: result first = 1.
- self assert: result second inputValue = '*'.
- self assert: result third = 2.
-!
-
-testNumber
- result := self parse: '1' rule: #number.
- self assert: result = 1.
-!
-
-testParens
- result := self parse: '(1)' rule: #parens.
- self assert: result size = 3.
- self assert: result first inputValue = '('.
- self assert: result second = 1.
- self assert: result third inputValue = ')'.
-
-!
-
-testPrim
- result := self parse: '1' rule: #prim.
- self assert: result = 1.
-!
-
-testPrim2
- result := self parse: '(1)' rule: #prim.
- self assert: result size = 3.
- self assert: result second = 1.
-!
-
-testProd
- result := self parse: '1' rule: #prod.
- self assert: result = 1.
-!
-
-testTerm
- result := self parse: '1' rule: #term.
- self assert: result = 1.
-
-!
-
-testTerm11
- result := self parse: '1 + 2' rule: #term.
- self assert: result size = 3.
- self assert: result first = 1.
- self assert: result second inputValue = '+'.
- self assert: result third = 2.
-
-!
-
-testTerm12
- result := self parse: '1 + 2 * 3' rule: #term.
- self assert: result size = 3.
- self assert: result second inputValue = '+'.
- self assert: result first = 1.
- self assert: result third isArray.
- self assert: result third first = 2.
- self assert: result third second inputValue = '*'.
- self assert: result third third = 3.
-!
-
-testTerm13
- result := self parse: '1 * 2 + 3' rule: #term.
- self assert: result size = 3.
- self assert: result first isArray.
- self assert: result first first = 1.
- self assert: result first second inputValue = '*'.
- self assert: result first third = 2.
- self assert: result second inputValue = '+'.
- self assert: result third = 3.
-! !
-
--- a/compiler/tests/extras/PPTokenizedExpressionsVerificationTest.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,35 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCExpressionsVerificationTest subclass:#PPTokenizedExpressionsVerificationTest
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Extras-Tests-Expressions'
-!
-
-!PPTokenizedExpressionsVerificationTest class methodsFor:'as yet unclassified'!
-
-resources
- ^ (OrderedCollection with: PPTokenizedExpressionGrammarResource)
- addAll: super resources;
- yourself
-! !
-
-!PPTokenizedExpressionsVerificationTest methodsFor:'as yet unclassified'!
-
-compiledGrammarClass
- ^ (Smalltalk at: #PPTokenizedExpressionGrammar)
-! !
-
-!PPTokenizedExpressionsVerificationTest methodsFor:'testing'!
-
-testExpressions
- ^ super testExpressions
-!
-
-testSanity
- ^ super testSanity
-! !
-
--- a/compiler/tests/extras/PPTokenizedLL1ExpressionGrammarResource.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,27 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
-
-"{ NameSpace: Smalltalk }"
-
-TestResource subclass:#PPTokenizedLL1ExpressionGrammarResource
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Extras-Tests-Expressions'
-!
-
-!PPTokenizedLL1ExpressionGrammarResource methodsFor:'as yet unclassified'!
-
-setUp
- | time configuration |
- configuration := PPCTokenizingConfiguration new.
- configuration arguments parserName:#PPTokenizedLL1ExpressionGrammar.
-
-
- time := Time millisecondsToRun: [
- PPLL1ExpressionGrammar new compileWithConfiguration: configuration.
- ].
- Transcript show: 'LL1 Expression grammar tokenized in: '; show: time asString; show: 'ms'; cr.
-
- "Modified: / 26-05-2015 / 07:24:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
--- a/compiler/tests/extras/PPTokenizedLL1ExpressionGrammarTest.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,140 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCompositeParserTest subclass:#PPTokenizedLL1ExpressionGrammarTest
- instanceVariableNames:'context'
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Extras-Tests-Expressions'
-!
-
-!PPTokenizedLL1ExpressionGrammarTest class methodsFor:'as yet unclassified'!
-
-resources
- ^ (OrderedCollection with: PPTokenizedLL1ExpressionGrammarResource)
- addAll: super resources;
- yourself
-! !
-
-!PPTokenizedLL1ExpressionGrammarTest methodsFor:'as yet unclassified'!
-
-compilerArguments
- ^ PPCArguments default
- profile: true;
- ll: true;
- yourself
-!
-
-context
- ^ context := PPCProfilingContext new
-!
-
-parserClass
- ^ Smalltalk at: #PPTokenizedLL1ExpressionGrammar
-!
-
-parserInstanceFor: aSymbol
- ^ (Smalltalk at: #PPTokenizedLL1ExpressionGrammar) new startSymbol: aSymbol
-!
-
-testAdd
- result := self parse: '1+2' rule: #term.
- self assert: result isArray.
- self assert: result first = 1.
- self assert: result second inputValue = '+'.
- self assert: result third = 2.
-!
-
-testMul
- result := self parse: '1 * 2' rule: #mul.
- self assert: result isArray.
- self assert: result first = 1.
- self assert: result second inputValue = '*'.
- self assert: result third = 2.
-!
-
-testNumber
- result := self parse: '1' rule: #number.
- self assert: result = 1.
-!
-
-testParens
- result := self parse: '(1)' rule: #parens.
- self assert: result size = 3.
- self assert: result first inputValue = '('.
- self assert: result second = 1.
- self assert: result third inputValue = ')'.
-
-!
-
-testPrim
- result := self parse: '1' rule: #prim.
- self assert: result = 1.
-!
-
-testPrim2
- result := self parse: '(1)' rule: #prim.
- self assert: result size = 3.
- self assert: result second = 1.
-!
-
-testProd
- result := self parse: '1' rule: #prod.
- self assert: result = 1.
-!
-
-testTerm01
- result := self parse: '1' rule: #term.
- self assert: result = 1.
-
- self assert: context lwRememberCount = 2.
- self assert: context lwRestoreCount = 0.
-!
-
-testTerm02
- result := self parse: '1+2' rule: #term.
- self assert: result size = 3.
-
- self assert: context lwRestoreCount = 0.
-!
-
-testTerm03
- result := self parse: '1*2+3*4' rule: #term.
- self assert: result size = 3.
-
-
- self assert: context lwRestoreCount = 0.
-!
-
-testTerm11
- result := self parse: '1 + 2' rule: #term.
- self assert: result size = 3.
- self assert: result first = 1.
- self assert: result second inputValue = '+'.
- self assert: result third = 2.
-
-!
-
-testTerm12
- result := self parse: '1 + 2 * 3' rule: #term.
- self assert: result size = 3.
- self assert: result second inputValue = '+'.
- self assert: result first = 1.
- self assert: result third isArray.
- self assert: result third first = 2.
- self assert: result third second inputValue = '*'.
- self assert: result third third = 3.
-!
-
-testTerm13
- result := self parse: '1 * 2 + 3' rule: #term.
- self assert: result size = 3.
- self assert: result first isArray.
- self assert: result first first = 1.
- self assert: result first second inputValue = '*'.
- self assert: result first third = 2.
- self assert: result second inputValue = '+'.
- self assert: result third = 3.
-! !
-
--- a/compiler/tests/extras/PPTokenizedSmalltalkGrammarResource.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,47 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
-
-"{ NameSpace: Smalltalk }"
-
-TestResource subclass:#PPTokenizedSmalltalkGrammarResource
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Extras-Tests-Smalltalk'
-!
-
-
-!PPTokenizedSmalltalkGrammarResource methodsFor:'as yet unclassified'!
-
-setUp
- | time configuration |
- configuration := PPCConfiguration tokenizing.
- configuration arguments parserName:#PPTokenizedSmalltalkGrammar.
-
- time := Time millisecondsToRun: [
- PPSmalltalkGrammar new compileWithConfiguration: configuration.
- ].
- Transcript show: 'Smalltalk Grammar tokenized in: '; show: time asString; show: 'ms'; cr.
-
- "Modified: / 10-05-2015 / 07:55:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-tearDown
- | parserClass |
- super tearDown.
-
- parserClass := (Smalltalk at: #PPTokenizedSmalltalkGrammar ifAbsent: [nil]).
- self flag: 'uncomment:'.
-"
- parserClass notNil ifTrue:[
- parserClass removeFromSystem
- ].
-"
-! !
-
-!PPTokenizedSmalltalkGrammarResource class methodsFor:'documentation'!
-
-version_HG
-
- ^ '$Changeset: <not expanded> $'
-! !
-
--- a/compiler/tests/extras/PPTokenizedSmalltalkGrammarTests.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,935 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCompositeParserTest subclass:#PPTokenizedSmalltalkGrammarTests
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Extras-Tests-Smalltalk'
-!
-
-!PPTokenizedSmalltalkGrammarTests class methodsFor:'accessing'!
-
-resources
- ^ (OrderedCollection with: PPTokenizedSmalltalkGrammarResource)
- addAll: super resources;
- yourself
-! !
-
-!PPTokenizedSmalltalkGrammarTests methodsFor:'accessing'!
-
-context
- ^ PPCContext new
-!
-
-parserClass
- ^ Smalltalk at: #PPTokenizedSmalltalkGrammar
-!
-
-parserInstanceFor: aSymbol
- ^ (Smalltalk at: #PPTokenizedSmalltalkGrammar) new startSymbol: aSymbol
-!
-
-testSmalltalkWhitespace
- | whitespaces |
- whitespaces := parser class methodDictionary keys select: [:e | e beginsWith: 'smalltalk_ws' ].
- self assert: whitespaces size = 1.
-! !
-
-!PPTokenizedSmalltalkGrammarTests 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 ]
-! !
-
-!PPTokenizedSmalltalkGrammarTests 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
-! !
-
-!PPTokenizedSmalltalkGrammarTests 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
-! !
-
-!PPTokenizedSmalltalkGrammarTests 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
-! !
-
-!PPTokenizedSmalltalkGrammarTests methodsFor:'testing-pragmas'!
-
-testPragma1
- self
- parse: 'method <foo>'
- rule: #method
-!
-
-testPragma10
- self
- parse: 'method <foo: bar>'
- rule: #method
-!
-
-testPragma11
- self
- parse: 'method <foo: true>'
- rule: #method
-!
-
-testPragma12
- self
- parse: 'method <foo: false>'
- rule: #method
-!
-
-testPragma13
- self
- parse: 'method <foo: nil>'
- rule: #method
-!
-
-testPragma14
- self
- parse: 'method <foo: ()>'
- rule: #method
-!
-
-testPragma15
- self
- parse: 'method <foo: #()>'
- rule: #method
-!
-
-testPragma16
- self
- parse: 'method < + 1 >'
- rule: #method
-!
-
-testPragma2
- self
- parse: 'method <foo> <bar>'
- rule: #method
-!
-
-testPragma3
- self
- parse: 'method | a | <foo>'
- rule: #method
-!
-
-testPragma4
- self
- parse: 'method <foo> | a |'
- rule: #method
-!
-
-testPragma5
- self
- parse: 'method <foo> | a | <bar>'
- rule: #method
-!
-
-testPragma6
- self
- parse: 'method <foo: 1>'
- rule: #method
-!
-
-testPragma7
- self
- parse: 'method <foo: 1.2>'
- rule: #method
-!
-
-testPragma8
- self
- parse: 'method <foo: ''bar''>'
- rule: #method
-!
-
-testPragma9
- self
- parse: 'method <foo: #''bar''>'
- rule: #method
-! !
-
--- a/compiler/tests/extras/PPTokenizedSmalltalkParserResource.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,39 +0,0 @@
-"{ 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 <jan.vrany@fit.cvut.cz>"
-!
-
-tearDown
- | parserClass |
- super tearDown.
-
- parserClass := (Smalltalk at: #PPTokenizedSmalltalkParser ifAbsent: [nil]).
- self flag: 'uncomment:'.
-"
- parserClass notNil ifTrue:[
- parserClass removeFromSystem
- ].
-"
-! !
-
--- a/compiler/tests/extras/PPTokenizedSmalltalkParserTests.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,935 +0,0 @@
-"{ 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 <foo>'
- rule: #method
-!
-
-testPragma10
- self
- parse: 'method <foo: bar>'
- rule: #method
-!
-
-testPragma11
- self
- parse: 'method <foo: true>'
- rule: #method
-!
-
-testPragma12
- self
- parse: 'method <foo: false>'
- rule: #method
-!
-
-testPragma13
- self
- parse: 'method <foo: nil>'
- rule: #method
-!
-
-testPragma14
- self
- parse: 'method <foo: ()>'
- rule: #method
-!
-
-testPragma15
- self
- parse: 'method <foo: #()>'
- rule: #method
-!
-
-testPragma16
- self
- parse: 'method < + 1 >'
- rule: #method
-!
-
-testPragma2
- self
- parse: 'method <foo> <bar>'
- rule: #method
-!
-
-testPragma3
- self
- parse: 'method | a | <foo>'
- rule: #method
-!
-
-testPragma4
- self
- parse: 'method <foo> | a |'
- rule: #method
-!
-
-testPragma5
- self
- parse: 'method <foo> | a | <bar>'
- rule: #method
-!
-
-testPragma6
- self
- parse: 'method <foo: 1>'
- rule: #method
-!
-
-testPragma7
- self
- parse: 'method <foo: 1.2>'
- rule: #method
-!
-
-testPragma8
- self
- parse: 'method <foo: ''bar''>'
- rule: #method
-!
-
-testPragma9
- self
- parse: 'method <foo: #''bar''>'
- rule: #method
-! !
-
--- a/compiler/tests/extras/PPTokenizedSmalltalkParserVerificationTest.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,39 +0,0 @@
-"{ 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
-! !
-
--- a/compiler/tests/extras/PPTokenizedSmalltalkVerificationTest.st Fri Jul 24 15:06:54 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,39 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCSmalltalkVerificationTest subclass:#PPTokenizedSmalltalkVerificationTest
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Extras-Tests-Smalltalk'
-!
-
-!PPTokenizedSmalltalkVerificationTest class methodsFor:'as yet unclassified'!
-
-resources
- ^ (OrderedCollection with: PPTokenizedSmalltalkGrammarResource)
- addAll: super resources;
- yourself
-! !
-
-!PPTokenizedSmalltalkVerificationTest methodsFor:'accessing'!
-
-compiledSmalltalkGrammarClass
- ^ (Smalltalk at: #PPTokenizedSmalltalkGrammar)
-! !
-
-!PPTokenizedSmalltalkVerificationTest methodsFor:'tests'!
-
-testSmalltalk
- super testSmalltalk
-!
-
-testSmalltalkClass
- super testSmalltalkClass
-!
-
-testSmalltalkObject
- super testSmalltalkObject
-! !
-
--- a/compiler/tests/extras/abbrev.stc Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/extras/abbrev.stc Mon Aug 17 12:13:16 2015 +0100
@@ -1,34 +1,60 @@
# 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.
+PPCAbstractParserTest PPCAbstractParserTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Support' 1
PPCCompiledJavaVerificationTest PPCCompiledJavaVerificationTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Java' 1
-PPCExpressionsVerificationTest PPCExpressionsVerificationTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1
+PPCCompositeParserTest PPCCompositeParserTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Support' 1
+PPCLRPNode PPCLRPNode stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCLRPParser PPCLRPParser stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCLRPParserSmokeTest PPCLRPParserSmokeTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 1
+PPCLRPSourcesResource PPCLRPSourcesResource stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 1
PPCResources PPCResources stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Support' 1
+PPCSetUpBeforeTearDownAfterResource PPCSetUpBeforeTearDownAfterResource stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Support' 2
+PPCSmalltalkGrammarTests PPCSmalltalkGrammarTests stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1
+PPCSmalltalkParserTests PPCSmalltalkParserTests stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1
PPCSmalltalkTests PPCSmalltalkTests stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1
-PPCSmalltalkVerificationTest PPCSmalltalkVerificationTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1
-PPCompiledExpressionGrammarResource PPCompiledExpressionGrammarResource stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1
-PPCompiledExpressionGrammarTest PPCompiledExpressionGrammarTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1
PPCompiledJavaResource PPCompiledJavaResource stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Java' 1
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
PPLL1ExpressionGrammarTest PPLL1ExpressionGrammarTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1
-PPTokenizedExpressionGrammarResource PPTokenizedExpressionGrammarResource stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1
-PPTokenizedExpressionGrammarTest PPTokenizedExpressionGrammarTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1
-PPTokenizedLL1ExpressionGrammarResource PPTokenizedLL1ExpressionGrammarResource stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1
-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
+PPCExpressionGrammarTest PPCExpressionGrammarTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1
+PPCExpressionGrammarVerificationTest PPCExpressionGrammarVerificationTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1
+PPCLL1ExpressionGrammarTest PPCLL1ExpressionGrammarTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1
+PPCLRPAction PPCLRPAction stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCLRPContainedElement PPCLRPContainedElement stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCLRPParserVerificationTest PPCLRPParserVerificationTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 1
+PPCLRPSpawn PPCLRPSpawn stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCSmalltalkGrammarTests_Tokenized PPCSmalltalkGrammarTests_Tokenized stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1
+PPCSmalltalkGrammarTests_Universal PPCSmalltalkGrammarTests_Universal stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1
+PPCSmalltalkGrammarVerificationTest PPCSmalltalkGrammarVerificationTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1
+PPCSmalltalkParserTests_Tokenized PPCSmalltalkParserTests_Tokenized stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1
+PPCSmalltalkParserTests_Universal PPCSmalltalkParserTests_Universal stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1
+PPCSmalltalkParserVerificationTest PPCSmalltalkParserVerificationTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1
+PPCExpressionGrammarTest_Tokenized PPCExpressionGrammarTest_Tokenized stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1
+PPCExpressionGrammarTest_Universal PPCExpressionGrammarTest_Universal stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1
+PPCLL1ExpressionGrammarTest_Tokenized PPCLL1ExpressionGrammarTest_Tokenized stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1
+PPCLL1ExpressionGrammarTest_Universal PPCLL1ExpressionGrammarTest_Universal stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1
+PPCLRPComment PPCLRPComment stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCLRPErrorNode PPCLRPErrorNode stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCLRPEvent PPCLRPEvent stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCLRPMachine PPCLRPMachine stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCLRPOnEntry PPCLRPOnEntry stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCLRPOnExit PPCLRPOnExit stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCLRPParserVerificationTest_Tokenized PPCLRPParserVerificationTest_Tokenized stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 1
+PPCLRPParserVerificationTest_Universal PPCLRPParserVerificationTest_Universal stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 1
+PPCLRPRunning PPCLRPRunning stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCLRPState PPCLRPState stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCLRPTransition PPCLRPTransition stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCLRPVariable PPCLRPVariable stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCSmalltalkGrammarVerificationTest_Tokenized PPCSmalltalkGrammarVerificationTest_Tokenized stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1
+PPCSmalltalkGrammarVerificationTest_Universal PPCSmalltalkGrammarVerificationTest_Universal stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1
+PPCSmalltalkParserVerificationTest_Tokenized PPCSmalltalkParserVerificationTest_Tokenized stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1
+PPCSmalltalkParserVerificationTest_Universal PPCSmalltalkParserVerificationTest_Universal stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1
+PPExpressionGrammarVerificationTest_Tokenized PPExpressionGrammarVerificationTest_Tokenized stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1
+PPExpressionGrammarVerificationTest_Universal PPExpressionGrammarVerificationTest_Universal stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Expressions' 1
+PPCLRPEpsilonTransition PPCLRPEpsilonTransition stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCLRPTimeoutTransition PPCLRPTimeoutTransition stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
+PPCLRPWildcardTransition PPCLRPWildcardTransition stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-LRP' 0
--- a/compiler/tests/extras/bc.mak Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/extras/bc.mak Mon Aug 17 12:13:16 2015 +0100
@@ -35,7 +35,7 @@
-LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\compiler -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\java -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\goodies\petitparser\tests -I$(INCLUDE_TOP)\stx\goodies\sunit -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\compiler -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\java -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk\tests -I$(INCLUDE_TOP)\stx\goodies\petitparser\tests -I$(INCLUDE_TOP)\stx\goodies\sunit -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2
LOCALDEFINES=
STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
@@ -59,6 +59,7 @@
pushd ..\..\..\..\sunit & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
pushd ..\..\..\tests & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
pushd ..\..\..\parsers\java & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\..\parsers\smalltalk\tests & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
@@ -75,9 +76,27 @@
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)PPCLRPNode.$(O) PPCLRPNode.$(H): PPCLRPNode.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPParser.$(O) PPCLRPParser.$(H): PPCLRPParser.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPCompositeParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPExpressionGrammar.$(O) PPExpressionGrammar.$(H): PPExpressionGrammar.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPCompositeParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPLL1ExpressionGrammar.$(O) PPLL1ExpressionGrammar.$(H): PPLL1ExpressionGrammar.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPCompositeParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)stx_goodies_petitparser_compiler_tests_extras.$(O) stx_goodies_petitparser_compiler_tests_extras.$(H): stx_goodies_petitparser_compiler_tests_extras.st $(INCLUDE_TOP)\stx\libbasic\LibraryDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProjectDefinition.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPAction.$(O) PPCLRPAction.$(H): PPCLRPAction.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPContainedElement.$(O) PPCLRPContainedElement.$(H): PPCLRPContainedElement.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPSpawn.$(O) PPCLRPSpawn.$(H): PPCLRPSpawn.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPComment.$(O) PPCLRPComment.$(H): PPCLRPComment.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPContainedElement.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPErrorNode.$(O) PPCLRPErrorNode.$(H): PPCLRPErrorNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPContainedElement.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPEvent.$(O) PPCLRPEvent.$(H): PPCLRPEvent.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPContainedElement.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPMachine.$(O) PPCLRPMachine.$(H): PPCLRPMachine.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPContainedElement.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPOnEntry.$(O) PPCLRPOnEntry.$(H): PPCLRPOnEntry.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPAction.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPOnExit.$(O) PPCLRPOnExit.$(H): PPCLRPOnExit.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPAction.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPRunning.$(O) PPCLRPRunning.$(H): PPCLRPRunning.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPAction.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPState.$(O) PPCLRPState.$(H): PPCLRPState.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPContainedElement.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPTransition.$(O) PPCLRPTransition.$(H): PPCLRPTransition.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPContainedElement.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPVariable.$(O) PPCLRPVariable.$(H): PPCLRPVariable.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPContainedElement.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPEpsilonTransition.$(O) PPCLRPEpsilonTransition.$(H): PPCLRPEpsilonTransition.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPContainedElement.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPTransition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPTimeoutTransition.$(O) PPCLRPTimeoutTransition.$(H): PPCLRPTimeoutTransition.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPContainedElement.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPTransition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLRPWildcardTransition.$(O) PPCLRPWildcardTransition.$(H): PPCLRPWildcardTransition.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPContainedElement.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\tests\extras\PPCLRPTransition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
# ENDMAKEDEPEND --- do not remove this line
--- a/compiler/tests/extras/libInit.cc Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/extras/libInit.cc Mon Aug 17 12:13:16 2015 +0100
@@ -27,9 +27,27 @@
void _libstx_goodies_petitparser_compiler_tests_extras_Init(pass, __pRT__, snd)
OBJ snd; struct __vmData__ *__pRT__; {
__BEGIN_PACKAGE2__("libstx_goodies_petitparser_compiler_tests_extras", _libstx_goodies_petitparser_compiler_tests_extras_Init, "stx:goodies/petitparser/compiler/tests/extras");
+_PPCLRPNode_Init(pass,__pRT__,snd);
+_PPCLRPParser_Init(pass,__pRT__,snd);
_PPExpressionGrammar_Init(pass,__pRT__,snd);
_PPLL1ExpressionGrammar_Init(pass,__pRT__,snd);
_stx_137goodies_137petitparser_137compiler_137tests_137extras_Init(pass,__pRT__,snd);
+_PPCLRPAction_Init(pass,__pRT__,snd);
+_PPCLRPContainedElement_Init(pass,__pRT__,snd);
+_PPCLRPSpawn_Init(pass,__pRT__,snd);
+_PPCLRPComment_Init(pass,__pRT__,snd);
+_PPCLRPErrorNode_Init(pass,__pRT__,snd);
+_PPCLRPEvent_Init(pass,__pRT__,snd);
+_PPCLRPMachine_Init(pass,__pRT__,snd);
+_PPCLRPOnEntry_Init(pass,__pRT__,snd);
+_PPCLRPOnExit_Init(pass,__pRT__,snd);
+_PPCLRPRunning_Init(pass,__pRT__,snd);
+_PPCLRPState_Init(pass,__pRT__,snd);
+_PPCLRPTransition_Init(pass,__pRT__,snd);
+_PPCLRPVariable_Init(pass,__pRT__,snd);
+_PPCLRPEpsilonTransition_Init(pass,__pRT__,snd);
+_PPCLRPTimeoutTransition_Init(pass,__pRT__,snd);
+_PPCLRPWildcardTransition_Init(pass,__pRT__,snd);
__END_PACKAGE__();
--- a/compiler/tests/extras/stx_goodies_petitparser_compiler_tests_extras.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/extras/stx_goodies_petitparser_compiler_tests_extras.st Mon Aug 17 12:13:16 2015 +0100
@@ -57,10 +57,11 @@
by searching along the inheritance chain of all of my classes."
^ #(
- #'stx:goodies/petitparser' "PPCompositeParser - superclass of PPExpressionGrammar"
+ #'stx:goodies/petitparser' "PPCompositeParser - superclass of PPCLRPParser"
#'stx:goodies/petitparser/parsers/java' "PPJavaLexiconTest - superclass of PPCompiledJavaSyntaxTest"
- #'stx:goodies/petitparser/tests' "PPAbstractParserTest - superclass of PPCCompiledJavaVerificationTest"
- #'stx:goodies/sunit' "TestAsserter - superclass of PPCCompiledJavaVerificationTest"
+ #'stx:goodies/petitparser/parsers/smalltalk/tests' "PPSmalltalkGrammarTests - superclass of PPCSmalltalkGrammarTests"
+ #'stx:goodies/petitparser/tests' "PPAbstractParserTest - superclass of PPCAbstractParserTest"
+ #'stx:goodies/sunit' "TestAsserter - superclass of PPCAbstractParserTest"
#'stx:libbasic' "LibraryDefinition - superclass of stx_goodies_petitparser_compiler_tests_extras"
)
!
@@ -76,8 +77,8 @@
by searching all classes (and their packages) which are referenced by my classes."
^ #(
- #'stx:goodies/petitparser/compiler' "PPCArguments - referenced by PPCSmalltalkTests>>setUp"
- #'stx:goodies/petitparser/parsers/smalltalk' "PPSmalltalkGrammar - referenced by PPCSmalltalkVerificationTest>>smalltalkGrammar"
+ #'stx:goodies/petitparser/compiler' "PPCArguments - referenced by PPCSmalltalkTests>>configuration"
+ #'stx:goodies/petitparser/parsers/smalltalk' "PPSmalltalkGrammar - referenced by PPCSmalltalkGrammarTests>>petitParserClass"
#'stx:libbasic2' "Random - referenced by PPCResources>>expressionOfSize:stream:"
)
!
@@ -102,37 +103,63 @@
^ #(
"<className> or (<className> attributes...) in load order"
+ (PPCAbstractParserTest autoload)
(PPCCompiledJavaVerificationTest autoload)
- (PPCExpressionsVerificationTest autoload)
+ (PPCCompositeParserTest autoload)
+ PPCLRPNode
+ PPCLRPParser
+ (PPCLRPParserSmokeTest autoload)
+ (PPCLRPSourcesResource autoload)
(PPCResources autoload)
+ (PPCSetUpBeforeTearDownAfterResource autoload)
+ (PPCSmalltalkGrammarTests autoload)
+ (PPCSmalltalkParserTests autoload)
(PPCSmalltalkTests autoload)
- (PPCSmalltalkVerificationTest autoload)
- (PPCompiledExpressionGrammarResource autoload)
- (PPCompiledExpressionGrammarTest autoload)
(PPCompiledJavaResource autoload)
(PPCompiledJavaSyntaxTest autoload)
- (PPCompiledSmalltalkGrammarResource autoload)
- (PPCompiledSmalltalkGrammarTests autoload)
- (PPCompiledSmalltalkParserResource autoload)
- (PPCompiledSmalltalkParserTests autoload)
PPExpressionGrammar
(PPExpressionGrammarTest autoload)
PPLL1ExpressionGrammar
(PPLL1ExpressionGrammarTest autoload)
- (PPTokenizedExpressionGrammarResource autoload)
- (PPTokenizedExpressionGrammarTest autoload)
- (PPTokenizedLL1ExpressionGrammarResource autoload)
- (PPTokenizedLL1ExpressionGrammarTest autoload)
- (PPTokenizedSmalltalkGrammarResource autoload)
- (PPTokenizedSmalltalkGrammarTests autoload)
- (PPTokenizedSmalltalkParserResource autoload)
- (PPTokenizedSmalltalkParserTests autoload)
#'stx_goodies_petitparser_compiler_tests_extras'
- (PPCompiledExpressionsVerificationTest autoload)
- (PPCompiledSmalltalkVerificationTest autoload)
- (PPTokenizedExpressionsVerificationTest autoload)
- (PPTokenizedSmalltalkParserVerificationTest autoload)
- (PPTokenizedSmalltalkVerificationTest autoload)
+ (PPCExpressionGrammarTest autoload)
+ (PPCExpressionGrammarVerificationTest autoload)
+ (PPCLL1ExpressionGrammarTest autoload)
+ PPCLRPAction
+ PPCLRPContainedElement
+ (PPCLRPParserVerificationTest autoload)
+ PPCLRPSpawn
+ (#'PPCSmalltalkGrammarTests_Tokenized' autoload)
+ (#'PPCSmalltalkGrammarTests_Universal' autoload)
+ (PPCSmalltalkGrammarVerificationTest autoload)
+ (#'PPCSmalltalkParserTests_Tokenized' autoload)
+ (#'PPCSmalltalkParserTests_Universal' autoload)
+ (PPCSmalltalkParserVerificationTest autoload)
+ (#'PPCExpressionGrammarTest_Tokenized' autoload)
+ (#'PPCExpressionGrammarTest_Universal' autoload)
+ (#'PPCLL1ExpressionGrammarTest_Tokenized' autoload)
+ (#'PPCLL1ExpressionGrammarTest_Universal' autoload)
+ PPCLRPComment
+ PPCLRPErrorNode
+ PPCLRPEvent
+ PPCLRPMachine
+ PPCLRPOnEntry
+ PPCLRPOnExit
+ (#'PPCLRPParserVerificationTest_Tokenized' autoload)
+ (#'PPCLRPParserVerificationTest_Universal' autoload)
+ PPCLRPRunning
+ PPCLRPState
+ PPCLRPTransition
+ PPCLRPVariable
+ (#'PPCSmalltalkGrammarVerificationTest_Tokenized' autoload)
+ (#'PPCSmalltalkGrammarVerificationTest_Universal' autoload)
+ (#'PPCSmalltalkParserVerificationTest_Tokenized' autoload)
+ (#'PPCSmalltalkParserVerificationTest_Universal' autoload)
+ (#'PPExpressionGrammarVerificationTest_Tokenized' autoload)
+ (#'PPExpressionGrammarVerificationTest_Universal' autoload)
+ PPCLRPEpsilonTransition
+ PPCLRPTimeoutTransition
+ PPCLRPWildcardTransition
)
!
--- a/compiler/tests/libInit.cc Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/libInit.cc Mon Aug 17 12:13:16 2015 +0100
@@ -28,13 +28,18 @@
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);
+_PEGFsaChoiceDeterminizationTest_Init(pass,__pRT__,snd);
_PEGFsaDeterminizationTest_Init(pass,__pRT__,snd);
_PEGFsaGeneratorTest_Init(pass,__pRT__,snd);
+_PEGFsaIntegrationTest_Init(pass,__pRT__,snd);
_PEGFsaInterpretTest_Init(pass,__pRT__,snd);
+_PEGFsaMinimizationTest_Init(pass,__pRT__,snd);
_PEGFsaScannerIntegrationTest_Init(pass,__pRT__,snd);
+_PEGFsaSequenceDeterminizationTest_Init(pass,__pRT__,snd);
_PEGFsaStateTest_Init(pass,__pRT__,snd);
_PEGFsaTest_Init(pass,__pRT__,snd);
_PEGFsaTransitionTest_Init(pass,__pRT__,snd);
+_PPCASTUtilitiesTests_Init(pass,__pRT__,snd);
_PPCClassBuilderTest_Init(pass,__pRT__,snd);
_PPCCodeGeneratorTest_Init(pass,__pRT__,snd);
_PPCCompilerTest_Init(pass,__pRT__,snd);
@@ -42,6 +47,7 @@
_PPCContextTest_Init(pass,__pRT__,snd);
_PPCCopyVisitorTest_Init(pass,__pRT__,snd);
_PPCGuardTest_Init(pass,__pRT__,snd);
+_PPCIdGeneratorTest_Init(pass,__pRT__,snd);
_PPCInliningVisitorTest_Init(pass,__pRT__,snd);
_PPCLL1VisitorTest_Init(pass,__pRT__,snd);
_PPCLTokenizingOptimizationTest_Init(pass,__pRT__,snd);
@@ -50,6 +56,7 @@
_PPCNodeFirstFollowNextTests_Init(pass,__pRT__,snd);
_PPCNodeTest_Init(pass,__pRT__,snd);
_PPCOptimizeChoicesTest_Init(pass,__pRT__,snd);
+_PPCOverlappingTokensTest_Init(pass,__pRT__,snd);
_PPCRecognizerComponentDetectorTest_Init(pass,__pRT__,snd);
_PPCRecognizerComponentVisitorTest_Init(pass,__pRT__,snd);
_PPCScannerCodeGeneratorTest_Init(pass,__pRT__,snd);
--- a/compiler/tests/stx_goodies_petitparser_compiler_tests.st Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/tests/stx_goodies_petitparser_compiler_tests.st Mon Aug 17 12:13:16 2015 +0100
@@ -108,13 +108,18 @@
^ #(
"<className> or (<className> attributes...) in load order"
FooScannerTest
+ PEGFsaChoiceDeterminizationTest
PEGFsaDeterminizationTest
PEGFsaGeneratorTest
+ PEGFsaIntegrationTest
PEGFsaInterpretTest
+ PEGFsaMinimizationTest
PEGFsaScannerIntegrationTest
+ PEGFsaSequenceDeterminizationTest
PEGFsaStateTest
PEGFsaTest
PEGFsaTransitionTest
+ PPCASTUtilitiesTests
PPCClassBuilderTest
PPCCodeGeneratorTest
PPCCompilerTest
@@ -122,6 +127,7 @@
PPCContextTest
PPCCopyVisitorTest
PPCGuardTest
+ PPCIdGeneratorTest
PPCInliningVisitorTest
PPCLL1VisitorTest
PPCLTokenizingOptimizationTest
@@ -130,6 +136,7 @@
PPCNodeFirstFollowNextTests
PPCNodeTest
PPCOptimizeChoicesTest
+ PPCOverlappingTokensTest
PPCRecognizerComponentDetectorTest
PPCRecognizerComponentVisitorTest
PPCScannerCodeGeneratorTest