# HG changeset patch # User Jan Vrany # Date 1439809996 -3600 # Node ID b5316ef152748f8645edc7a1d9bc57b0a4cff8ff # Parent 1e45d3c96ec58e53caf50ec3c59a65e22ea38639 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/FooScanner.st --- 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! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/Make.proto --- 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/Make.spec --- 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) \ diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsa.st --- 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 - + 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 ] diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaAbstractDeterminizator.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaCharacterTransition.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaChoiceDeterminizator.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaDeterminizator.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaEOFTransition.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaEpsilonTransition.st --- /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 := ''. + 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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaFailure.st --- 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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaGenerator.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaInterpret.st --- 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 ])" diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaInterpretRecord.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaMinimizator.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaPair.st --- 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 ] +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaPredicateTransition.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaSequenceDeterminizator.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaState.st --- 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 + + ^ self isMultivalue + + "Modified: / 17-08-2015 / 12:03:10 / Jan Vrany " ! multivalue: anObject - multivalue := anObject + self flag: 'JK: Obsolete?'. + "multivalue := anObject" + + "Modified: / 17-08-2015 / 12:03:39 / Jan Vrany " ! 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 " ! 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 ]). diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaStateInfo.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaTransition.st --- 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: ''. - ^ 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PEGFsaUncopiableState.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCASTUtilities.st --- /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 " + "Modified: / 27-07-2015 / 14:43:07 / Jan Vrany " +! ! + +!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 " + "Modified (comment): / 27-07-2015 / 11:26:29 / Jan Vrany " +! + +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 " +! + +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 " + "Modified (comment): / 27-07-2015 / 11:26:46 / Jan Vrany " +! + +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 " + "Modified (comment): / 27-07-2015 / 11:26:52 / Jan Vrany " +! + +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 " +! + +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 " + "Modified (comment): / 27-07-2015 / 11:27:00 / Jan Vrany " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCAbstractActionNode.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCAbstractLiteralNode.st --- 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'! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCAbstractPredicateNode.st --- 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: $' +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCAndNode.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCAnyNode.st --- 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'! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCCharacterNode.st --- 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'! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCChoiceNode.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCClassBuilder.st --- 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. ] ] ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCCodeBlock.st --- 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 " "Modified: / 03-06-2015 / 05:52:39 / Jan Vrany " ! @@ -66,6 +59,22 @@ ]. "Created: / 01-06-2015 / 22:58:07 / Jan Vrany " +! + +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 " +! + +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 " ! ! !PPCCodeBlock methodsFor:'private'! @@ -170,7 +211,7 @@ ! emitCodeAsString: aString - buffer nextPutAll: aString + self addOnLine: aString ! formatRBNode: anRBNode diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCCodeGen.st --- 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 " ! +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 " ! +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 " ! +codeOnLIne:aStringOrBlockOrRBParseNode + currentMethod codeOnLine: aStringOrBlockOrRBParseNode + + "Created: / 01-06-2015 / 23:49:11 / Jan Vrany " +! + +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 " - "Modified: / 01-06-2015 / 21:49:04 / Jan Vrany " + "Created: / 23-04-2015 / 18:01:05 / Jan Vrany " + "Modified: / 01-06-2015 / 21:49:04 / Jan Vrany " ! codeReturn: code @@ -333,6 +372,25 @@ "Modified: / 01-06-2015 / 21:48:51 / Jan Vrany " ! +codeReturnParsedValueOf: aBlock + | tmpVarirable method | + + self assert:aBlock isBlock. + tmpVarirable := returnVariable. + method := aBlock value. + self assert: returnVariable == tmpVarirable. + self assert: (method isKindOf: PPCMethod). + method isInline ifTrue:[ + self callOnLine:method. + self codeReturn: returnVariable. + ] ifFalse:[ + self codeReturn: method call. + + ] + + "Created: / 23-04-2015 / 18:21:51 / Jan Vrany " +! + codeStoreValueOf: aBlock intoVariable: aString | tmpVarirable method | self assert: aBlock isBlock. @@ -394,9 +452,12 @@ "Modified: / 10-05-2015 / 07:29:57 / Jan Vrany " ! -idFor: object - self assert: (object canHavePPCId). - ^ self idFor: object prefixed: object prefix suffixed: object suffix +idFor: 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 " ! 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. diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCCodeGenerator.st --- 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 " + "Modified: / 27-07-2015 / 15:52:59 / Jan Vrany " +! + +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 " +! + 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 " + "Modified: / 27-07-2015 / 15:49:15 / Jan Vrany " ! 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 " - "Modified: / 19-06-2015 / 07:06:19 / Jan Vrany " + "Modified: / 27-07-2015 / 15:49:58 / Jan Vrany " ! 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, '.'. diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCCompilationError.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCCompilationWarning.st --- /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' +! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCCompiler.st --- 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 " - "Modified: / 01-06-2015 / 21:49:04 / Jan Vrany " + "Created: / 23-04-2015 / 18:01:05 / Jan Vrany " + "Modified: / 01-06-2015 / 21:49:04 / Jan Vrany " ! codeReturn: code @@ -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 " + "Modified: / 01-06-2015 / 21:38:05 / Jan Vrany " ! 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 " ! installVariables diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCCompilerTokenErrorStrategy.st --- 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'! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCCompilerTokenRememberStrategy.st --- 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. diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCCompilerTokenizingErrorStrategy.st --- 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'! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCCompilerTokenizingRememberStrategy.st --- 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'! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCConfiguration.st --- 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. + ] +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCDelegateNode.st --- 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 ] ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCDistinctResultStrategy.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCEndOfFileNode.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCEndOfInputNode.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCFSACodeGen.st --- 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 " ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCForwardNode.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCGuard.st --- 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCIdGenerator.st --- /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 " +! + +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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCInlinedMethod.st --- 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 " +! + +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 " ! isInline ^ true +! + +source + ^ source isString ifTrue:[ + source + ] ifFalse:[ + (String streamContents:[:s | source sourceOn:s ]) trimRight + ]. + + "Created: / 24-07-2015 / 19:46:24 / Jan Vrany " ! ! !PPCInlinedMethod methodsFor:'code generation - variables'! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCInliningVisitor.st --- 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 " + "Modified: / 31-07-2015 / 08:20:09 / Jan Vrany " ! 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCMethod.st --- 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 " ! 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 " ! id: value - id := value + selector := value ! indentationLevel - ^ buffer indentationLevel + ^ source indentationLevel "Created: / 01-06-2015 / 21:38:31 / Jan Vrany " ! indentationLevel: anInteger - buffer indentationLevel: anInteger + source indentationLevel: anInteger "Created: / 01-06-2015 / 21:38:58 / Jan Vrany " ! methodName - ^ id + ^ selector ! profile + self error: 'Should no longer be used'. + " ^ profile + " + + "Modified: / 17-08-2015 / 11:58:40 / Jan Vrany " ! profile: aBoolean + self error: 'Should no longer be used'. + " profile := aBoolean + " + + "Modified: / 17-08-2015 / 11:58:46 / Jan Vrany " +! + +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 " +! + +source: aString + source := aString + + "Created: / 24-07-2015 / 19:48:05 / Jan Vrany " ! ! !PPCMethod methodsFor:'as yet unclassified'! add: string - buffer add: string + source add: string "Modified: / 01-06-2015 / 21:09:06 / Jan Vrany " ! addOnLine: string - buffer addOnLine: string + source addOnLine: string "Modified: / 01-06-2015 / 21:09:20 / Jan Vrany " ! @@ -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 " "Modified (format): / 01-06-2015 / 23:50:26 / Jan Vrany " @@ -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 " "Modified: / 03-06-2015 / 06:11:32 / Jan Vrany " +! + +codeOnLine: aStringOrBlockOrRBParseNode + source codeOnLine: aStringOrBlockOrRBParseNode. + + "Created: / 01-06-2015 / 22:31:16 / Jan Vrany " + "Modified (format): / 01-06-2015 / 23:50:26 / Jan Vrany " ! ! !PPCMethod methodsFor:'code generation - indenting'! dedent - buffer dedent + source dedent "Created: / 01-06-2015 / 21:32:28 / Jan Vrany " ! indent - buffer indent + source indent "Created: / 01-06-2015 / 21:32:22 / Jan Vrany " ! nl - buffer nl + source nl "Created: / 01-06-2015 / 21:52:31 / Jan Vrany " ! ! !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 " +! + 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 " "Modified: / 01-06-2015 / 21:04:02 / Jan Vrany " @@ -210,12 +267,21 @@ "Created: / 23-04-2015 / 18:23:47 / Jan Vrany " "Modified: / 15-06-2015 / 18:14:02 / Jan Vrany " +! + +variables + self error: 'Should no longer be used'. + " + ^ ' | ', (variables inject: '' into: [ :s :e | s, ' ', e]), ' |' + " + + "Modified: / 17-08-2015 / 11:54:58 / Jan Vrany " ! ! !PPCMethod methodsFor:'initialization'! initialize - buffer := PPCCodeBlock new. + source := PPCCodeBlock new. "Modified: / 01-06-2015 / 21:33:36 / Jan Vrany " ! ! @@ -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 " ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCNegateNode.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCNilNode.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCNode.st --- 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCNodeVisitor.st --- 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 ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCNotCharacterNode.st --- 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: ')' +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCNotLiteralNode.st --- 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'! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCNotNode.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCOptionalNode.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCPluggableNode.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCPlusNode.st --- 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'! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCProfilingContext.st --- 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCRecognizerComponentDetector.st --- 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 | diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCRecognizerComponentVisitor.st --- 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; diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCRecognizingSequenceNode.st --- 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'! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCScanner.st --- 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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCScannerCodeGenerator.st --- 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' ]. -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCScannerResultStrategy.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCSequenceNode.st --- 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 " ! -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. ]. diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCSpecializingVisitor.st --- 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. diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCStarAnyNode.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCStarCharSetPredicateNode.st --- 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'! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCStarMessagePredicateNode.st --- 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'! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCStarNode.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCTokenCodeGenerator.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCTokenConsumeNode.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCTokenDetector.st --- 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; diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCTokenNode.st --- 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCTokenVisitor.st --- 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; diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCTokenizingCodeGen.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCTokenizingCodeGenerator.st --- 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 " + "Modified: / 31-07-2015 / 08:07:59 / Jan Vrany " ! 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!!' ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCTokenizingConfiguration.st --- 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCTokenizingParserNode.st --- 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'! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCTokenizingVisitor.st --- 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 " ! 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. ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCTrimNode.st --- 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; diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCTrimmingTokenNode.st --- 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCUniversalConfiguration.st --- 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. diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCUniversalResultStrategy.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCUnknownNode.st --- 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'! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPCompiledParser.st --- 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. diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/PPTokenizingCompiledParser.st --- 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. diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/abbrev.stc --- 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/bc.mak --- 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/benchmarks/PPCBenchmark.st --- 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 " ! ! +!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. diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/extensions.st --- 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 ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/libInit.cc --- 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); diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/stx_goodies_petitparser_compiler.st --- 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 @@ ^ #( " or ( 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 ) ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/FooScannerTest.st --- 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. ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/Make.proto --- 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) diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/Make.spec --- 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) \ diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PEGFsaChoiceDeterminizationTest.st --- /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'. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PEGFsaDeterminizationTest.st --- 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). ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PEGFsaGeneratorTest.st --- 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PEGFsaIntegrationTest.st --- /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: $' +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PEGFsaInterpretTest.st --- 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' ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PEGFsaMinimizationTest.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PEGFsaScannerIntegrationTest.st --- 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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PEGFsaSequenceDeterminizationTest.st --- /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). +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PEGFsaStateTest.st --- 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PEGFsaTest.st --- 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. ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PEGFsaTransitionTest.st --- 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). +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PPCASTUtilitiesTests.st --- /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 " +! + +methodWithArguments: arg1 + (arg1 + 4) yourself isOdd ifTrue:[ + ^ true + ]. + ^ false not. + + "Created: / 27-07-2015 / 13:35:40 / Jan Vrany " +! + +methodWithClassReference + ^ PPCASTUtilities new + + "Created: / 27-07-2015 / 13:28:53 / Jan Vrany " +! + +methodWithClassVariableReference + ^ SomeClassVariable + + "Created: / 27-07-2015 / 14:02:23 / Jan Vrany " +! + +methodWithInstanceVariableReference + ^ testSelector + + "Created: / 27-07-2015 / 13:29:32 / Jan Vrany " +! + +methodWithSelfSend1 + ^ self methodSimple1 + + "Created: / 27-07-2015 / 13:28:08 / Jan Vrany " +! + +methodWithSelfSend2 + ^ self methodWithSelfSend1 + + "Created: / 27-07-2015 / 13:34:20 / Jan Vrany " +! + +methodWithSelfSend3 + ^ self methodWithInstanceVariableReference + + "Created: / 27-07-2015 / 14:01:26 / Jan Vrany " +! + +methodWithSuperSend + ^ super yourself + + "Created: / 27-07-2015 / 14:02:45 / Jan Vrany " +! + +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 " +! ! + +!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 " +! + +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 " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PPCCodeGeneratorTest.st --- 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 " ! +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 " +! + 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 " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PPCCompilerTest.st --- 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PPCIdGeneratorTest.st --- /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'. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PPCLTokenizingOptimizationTest.st --- 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'! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PPCOverlappingTokensTest.st --- /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:' +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PPCScannerCodeGeneratorTest.st --- 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. diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PPCTokenizingCodeGeneratorTest.st --- 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'. ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PPCTokenizingTest.st --- 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. ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PPCTokenizingVisitorTest.st --- 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 ]). ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/PPCUniversalTest.st --- 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 " ! ! !PPCUniversalTest methodsFor:'tests - compiling'! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/abbrev.stc --- 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/bc.mak --- 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) diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/Make.proto --- 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/Make.spec --- 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) \ diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCAbstractParserTest.st --- /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 " +! ! + +!PPCAbstractParserTest methodsFor:'accessing'! + +compiledParser + ^ self compiledParserClass new + + "Created: / 29-07-2015 / 17:00:04 / Jan Vrany " +! + +compiledParserClass + ^ Smalltalk at: self compiledParserClassName + + "Created: / 29-07-2015 / 16:54:01 / Jan Vrany " +! + +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 " +! + +compiledScannerClassName + "Return the name of the compiled parser" + + ^ (self petitParserClass name , 'C_Scanner') asSymbol + "Created: / 29-07-2015 / 16:54:01 / Jan Vrany " +! + +compilerConfiguration + "Return configuration to use when compiling parser (as instance of PPCConfiguration)" + + ^ self subclassResponsibility + + "Created: / 29-07-2015 / 16:53:22 / Jan Vrany " +! + +parserClass + ^ self compiledParserClass + + "Modified: / 29-07-2015 / 18:43:08 / Jan Vrany " +! + +parserInstanceFor: aSymbol + ^ self parserClass new startSymbol: aSymbol + + "Modified: / 29-07-2015 / 18:43:43 / Jan Vrany " +! + +petitParser + ^ self petitParserClass new + + "Created: / 29-07-2015 / 17:01:41 / Jan Vrany " +! + +petitParserClass + "Return the name of the petit parser to compile" + + ^ self subclassResponsibility + + "Created: / 29-07-2015 / 17:01:17 / Jan Vrany " +! ! + +!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 " + "Modified: / 29-07-2015 / 18:40:47 / Jan Vrany " +! + +tearDownAfter + "Called after all my tests are ryn(when resources are torn down)" + + "Created: / 29-07-2015 / 16:33:46 / Jan Vrany " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCCompositeParserTest.st --- /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 " +! ! + +!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 " + "Modified: / 31-07-2015 / 07:27:03 / Jan Vrany " +! + +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 " +! ! + +!PPCCompositeParserTest methodsFor:'accessing'! + +compiledParser + ^ self compiledParserClass new + + "Created: / 29-07-2015 / 17:00:04 / Jan Vrany " +! + +compiledParserClass + ^ Smalltalk at: self compiledParserClassName + + "Created: / 29-07-2015 / 16:54:01 / Jan Vrany " +! + +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 " +! + +compilerConfiguration + "Return configuration to use when compiling parser (as instance of PPCConfiguration)" + + ^ self subclassResponsibility + + "Created: / 29-07-2015 / 16:53:22 / Jan Vrany " +! + +parserClass + ^ self compiledParserClass + + "Modified: / 29-07-2015 / 18:43:08 / Jan Vrany " +! + +parserInstanceFor: aSymbol + ^ self parserClass new startSymbol: aSymbol + + "Modified: / 29-07-2015 / 18:43:43 / Jan Vrany " +! + +petitParser + ^ self petitParserClass new + + "Created: / 29-07-2015 / 17:01:41 / Jan Vrany " +! + +petitParserClass + "Return the name of the petit parser to compile" + + ^ self subclassResponsibility + + "Created: / 29-07-2015 / 17:01:17 / Jan Vrany " +! ! + +!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 " + "Modified: / 29-07-2015 / 18:40:47 / Jan Vrany " +! + +tearDownAfter + "Called after all my tests are ryn(when resources are torn down)" + + "Created: / 29-07-2015 / 16:33:46 / Jan Vrany " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCExpressionGrammarTest.st --- /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 " +! + +compiledParserClass + ^ Smalltalk at: self compiledParserClassName + + "Created: / 29-07-2015 / 16:54:01 / Jan Vrany " +! + +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 " +! + +compilerConfiguration + "Return configuration to use when compiling parser (as instance of PPCConfiguration)" + + ^ self subclassResponsibility + + "Created: / 29-07-2015 / 16:53:22 / Jan Vrany " +! + +parserClass + ^ self compiledParserClass + + "Modified: / 29-07-2015 / 18:43:08 / Jan Vrany " +! + +parserInstanceFor: aSymbol + ^ self parserClass new startSymbol: aSymbol + + "Modified: / 29-07-2015 / 18:43:43 / Jan Vrany " +! + +petitParser + ^ self petitParserClass new + + "Created: / 29-07-2015 / 17:01:41 / Jan Vrany " +! + +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 " + "Modified: / 29-07-2015 / 18:40:47 / Jan Vrany " +! + +tearDownAfter + "Called after all my tests are ryn(when resources are torn down)" + + "Created: / 29-07-2015 / 16:33:46 / Jan Vrany " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCExpressionGrammarTest_Tokenized.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCExpressionGrammarTest_Universal.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCExpressionGrammarVerificationTest.st --- /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 " +! ! + +!PPCExpressionGrammarVerificationTest methodsFor:'accessing'! + +petitParserClass + "Return the name of the petit parser to compile" + + ^ PPExpressionGrammar + + "Modified: / 29-07-2015 / 17:08:08 / Jan Vrany " +! ! + +!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 " +! + +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 " +! ! + +!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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCExpressionsVerificationTest.st --- 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. -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLL1ExpressionGrammarTest.st --- /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 " +! + +compiledParserClass + ^ Smalltalk at: self compiledParserClassName + + "Created: / 29-07-2015 / 16:54:01 / Jan Vrany " +! + +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 " +! + +compilerConfiguration + "Return configuration to use when compiling parser (as instance of PPCConfiguration)" + + ^ self subclassResponsibility + + "Created: / 29-07-2015 / 16:53:22 / Jan Vrany " +! + +parserClass + ^ self compiledParserClass + + "Modified: / 29-07-2015 / 18:43:08 / Jan Vrany " +! + +parserInstanceFor: aSymbol + ^ self parserClass new startSymbol: aSymbol + + "Modified: / 29-07-2015 / 18:43:43 / Jan Vrany " +! + +petitParser + ^ self petitParserClass new + + "Created: / 29-07-2015 / 17:01:41 / Jan Vrany " +! + +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 " + "Modified: / 29-07-2015 / 18:40:47 / Jan Vrany " +! + +tearDownAfter + "Called after all my tests are ryn(when resources are torn down)" + + "Created: / 29-07-2015 / 16:33:46 / Jan Vrany " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLL1ExpressionGrammarTest_Tokenized.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLL1ExpressionGrammarTest_Universal.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPAction.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPComment.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPContainedElement.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPEpsilonTransition.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPErrorNode.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPEvent.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPMachine.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPNode.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPOnEntry.st --- /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' +! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPOnExit.st --- /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' +! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPParser.st --- /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 " +! + +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 " +! + +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 " +! + +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 " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPParserSmokeTest.st --- /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 " +! ! + +!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 " +! ! + +!PPCLRPParserSmokeTest methodsFor:'tests'! + +testSmoke1 + PPCLRPSourcesResource current sources do:[:source | + self parse: source + ]. + + "Created: / 30-07-2015 / 19:07:22 / Jan Vrany " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPParserVerificationTest.st --- /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 " +! ! + +!PPCLRPParserVerificationTest methodsFor:'accessing'! + +compiledParser + ^ self compiledParserClass new + + "Created: / 29-07-2015 / 17:00:04 / Jan Vrany " +! + +compiledParserClass + ^ Smalltalk at: self compiledParserClassName + + "Created: / 29-07-2015 / 16:54:01 / Jan Vrany " +! + +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 " +! + +compilerConfiguration + "Return configuration to use when compiling parser (as instance of PPCConfiguration)" + + ^ self subclassResponsibility + + "Created: / 29-07-2015 / 16:53:22 / Jan Vrany " +! + +parserClass + ^ self compiledParserClass + + "Modified: / 29-07-2015 / 18:43:08 / Jan Vrany " +! + +parserInstanceFor: aSymbol + ^ self parserClass new startSymbol: aSymbol + + "Modified: / 29-07-2015 / 18:43:43 / Jan Vrany " +! + +petitParser + ^ self petitParserClass new + + "Created: / 29-07-2015 / 17:01:41 / Jan Vrany " +! + +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 " + "Modified: / 29-07-2015 / 18:40:47 / Jan Vrany " +! + +tearDownAfter + "Called after all my tests are ryn(when resources are torn down)" + + "Created: / 29-07-2015 / 16:33:46 / Jan Vrany " +! ! + +!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 " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPParserVerificationTest_Tokenized.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPParserVerificationTest_Universal.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPRunning.st --- /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' +! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPSourcesResource.st --- /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 " +! ! + +!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 " +! + +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 " +! + +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 " +! + +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 " +! + +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 " +! + +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 " +! + +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 " +! + +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 " +! + +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 " +! + +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 " +! ! + +!PPCLRPSourcesResource class methodsFor:'documentation'! + +version_HG + + ^ '$Changeset: $' +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPSpawn.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPState.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPTimeoutTransition.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPTransition.st --- /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. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPVariable.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCLRPWildcardTransition.st --- /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. + +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCResources.st --- 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. ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCSetUpBeforeTearDownAfterResource.st --- /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 " +! ! + +!PPCSetUpBeforeTearDownAfterResource class methodsFor:'accessing'! + +testCaseClass + ^ testCaseClass + + "Created: / 29-07-2015 / 16:19:23 / Jan Vrany " +! + +testCaseClass: aClass + testCaseClass := aClass + + "Created: / 29-07-2015 / 16:19:36 / Jan Vrany " +! ! + +!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 " +! ! + +!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 " + "Modified (format): / 30-07-2015 / 07:48:30 / Jan Vrany " +! ! + +!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 " +! + +tearDown + | testCaseClass | + + testCaseClass := self class testCaseClass. + (testCaseClass lookupSelector: #tearDownAfter) notNil ifTrue:[ + testCaseClass new tearDownAfter + ]. + + "Created: / 29-07-2015 / 16:33:34 / Jan Vrany " +! ! + + +PPCSetUpBeforeTearDownAfterResource initialize! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCSmalltalkGrammarTests.st --- /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 " +! + +compiledParserClass + ^ Smalltalk at: self compiledParserClassName + + "Created: / 29-07-2015 / 16:54:01 / Jan Vrany " +! + +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 " +! + +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 " +! + +parserClass + ^ self compiledParserClass + + "Modified: / 29-07-2015 / 18:43:08 / Jan Vrany " +! + +parserInstanceFor: aSymbol + ^ self parserClass new startSymbol: aSymbol + + "Modified: / 29-07-2015 / 18:43:43 / Jan Vrany " +! + +petitParser + ^ self petitParserClass new + + "Created: / 29-07-2015 / 17:01:41 / Jan Vrany " +! + +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 " + "Modified: / 29-07-2015 / 18:40:47 / Jan Vrany " +! + +tearDownAfter + "Called after all my tests are ryn(when resources are torn down)" + + "Created: / 29-07-2015 / 16:33:46 / Jan Vrany " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCSmalltalkGrammarTests_Tokenized.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCSmalltalkGrammarTests_Universal.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCSmalltalkGrammarVerificationTest.st --- /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 " +! ! + +!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). + ]. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCSmalltalkGrammarVerificationTest_Tokenized.st --- /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 " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCSmalltalkGrammarVerificationTest_Universal.st --- /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 " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCSmalltalkParserTests.st --- /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 " +! + +compiledParserClass + ^ Smalltalk at: self compiledParserClassName + + "Created: / 29-07-2015 / 16:54:01 / Jan Vrany " +! + +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 " +! + +compilerConfiguration + "Return configuration to use when compiling parser (as instance of PPCConfiguration)" + + ^ self subclassResponsibility + + "Created: / 29-07-2015 / 16:53:22 / Jan Vrany " +! + +parserClass + ^ self compiledParserClass + + "Modified: / 29-07-2015 / 18:43:08 / Jan Vrany " +! + +parserInstanceFor: aSymbol + ^ self parserClass new startSymbol: aSymbol + + "Modified: / 29-07-2015 / 18:43:43 / Jan Vrany " +! + +petitParser + ^ self petitParserClass new + + "Created: / 29-07-2015 / 17:01:41 / Jan Vrany " +! + +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 " + "Modified: / 29-07-2015 / 18:40:47 / Jan Vrany " +! + +tearDownAfter + "Called after all my tests are ryn(when resources are torn down)" + + "Created: / 29-07-2015 / 16:33:46 / Jan Vrany " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCSmalltalkParserTests_Tokenized.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCSmalltalkParserTests_Universal.st --- /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 +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCSmalltalkParserVerificationTest.st --- /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 " +! ! + +!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). + ]. +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCSmalltalkParserVerificationTest_Tokenized.st --- /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 " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCSmalltalkParserVerificationTest_Universal.st --- /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 " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCSmalltalkTests.st --- 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 " ! ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCSmalltalkVerificationTest.st --- 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). - ]. -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCompiledExpressionGrammarResource.st --- 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. - -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCompiledExpressionGrammarTest.st --- 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. -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCompiledExpressionsVerificationTest.st --- 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 -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCompiledSmalltalkGrammarResource.st --- 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 " -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCompiledSmalltalkGrammarTests.st --- 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 ' - rule: #method -! - -testPragma10 - self - parse: 'method ' - rule: #method -! - -testPragma11 - self - parse: 'method ' - rule: #method -! - -testPragma12 - self - parse: 'method ' - rule: #method -! - -testPragma13 - self - parse: 'method ' - rule: #method -! - -testPragma14 - self - parse: 'method ' - rule: #method -! - -testPragma15 - self - parse: 'method ' - rule: #method -! - -testPragma16 - self - parse: 'method < + 1 >' - rule: #method -! - -testPragma2 - self - parse: 'method ' - rule: #method -! - -testPragma3 - self - parse: 'method | a | ' - rule: #method -! - -testPragma4 - self - parse: 'method | a |' - rule: #method -! - -testPragma5 - self - parse: 'method | a | ' - rule: #method -! - -testPragma6 - self - parse: 'method ' - rule: #method -! - -testPragma7 - self - parse: 'method ' - rule: #method -! - -testPragma8 - self - parse: 'method ' - rule: #method -! - -testPragma9 - self - parse: 'method ' - rule: #method -! ! - -!PPCompiledSmalltalkGrammarTests class methodsFor:'documentation'! - -version_HG - - ^ '$Changeset: $' -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCompiledSmalltalkParserResource.st --- 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 " -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCompiledSmalltalkParserTests.st --- 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 -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPCompiledSmalltalkVerificationTest.st --- 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 -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPExpressionGrammarVerificationTest_Tokenized.st --- /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 " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPExpressionGrammarVerificationTest_Universal.st --- /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 " +! ! + diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPLL1ExpressionGrammar.st --- 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 " + "Modified (format): / 26-05-2015 / 07:23:34 / Jan Vrany " ! 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 " ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPLL1ExpressionGrammarTest.st --- 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 = '+'. diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPTokenizedExpressionGrammarResource.st --- 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 " -! ! - -!PPTokenizedExpressionGrammarResource class methodsFor:'documentation'! - -version_HG - - ^ '$Changeset: $' -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPTokenizedExpressionGrammarTest.st --- 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. -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPTokenizedExpressionsVerificationTest.st --- 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 -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPTokenizedLL1ExpressionGrammarResource.st --- 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 " -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPTokenizedLL1ExpressionGrammarTest.st --- 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. -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPTokenizedSmalltalkGrammarResource.st --- 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 " -! - -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: $' -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPTokenizedSmalltalkGrammarTests.st --- 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 ' - rule: #method -! - -testPragma10 - self - parse: 'method ' - rule: #method -! - -testPragma11 - self - parse: 'method ' - rule: #method -! - -testPragma12 - self - parse: 'method ' - rule: #method -! - -testPragma13 - self - parse: 'method ' - rule: #method -! - -testPragma14 - self - parse: 'method ' - rule: #method -! - -testPragma15 - self - parse: 'method ' - rule: #method -! - -testPragma16 - self - parse: 'method < + 1 >' - rule: #method -! - -testPragma2 - self - parse: 'method ' - rule: #method -! - -testPragma3 - self - parse: 'method | a | ' - rule: #method -! - -testPragma4 - self - parse: 'method | a |' - rule: #method -! - -testPragma5 - self - parse: 'method | a | ' - rule: #method -! - -testPragma6 - self - parse: 'method ' - rule: #method -! - -testPragma7 - self - parse: 'method ' - rule: #method -! - -testPragma8 - self - parse: 'method ' - rule: #method -! - -testPragma9 - self - parse: 'method ' - rule: #method -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPTokenizedSmalltalkParserResource.st --- 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 " -! - -tearDown - | parserClass | - super tearDown. - - parserClass := (Smalltalk at: #PPTokenizedSmalltalkParser ifAbsent: [nil]). - self flag: 'uncomment:'. -" - parserClass notNil ifTrue:[ - parserClass removeFromSystem - ]. -" -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPTokenizedSmalltalkParserTests.st --- 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 ' - rule: #method -! - -testPragma10 - self - parse: 'method ' - rule: #method -! - -testPragma11 - self - parse: 'method ' - rule: #method -! - -testPragma12 - self - parse: 'method ' - rule: #method -! - -testPragma13 - self - parse: 'method ' - rule: #method -! - -testPragma14 - self - parse: 'method ' - rule: #method -! - -testPragma15 - self - parse: 'method ' - rule: #method -! - -testPragma16 - self - parse: 'method < + 1 >' - rule: #method -! - -testPragma2 - self - parse: 'method ' - rule: #method -! - -testPragma3 - self - parse: 'method | a | ' - rule: #method -! - -testPragma4 - self - parse: 'method | a |' - rule: #method -! - -testPragma5 - self - parse: 'method | a | ' - rule: #method -! - -testPragma6 - self - parse: 'method ' - rule: #method -! - -testPragma7 - self - parse: 'method ' - rule: #method -! - -testPragma8 - self - parse: 'method ' - rule: #method -! - -testPragma9 - self - parse: 'method ' - rule: #method -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPTokenizedSmalltalkParserVerificationTest.st --- 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 -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/PPTokenizedSmalltalkVerificationTest.st --- 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 -! ! - diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/abbrev.stc --- 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/bc.mak --- 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 diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/libInit.cc --- 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__(); diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/extras/stx_goodies_petitparser_compiler_tests_extras.st --- 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 @@ ^ #( " or ( 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 ) ! diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/libInit.cc --- 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); diff -r 1e45d3c96ec5 -r b5316ef15274 compiler/tests/stx_goodies_petitparser_compiler_tests.st --- 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 @@ ^ #( " or ( 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