Updated to PetitCompiler-JanKurs.111, PetitCompiler-Tests-JanKurs.51, PetitCompiler-Benchmarks-JanKurs.7, added PetitCompiler-Extras-Tests-JanKurs.4
Name: PetitCompiler-JanKurs.111
Author: JanKurs
Time: 08-05-2015, 05:56:05.327 PM
UUID: 8805e696-9933-49b8-a5c8-a963b931b996
Name: PetitCompiler-Tests-JanKurs.51
Author: JanKurs
Time: 08-05-2015, 05:17:44.224 PM
UUID: 21c24114-73be-4ba2-86cd-5a4402f778a0
Name: PetitCompiler-Benchmarks-JanKurs.7
Author: JanKurs
Time: 07-05-2015, 06:06:12.918 PM
UUID: 0e6e2c0a-90f6-4f46-9663-c66f636da602
Name: PetitCompiler-Extras-Tests-JanKurs.4
Author: JanKurs
Time: 08-05-2015, 05:56:46.180 PM
UUID: 4d4d4d23-c5bc-41ef-ad41-8a56528ddb42
--- a/compiler/Make.proto Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/Make.proto Sun May 10 06:28:36 2015 +0100
@@ -135,6 +135,8 @@
$(OUTDIR)PPCBridge.$(O) PPCBridge.$(H): PPCBridge.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCCompiledMethod.$(O) PPCCompiledMethod.$(H): PPCCompiledMethod.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCCompiler.$(O) PPCCompiler.$(H): PPCCompiler.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCCompilerTokenRememberStrategy.$(O) PPCCompilerTokenRememberStrategy.$(H): PPCCompilerTokenRememberStrategy.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCCompilerTokenizingRememberStrategy.$(O) PPCCompilerTokenizingRememberStrategy.$(H): PPCCompilerTokenizingRememberStrategy.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCConfiguration.$(O) PPCConfiguration.$(H): PPCConfiguration.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(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)
@@ -142,6 +144,7 @@
$(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)PPCompiledParser.$(O) PPCompiledParser.$(H): PPCompiledParser.st $(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)PPCAbstractCharacterNode.$(O) PPCAbstractCharacterNode.$(H): PPCAbstractCharacterNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
@@ -151,23 +154,27 @@
$(OUTDIR)PPCCodeGenerator.$(O) PPCCodeGenerator.$(H): PPCCodeGenerator.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNodeVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCDelegateNode.$(O) PPCDelegateNode.$(H): PPCDelegateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCEndOfFileNode.$(O) PPCEndOfFileNode.$(H): PPCEndOfFileNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCFirstPrototype.$(O) PPCFirstPrototype.$(H): PPCFirstPrototype.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCConfiguration.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCInlinedMethod.$(O) PPCInlinedMethod.$(H): PPCInlinedMethod.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCMethod.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCInliningVisitor.$(O) PPCInliningVisitor.$(H): PPCInliningVisitor.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNodeVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLL1Configuration.$(O) PPCLL1Configuration.$(H): PPCLL1Configuration.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCConfiguration.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCListNode.$(O) PPCListNode.$(H): PPCListNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCNilNode.$(O) PPCNilNode.$(H): PPCNilNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCPluggableConfiguration.$(O) PPCPluggableConfiguration.$(H): PPCPluggableConfiguration.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCConfiguration.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(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)PPCTokenizingCompiler.$(O) PPCTokenizingCompiler.$(H): PPCTokenizingCompiler.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCCompiler.$(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)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)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)
$(OUTDIR)PPCCharacterNode.$(O) PPCCharacterNode.$(H): PPCCharacterNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractCharacterNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCChoiceNode.$(O) PPCChoiceNode.$(H): PPCChoiceNode.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)PPCCopyVisitor.$(O) PPCCopyVisitor.$(H): PPCCopyVisitor.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)PPCEndOfInputNode.$(O) PPCEndOfInputNode.$(H): PPCEndOfInputNode.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)PPCForwardNode.$(O) PPCForwardNode.$(H): PPCForwardNode.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)PPCLL1Visitor.$(O) PPCLL1Visitor.$(H): PPCLL1Visitor.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)PPCLiteralNode.$(O) PPCLiteralNode.$(H): PPCLiteralNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractLiteralNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCMergingVisitor.$(O) PPCMergingVisitor.$(H): PPCMergingVisitor.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)PPCMessagePredicateNode.$(O) PPCMessagePredicateNode.$(H): PPCMessagePredicateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractPredicateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
@@ -176,30 +183,37 @@
$(OUTDIR)PPCNotLiteralNode.$(O) PPCNotLiteralNode.$(H): PPCNotLiteralNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractLiteralNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCNotMessagePredicateNode.$(O) PPCNotMessagePredicateNode.$(H): PPCNotMessagePredicateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractPredicateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCNotNode.$(O) PPCNotNode.$(H): PPCNotNode.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)PPCOptimizingVisitor.$(O) PPCOptimizingVisitor.$(H): PPCOptimizingVisitor.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)PPCOptimizeChoices.$(O) PPCOptimizeChoices.$(H): PPCOptimizeChoices.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)PPCOptionalNode.$(O) PPCOptionalNode.$(H): PPCOptionalNode.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)PPCPlusNode.$(O) PPCPlusNode.$(H): PPCPlusNode.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)PPCPredicateNode.$(O) PPCPredicateNode.$(H): PPCPredicateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractPredicateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCRecognizerComponentDetector.$(O) PPCRecognizerComponentDetector.$(H): PPCRecognizerComponentDetector.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)PPCRecognizerComponentVisitor.$(O) PPCRecognizerComponentVisitor.$(H): PPCRecognizerComponentVisitor.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)PPCSentinelNode.$(O) PPCSentinelNode.$(H): PPCSentinelNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNilNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(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)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)
$(OUTDIR)PPCTokenVisitor.$(O) PPCTokenVisitor.$(H): PPCTokenVisitor.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)PPCTokenWhitespaceNode.$(O) PPCTokenWhitespaceNode.$(H): PPCTokenWhitespaceNode.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)PPCTokenizingCodeGenerator.$(O) PPCTokenizingCodeGenerator.$(H): PPCTokenizingCodeGenerator.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)PPCTrimNode.$(O) PPCTrimNode.$(H): PPCTrimNode.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)PPCTokenizingParserNode.$(O) PPCTokenizingParserNode.$(H): PPCTokenizingParserNode.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)PPCTokenizingVisitor.$(O) PPCTokenizingVisitor.$(H): PPCTokenizingVisitor.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)PPCTrimmingTokenNode.$(O) PPCTrimmingTokenNode.$(H): PPCTrimmingTokenNode.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)PPCActionNode.$(O) PPCActionNode.$(H): PPCActionNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractActionNode.$(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)PPCLLChoiceNode.$(O) PPCLLChoiceNode.$(H): PPCLLChoiceNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCChoiceNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCListNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCDeterministicChoiceNode.$(O) PPCDeterministicChoiceNode.$(H): PPCDeterministicChoiceNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCChoiceNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCListNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCRecognizingSequenceNode.$(O) PPCRecognizingSequenceNode.$(H): PPCRecognizingSequenceNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCListNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCSequenceNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCStarAnyNode.$(O) PPCStarAnyNode.$(H): PPCStarAnyNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCDelegateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCStarNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCStarCharSetPredicateNode.$(O) PPCStarCharSetPredicateNode.$(H): PPCStarCharSetPredicateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCDelegateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCStarNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCStarMessagePredicateNode.$(O) PPCStarMessagePredicateNode.$(H): PPCStarMessagePredicateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCDelegateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCStarNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCSymbolActionNode.$(O) PPCSymbolActionNode.$(H): PPCSymbolActionNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractActionNode.$(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)PPCTokenSequenceNode.$(O) PPCTokenSequenceNode.$(H): PPCTokenSequenceNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCListNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCSequenceNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCTokenChoiceNode.$(O) PPCTokenChoiceNode.$(H): PPCTokenChoiceNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCChoiceNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCListNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCTrimNode.$(O) PPCTrimNode.$(H): PPCTrimNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCListNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCSequenceNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)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/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/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)
# ENDMAKEDEPEND --- do not remove this line
--- a/compiler/Make.spec Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/Make.spec Sun May 10 06:28:36 2015 +0100
@@ -55,6 +55,8 @@
PPCBridge \
PPCCompiledMethod \
PPCCompiler \
+ PPCCompilerTokenRememberStrategy \
+ PPCCompilerTokenizingRememberStrategy \
PPCConfiguration \
PPCContext \
PPCContextMemento \
@@ -62,6 +64,7 @@
PPCMethod \
PPCNode \
PPCNodeVisitor \
+ PPCPluggableConfiguration \
PPCompiledParser \
stx_goodies_petitparser_compiler \
PPCAbstractCharacterNode \
@@ -71,23 +74,27 @@
PPCCodeGenerator \
PPCDelegateNode \
PPCEndOfFileNode \
- PPCFirstPrototype \
PPCInlinedMethod \
PPCInliningVisitor \
+ PPCLL1Configuration \
PPCListNode \
PPCNilNode \
- PPCPluggableConfiguration \
PPCPluggableNode \
PPCProfilingContext \
PPCRewritingVisitor \
+ PPCTokenizingCompiler \
+ PPCUniversalConfiguration \
PPCUnknownNode \
+ PPTokenizingCompiledParser \
PPCAbstractActionNode \
PPCAndNode \
PPCCharSetPredicateNode \
PPCCharacterNode \
PPCChoiceNode \
PPCCopyVisitor \
+ PPCEndOfInputNode \
PPCForwardNode \
+ PPCLL1Visitor \
PPCLiteralNode \
PPCMergingVisitor \
PPCMessagePredicateNode \
@@ -96,27 +103,34 @@
PPCNotLiteralNode \
PPCNotMessagePredicateNode \
PPCNotNode \
- PPCOptimizingVisitor \
+ PPCOptimizeChoices \
PPCOptionalNode \
PPCPlusNode \
PPCPredicateNode \
+ PPCRecognizerComponentDetector \
+ PPCRecognizerComponentVisitor \
PPCSentinelNode \
PPCSequenceNode \
+ PPCSpecializingVisitor \
PPCStarNode \
PPCTokenConsumeNode \
PPCTokenDetector \
PPCTokenNode \
PPCTokenVisitor \
+ PPCTokenWhitespaceNode \
PPCTokenizingCodeGenerator \
- PPCTrimNode \
+ PPCTokenizingParserNode \
+ PPCTokenizingVisitor \
PPCTrimmingTokenNode \
PPCActionNode \
- PPCLLChoiceNode \
+ PPCDeterministicChoiceNode \
+ PPCRecognizingSequenceNode \
PPCStarAnyNode \
PPCStarCharSetPredicateNode \
PPCStarMessagePredicateNode \
PPCSymbolActionNode \
- PPCTokenSequenceNode \
+ PPCTokenChoiceNode \
+ PPCTrimNode \
PPCTokenStarMessagePredicateNode \
PPCTokenStarSeparatorNode \
@@ -128,6 +142,8 @@
$(OUTDIR_SLASH)PPCBridge.$(O) \
$(OUTDIR_SLASH)PPCCompiledMethod.$(O) \
$(OUTDIR_SLASH)PPCCompiler.$(O) \
+ $(OUTDIR_SLASH)PPCCompilerTokenRememberStrategy.$(O) \
+ $(OUTDIR_SLASH)PPCCompilerTokenizingRememberStrategy.$(O) \
$(OUTDIR_SLASH)PPCConfiguration.$(O) \
$(OUTDIR_SLASH)PPCContext.$(O) \
$(OUTDIR_SLASH)PPCContextMemento.$(O) \
@@ -135,6 +151,7 @@
$(OUTDIR_SLASH)PPCMethod.$(O) \
$(OUTDIR_SLASH)PPCNode.$(O) \
$(OUTDIR_SLASH)PPCNodeVisitor.$(O) \
+ $(OUTDIR_SLASH)PPCPluggableConfiguration.$(O) \
$(OUTDIR_SLASH)PPCompiledParser.$(O) \
$(OUTDIR_SLASH)stx_goodies_petitparser_compiler.$(O) \
$(OUTDIR_SLASH)PPCAbstractCharacterNode.$(O) \
@@ -144,23 +161,27 @@
$(OUTDIR_SLASH)PPCCodeGenerator.$(O) \
$(OUTDIR_SLASH)PPCDelegateNode.$(O) \
$(OUTDIR_SLASH)PPCEndOfFileNode.$(O) \
- $(OUTDIR_SLASH)PPCFirstPrototype.$(O) \
$(OUTDIR_SLASH)PPCInlinedMethod.$(O) \
$(OUTDIR_SLASH)PPCInliningVisitor.$(O) \
+ $(OUTDIR_SLASH)PPCLL1Configuration.$(O) \
$(OUTDIR_SLASH)PPCListNode.$(O) \
$(OUTDIR_SLASH)PPCNilNode.$(O) \
- $(OUTDIR_SLASH)PPCPluggableConfiguration.$(O) \
$(OUTDIR_SLASH)PPCPluggableNode.$(O) \
$(OUTDIR_SLASH)PPCProfilingContext.$(O) \
$(OUTDIR_SLASH)PPCRewritingVisitor.$(O) \
+ $(OUTDIR_SLASH)PPCTokenizingCompiler.$(O) \
+ $(OUTDIR_SLASH)PPCUniversalConfiguration.$(O) \
$(OUTDIR_SLASH)PPCUnknownNode.$(O) \
+ $(OUTDIR_SLASH)PPTokenizingCompiledParser.$(O) \
$(OUTDIR_SLASH)PPCAbstractActionNode.$(O) \
$(OUTDIR_SLASH)PPCAndNode.$(O) \
$(OUTDIR_SLASH)PPCCharSetPredicateNode.$(O) \
$(OUTDIR_SLASH)PPCCharacterNode.$(O) \
$(OUTDIR_SLASH)PPCChoiceNode.$(O) \
$(OUTDIR_SLASH)PPCCopyVisitor.$(O) \
+ $(OUTDIR_SLASH)PPCEndOfInputNode.$(O) \
$(OUTDIR_SLASH)PPCForwardNode.$(O) \
+ $(OUTDIR_SLASH)PPCLL1Visitor.$(O) \
$(OUTDIR_SLASH)PPCLiteralNode.$(O) \
$(OUTDIR_SLASH)PPCMergingVisitor.$(O) \
$(OUTDIR_SLASH)PPCMessagePredicateNode.$(O) \
@@ -169,27 +190,34 @@
$(OUTDIR_SLASH)PPCNotLiteralNode.$(O) \
$(OUTDIR_SLASH)PPCNotMessagePredicateNode.$(O) \
$(OUTDIR_SLASH)PPCNotNode.$(O) \
- $(OUTDIR_SLASH)PPCOptimizingVisitor.$(O) \
+ $(OUTDIR_SLASH)PPCOptimizeChoices.$(O) \
$(OUTDIR_SLASH)PPCOptionalNode.$(O) \
$(OUTDIR_SLASH)PPCPlusNode.$(O) \
$(OUTDIR_SLASH)PPCPredicateNode.$(O) \
+ $(OUTDIR_SLASH)PPCRecognizerComponentDetector.$(O) \
+ $(OUTDIR_SLASH)PPCRecognizerComponentVisitor.$(O) \
$(OUTDIR_SLASH)PPCSentinelNode.$(O) \
$(OUTDIR_SLASH)PPCSequenceNode.$(O) \
+ $(OUTDIR_SLASH)PPCSpecializingVisitor.$(O) \
$(OUTDIR_SLASH)PPCStarNode.$(O) \
$(OUTDIR_SLASH)PPCTokenConsumeNode.$(O) \
$(OUTDIR_SLASH)PPCTokenDetector.$(O) \
$(OUTDIR_SLASH)PPCTokenNode.$(O) \
$(OUTDIR_SLASH)PPCTokenVisitor.$(O) \
+ $(OUTDIR_SLASH)PPCTokenWhitespaceNode.$(O) \
$(OUTDIR_SLASH)PPCTokenizingCodeGenerator.$(O) \
- $(OUTDIR_SLASH)PPCTrimNode.$(O) \
+ $(OUTDIR_SLASH)PPCTokenizingParserNode.$(O) \
+ $(OUTDIR_SLASH)PPCTokenizingVisitor.$(O) \
$(OUTDIR_SLASH)PPCTrimmingTokenNode.$(O) \
$(OUTDIR_SLASH)PPCActionNode.$(O) \
- $(OUTDIR_SLASH)PPCLLChoiceNode.$(O) \
+ $(OUTDIR_SLASH)PPCDeterministicChoiceNode.$(O) \
+ $(OUTDIR_SLASH)PPCRecognizingSequenceNode.$(O) \
$(OUTDIR_SLASH)PPCStarAnyNode.$(O) \
$(OUTDIR_SLASH)PPCStarCharSetPredicateNode.$(O) \
$(OUTDIR_SLASH)PPCStarMessagePredicateNode.$(O) \
$(OUTDIR_SLASH)PPCSymbolActionNode.$(O) \
- $(OUTDIR_SLASH)PPCTokenSequenceNode.$(O) \
+ $(OUTDIR_SLASH)PPCTokenChoiceNode.$(O) \
+ $(OUTDIR_SLASH)PPCTrimNode.$(O) \
$(OUTDIR_SLASH)PPCTokenStarMessagePredicateNode.$(O) \
$(OUTDIR_SLASH)PPCTokenStarSeparatorNode.$(O) \
$(OUTDIR_SLASH)extensions.$(O) \
--- a/compiler/PPCAbstractActionNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCAbstractActionNode.st Sun May 10 06:28:36 2015 +0100
@@ -13,28 +13,28 @@
!PPCAbstractActionNode methodsFor:'accessing'!
block
-
- ^ block
+
+ ^ block
!
block: anObject
-
- block := anObject
+
+ block := anObject
!
prefix
- ^ #action
+ ^ #action
! !
!PPCAbstractActionNode methodsFor:'comparing'!
= anotherNode
- super = anotherNode ifFalse: [ ^ false ].
- ^ block = anotherNode block.
+ super = anotherNode ifFalse: [ ^ false ].
+ ^ block = anotherNode block.
!
hash
- ^ super hash bitXor: block hash
+ ^ super hash bitXor: block hash
! !
!PPCAbstractActionNode class methodsFor:'documentation'!
--- a/compiler/PPCAbstractCharacterNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCAbstractCharacterNode.st Sun May 10 06:28:36 2015 +0100
@@ -13,55 +13,73 @@
!PPCAbstractCharacterNode methodsFor:'accessing'!
character
- ^ character
+ ^ character
!
character: char
- character := char
+ character := char
!
prefix
- ^ #char
+ ^ #char
! !
!PPCAbstractCharacterNode methodsFor:'analysis'!
acceptsEpsilon
- ^ false
+ ^ false
!
firstCharSet
- ^ PPCharSetPredicate on: [:e | e = character ]
+ ^ PPCharSetPredicate on: [:e | e = character ]
+!
+
+recognizedSentencesPrim
+ ^ Array with: character asString
! !
!PPCAbstractCharacterNode methodsFor:'comparison'!
= anotherNode
- super = anotherNode ifFalse: [ ^ false ].
- ^ character = anotherNode character.
+ super = anotherNode ifFalse: [ ^ false ].
+ ^ character = anotherNode character.
!
hash
- ^ super hash bitXor: character hash
+ ^ super hash bitXor: character hash
! !
!PPCAbstractCharacterNode methodsFor:'compiling'!
body: compiler
- | id |
-
- character ppcPrintable ifTrue: [
- id := character storeString
- ] ifFalse: [
- id := compiler idFor: character prefixed: #char.
- compiler addConstant: (Character value: character asInteger) as: id .
- ].
-
- compiler add: '(context peek == ', id, ')'.
- compiler indent.
- compiler add: 'ifFalse: [ self error: ''', character asInteger asString, ' expected'' at: context position ] '.
- compiler add: 'ifTrue: [ context next ].'.
- compiler dedent.
+ | id |
+
+ character ppcPrintable ifTrue: [
+ id := character storeString
+ ] ifFalse: [
+ id := compiler idFor: character prefixed: #char.
+ compiler addConstant: (Character value: character asInteger) as: id .
+ ].
+
+ compiler add: '(context peek == ', id, ')'.
+ compiler indent.
+ compiler add: 'ifFalse: [ self error: ''', character asInteger asString, ' expected'' at: context position ] '.
+ compiler add: 'ifTrue: [ context next ].'.
+ compiler dedent.
+! !
+
+!PPCAbstractCharacterNode methodsFor:'printing'!
+
+printNameOn: aStream
+ super printNameOn: aStream.
+
+ character = $" ifTrue: [
+ "this is hack to allow for printing '' in comments..."
+ aStream nextPutAll: ', '; nextPutAll: '$'''''.
+ ^ self
+ ].
+
+ aStream nextPutAll: ', '; print: character
! !
!PPCAbstractCharacterNode class methodsFor:'documentation'!
--- a/compiler/PPCAbstractLiteralNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCAbstractLiteralNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,51 +12,51 @@
!PPCAbstractLiteralNode methodsFor:'accessing'!
literal
-
- ^ literal
+
+ ^ literal
!
literal: anObject
-
- literal := anObject
+
+ literal := anObject
!
prefix
- ^ #lit
+ ^ #lit
! !
!PPCAbstractLiteralNode methodsFor:'analysis'!
acceptsEpsilon
- ^ literal size = 0
+ ^ literal size = 0
!
firstCharSet
- | letter |
- letter := literal first.
- ^ PPCharSetPredicate on: [:e | e = letter ]
+ | letter |
+ letter := literal first.
+ ^ PPCharSetPredicate on: [:e | e = letter ]
! !
!PPCAbstractLiteralNode methodsFor:'comparison'!
= anotherNode
- super = anotherNode ifFalse: [ ^ false ].
- ^ literal = anotherNode literal.
+ super = anotherNode ifFalse: [ ^ false ].
+ ^ literal = anotherNode literal.
!
hash
- ^ super hash bitXor: literal hash
+ ^ super hash bitXor: literal hash
! !
!PPCAbstractLiteralNode methodsFor:'compiling'!
encodeQuotes: string
- | x s |
- s := WriteStream on: ''.
- 1 to: string size do: [ :i|
- s nextPut: (x := string at: i).
- x = $' ifTrue: [ s nextPut: x ].
- ].
- ^ s contents
+ | x s |
+ s := WriteStream on: ''.
+ 1 to: string size do: [ :i|
+ s nextPut: (x := string at: i).
+ x = $' ifTrue: [ s nextPut: x ].
+ ].
+ ^ s contents
! !
--- a/compiler/PPCAbstractPredicateNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCAbstractPredicateNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,43 +12,56 @@
!PPCAbstractPredicateNode methodsFor:'accessing'!
predicate
-
- ^ predicate
+
+ ^ predicate
!
predicate: anObject
-
- predicate := anObject
+
+ predicate := anObject
!
prefix
- ^ #predicate
+ ^ #predicate
! !
!PPCAbstractPredicateNode methodsFor:'analysis'!
acceptsEpsilon
- ^ false
+ ^ false
!
firstCharSet
- ^ PPCharSetPredicate on: predicate
+ ^ PPCharSetPredicate on: predicate
! !
!PPCAbstractPredicateNode methodsFor:'comparing'!
= anotherNode
- super = anotherNode ifFalse: [ ^ false ].
- ^ predicate = anotherNode predicate.
+ super = anotherNode ifFalse: [ ^ false ].
+ ^ predicate = anotherNode predicate.
!
hash
- ^ super hash bitXor: predicate hash
+ ^ super hash bitXor: predicate hash
+!
+
+recognizedSentencesPrim
+ | retval |
+
+ retval := OrderedCollection new.
+ "TODO JK: Works only for ASCII :("
+ 1 to: 255 do: [ :i |
+ (predicate value: (Character codePoint: i)) ifTrue: [
+ retval add: (Character codePoint: i) asString
+ ]
+ ].
+ ^ retval
! !
!PPCAbstractPredicateNode methodsFor:'compiling'!
extendClassification: classification
- ^ (classification asOrderedCollection addLast: false; yourself) asArray
+ ^ (classification asOrderedCollection addLast: false; yourself) asArray
! !
--- a/compiler/PPCActionNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCActionNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,6 +12,6 @@
!PPCActionNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitActionNode: self
+ ^ visitor visitActionNode: self
! !
--- a/compiler/PPCAndNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCAndNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,12 +12,12 @@
!PPCAndNode methodsFor:'accessing'!
prefix
- ^ #and
+ ^ #and
! !
!PPCAndNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitAndNode: self
+ ^ visitor visitAndNode: self
! !
--- a/compiler/PPCAnyNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCAnyNode.st Sun May 10 06:28:36 2015 +0100
@@ -13,23 +13,23 @@
!PPCAnyNode methodsFor:'accessing'!
prefix
- ^ #any
+ ^ #any
! !
!PPCAnyNode methodsFor:'analysis'!
acceptsEpsilon
- ^ false
+ ^ false
!
firstCharSet
- ^ PPCharSetPredicate on: [:e | true ]
+ ^ PPCharSetPredicate on: [:e | true ]
! !
!PPCAnyNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitAnyNode: self
+ ^ visitor visitAnyNode: self
! !
!PPCAnyNode class methodsFor:'documentation'!
--- a/compiler/PPCArguments.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCArguments.st Sun May 10 06:28:36 2015 +0100
@@ -12,99 +12,135 @@
!PPCArguments class methodsFor:'as yet unclassified'!
default
- ^ self new
+ ^ self new
!
new
- ^ self basicNew
- initialize;
- yourself
+ ^ self basicNew
+ initialize;
+ yourself
! !
!PPCArguments methodsFor:'accessing'!
+cacheFirstFollow
+ ^ self at: #cacheFirstFollow ifAbsent: true
+!
+
+cacheFirstFollow: value
+ self set: #cacheFirstFollow to: value.
+!
+
+codeGenerator
+ ^ self at: #codeGenerator ifAbsent: PPCCodeGenerator
+!
+
+codeGenerator: value
+ self set: #codeGenerator to: value.
+!
+
debug
- ^ self at: #debug ifAbsent: true
+ ^ self at: #debug ifAbsent: true
!
debug: value
- self set: #debug to: value.
+ self set: #debug to: value.
+!
+
+detectTokens
+ ^ self at: #detectTokens ifAbsent: true
+!
+
+detectTokens: value
+ self set: #detectTokens to: value.
!
generate
- ^ self at: #generate ifAbsent: true
+ ^ self at: #generate ifAbsent: true
+!
+
+generate: value
+ ^ self set: #generate to: value
!
guards
- ^ self at: #guards ifAbsent: true
+ ^ self at: #guards ifAbsent: true
!
guards: value
- self set: #guards to: value.
+ self set: #guards to: value.
!
inline
- ^ self at: #inline ifAbsent: true
+ ^ self at: #inline ifAbsent: true
!
inline: value
- self set: #inline to: value.
+ self set: #inline to: value.
!
merge
- ^ self at: #merge ifAbsent: true
+ ^ self at: #merge ifAbsent: true
!
merge: value
- self set: #merge to: value.
+ self set: #merge to: value.
!
name
- ^ self at: #name ifAbsent: #PPGeneratedParser
+ ^ self at: #name ifAbsent: #PPGeneratedParser
!
name: value
- self set: #name to: value.
+ self set: #name to: value.
!
profile
- ^ self at: #profile ifAbsent: false
+ ^ self at: #profile ifAbsent: false
!
profile: value
- self set: #profile to: value.
+ self set: #profile to: value.
+!
+
+recognizingComponents
+ ^ self at: #recognizingComponents ifAbsent: true
+!
+
+recognizingComponents: value
+ self set: #recognizingComponents to: value.
!
specialize
- ^ self at: #specialize ifAbsent: true
+ ^ self at: #specialize ifAbsent: true
!
specialize: value
- self set: #specialize to: value.
+ self set: #specialize to: value.
!
tokenize
- ^ self at: #tokenize ifAbsent: true
+ ^ self at: #tokenize ifAbsent: true
!
tokenize: value
- self set: #tokenize to: value.
+ self set: #tokenize to: value.
! !
!PPCArguments methodsFor:'initialization'!
initialize
- super initialize.
- arguments := IdentityDictionary new
+ super initialize.
+ arguments := IdentityDictionary new
! !
!PPCArguments methodsFor:'private'!
at: symbol ifAbsent: defaultValue
- ^ arguments at: symbol ifAbsent: [ ^ defaultValue ]
+ ^ arguments at: symbol ifAbsent: [ ^ defaultValue ]
!
set: symbol to: defaultValue
- ^ arguments at: symbol put: defaultValue
+ ^ arguments at: symbol put: defaultValue
! !
--- a/compiler/PPCBridge.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCBridge.st Sun May 10 06:28:36 2015 +0100
@@ -12,30 +12,30 @@
!PPCBridge class methodsFor:'as yet unclassified'!
on: aSymbol
- ^ self new
- selector: aSymbol;
- yourself
+ ^ self new
+ selector: aSymbol;
+ yourself
! !
!PPCBridge methodsFor:'as yet unclassified'!
call
- ^ 'self callParser: ', self id, '.'.
+ ^ 'self callParser: ', self id, '.'.
!
selector: aSymbol
- selector := aSymbol
+ selector := aSymbol
! !
!PPCBridge methodsFor:'parsing'!
parseOn: aPPContext
- | retval |
- retval := (aPPContext compiledParser) perform: selector.
- (aPPContext compiledParser isError) ifTrue: [
- aPPContext compiledParser clearError.
- ^ PPFailure message: 'error' context: aPPContext
- ].
- ^ retval
+ | retval |
+ retval := (aPPContext compiledParser) perform: selector.
+ (aPPContext compiledParser isError) ifTrue: [
+ aPPContext compiledParser clearError.
+ ^ PPFailure message: 'error' context: aPPContext
+ ].
+ ^ retval
! !
--- a/compiler/PPCCharSetPredicateNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCCharSetPredicateNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,16 +12,16 @@
!PPCCharSetPredicateNode methodsFor:'as yet unclassified'!
start: compiler id: id
- compiler startMethod: id
+ compiler startMethod: id
!
stop: compiler
- ^ compiler stopMethod
+ ^ compiler stopMethod
! !
!PPCCharSetPredicateNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitCharSetPredicateNode: self
+ ^ visitor visitCharSetPredicateNode: self
! !
--- a/compiler/PPCCharacterNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCCharacterNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,17 +12,17 @@
!PPCCharacterNode methodsFor:'as yet unclassified'!
start: compiler id: id
- compiler startMethod: id.
- compiler add: '^ '.
+ compiler startMethod: id.
+ compiler add: '^ '.
!
stop: compiler
- ^ compiler stopMethod
+ ^ compiler stopMethod
! !
!PPCCharacterNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitCharacterNode: self
+ ^ visitor visitCharacterNode: self
! !
--- a/compiler/PPCChoiceNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCChoiceNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,23 +12,41 @@
!PPCChoiceNode methodsFor:'accessing'!
prefix
- ^ #ch
+ ^ #ch
! !
!PPCChoiceNode methodsFor:'analysis'!
acceptsEpsilon
- ^ self acceptsEpsilonOpenSet: IdentitySet new.
+ ^ self acceptsEpsilonOpenSet: IdentitySet new.
!
acceptsEpsilonOpenSet: set
- set add: self.
- ^ self children anySatisfy: [:e | e acceptsEpsilonOpenSet: set ].
+ set add: self.
+ ^ self children anySatisfy: [:e | e acceptsEpsilonOpenSet: set ].
+!
+
+check
+ ^ self children asIdentitySet size = children size ifFalse: [
+ Transcript cr; show: 'WARNING: Identical children in choice!!'; cr.
+ nil.
+ ] ifTrue: [ nil ]
+!
+
+recognizedSentencesPrim
+ | retval |
+ (self children anySatisfy: [ :child | child hasFiniteLanguage not ]) ifTrue: [ ^ #() ].
+
+ retval := Set new.
+ self children do: [ : child |
+ retval addAll: child recognizedSentences.
+ ].
+ ^ retval asArray
! !
!PPCChoiceNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitChoiceNode: self
+ ^ visitor visitChoiceNode: self
! !
--- a/compiler/PPCCodeGenerator.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCCodeGenerator.st Sun May 10 06:28:36 2015 +0100
@@ -12,113 +12,113 @@
!PPCCodeGenerator class methodsFor:'as yet unclassified'!
on: aPPCCompiler
- ^ self new
- compiler: aPPCCompiler;
- yourself
+ ^ self new
+ compiler: aPPCCompiler;
+ yourself
! !
!PPCCodeGenerator methodsFor:'accessing'!
compiler: aPPCCompiler
- compiler := aPPCCompiler
+ compiler := aPPCCompiler
! !
!PPCCodeGenerator methodsFor:'hooks'!
afterAccept: node retval: retval
- "return the method from compiler"
- ^ self stopMethodForNode: node.
+ "return the method from compiler"
+ ^ self stopMethodForNode: node.
!
beforeAccept: node
- self startMethodForNode: node
+ self startMethodForNode: node
!
closedDetected: node
- ^ node isMarkedForInline ifFalse: [
- self error: 'Should not happen!!'
- ]
+ ^ node isMarkedForInline ifFalse: [
+ self error: 'Should not happen!!'
+ ]
!
openDetected: node
- ^ compiler checkCache: (compiler idFor: node)
+ ^ compiler checkCache: (compiler idFor: node)
! !
!PPCCodeGenerator methodsFor:'support'!
addGuard: node
- | guard firsts id |
- (arguments guards not or: [(guard := PPCGuard on: node) makesSense not]) ifTrue: [ ^ self].
+ | guard firsts id |
+ (arguments guards not or: [(guard := PPCGuard on: node) makesSense not]) ifTrue: [ ^ self].
- id := compiler idFor: node.
- firsts := (node firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]).
+ id := compiler idFor: node.
+ firsts := node firstSetWithTokens.
-
- (firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [
- "If we start with trimming, we should invoke the whitespace parser"
- self compileTokenWhitespace: firsts anyOne.
-
- compiler add: 'context atEnd ifTrue: [ ^ self error ].'.
- guard id: id, '_guard'.
- guard compileGuard: compiler.
- compiler addOnLine: 'ifFalse: [ ^ self error ].'
- ].
+
+ (firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [
+ "If we start with trimming, we should invoke the whitespace parser"
+ self compileTokenWhitespace: firsts anyOne.
+
+ compiler add: 'context atEnd ifTrue: [ ^ self error ].'.
+ guard id: id, '_guard'.
+ guard compileGuard: compiler.
+ compiler addOnLine: 'ifFalse: [ ^ self error ].'
+ ].
- (firsts allSatisfy: [ :e | e isTerminal ]) ifTrue: [
- compiler add: 'context atEnd ifTrue: [ ^ self error ].'.
- guard id: id, '_guard'.
- guard compileGuard: compiler.
- compiler addOnLine: 'ifFalse: [ ^ self error ].'
- ].
+ (firsts allSatisfy: [ :e | e isTerminal ]) ifTrue: [
+ compiler add: 'context atEnd ifTrue: [ ^ self error ].'.
+ guard id: id, '_guard'.
+ guard compileGuard: compiler.
+ compiler addOnLine: 'ifFalse: [ ^ self error ].'
+ ].
!
compileTokenWhitespace: node
- compiler add: 'context atWs ifFalse: ['.
- compiler indent.
- compiler call: (self visit: node whitespace).
- compiler add: 'context setWs.'.
- compiler dedent.
- compiler add: '].'.
+ compiler add: 'context atWs ifFalse: ['.
+ compiler indent.
+ compiler call: (self visit: node whitespace).
+ compiler add: 'context setWs.'.
+ compiler dedent.
+ compiler add: '].'.
!
notCharSetPredicateBody: node
- | classificationId classification |
- self error: 'deprecated.'.
- classification := node extendClassification: node predicate classification.
- classificationId := (compiler idFor: classification prefixed: #classification).
- compiler addConstant: classification as: classificationId.
-
- compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.
- compiler indent.
- compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.
- compiler add: ' ifFalse: [ nil ].'.
- compiler dedent.
+ | classificationId classification |
+ self error: 'deprecated.'.
+ classification := node extendClassification: node predicate classification.
+ classificationId := (compiler idFor: classification prefixed: #classification).
+ compiler addConstant: classification as: classificationId.
+
+ compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.
+ compiler indent.
+ compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.
+ compiler add: ' ifFalse: [ nil ].'.
+ compiler dedent.
!
notMessagePredicateBody: node
- self error: 'deprecated'.
- compiler addOnLine: '(context peek ', node message, ')'.
- compiler indent.
- compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.
- compiler add: ' ifFalse: [ nil ].'.
- compiler dedent.
+ self error: 'deprecated'.
+ compiler addOnLine: '(context peek ', node message, ')'.
+ compiler indent.
+ compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.
+ compiler add: ' ifFalse: [ nil ].'.
+ compiler dedent.
!
predicateBody: node
- | tmpId |
- self error:'deprecated'.
- tmpId := (compiler idFor: node predicate prefixed: #predicate).
- compiler addConstant: node predicate as: tmpId.
+ | tmpId |
+ self error:'deprecated'.
+ tmpId := (compiler idFor: node predicate prefixed: #predicate).
+ compiler addConstant: node predicate as: tmpId.
- compiler addOnLine: '(context atEnd not and: [ ', tmpId , ' value: context uncheckedPeek])'.
- compiler indent.
- compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'.
- compiler add: 'ifTrue: [ context next ].'.
- compiler dedent.
+ compiler addOnLine: '(context atEnd not and: [ ', tmpId , ' value: context uncheckedPeek])'.
+ compiler indent.
+ compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'.
+ compiler add: 'ifTrue: [ context next ].'.
+ compiler dedent.
!
retvalVar
- ^ compiler currentReturnVariable
+ ^ compiler currentReturnVariable
!
startMethodForNode:node
@@ -153,528 +153,567 @@
!PPCCodeGenerator methodsFor:'traversing - caching'!
cache: node value: retval
- "this is compiler thing, not mine"
+ "this is compiler thing, not mine"
!
cachedDetected: node
- ^ compiler checkCache: (compiler idFor: node)
+ ^ compiler checkCache: (compiler idFor: node)
!
isCached: node
- ^ (compiler checkCache: (compiler idFor: node)) isNil not
+ ^ (compiler checkCache: (compiler idFor: node)) isNil not
! !
!PPCCodeGenerator methodsFor:'visiting'!
visitActionNode: node
- compiler addConstant: node block as: (compiler idFor: node).
+ | blockId |
+
+ blockId := 'block_', (compiler idFor: node).
+ compiler addConstant: node block as: blockId.
- compiler addVariable: 'element'.
- compiler add: 'element := '.
- compiler callOnLine: (self visit: node child).
- compiler add: 'error ifFalse: [ ^ ', (compiler idFor: node), ' value: element ].'.
- compiler add: '^ failure'.
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
+ compiler add: 'error ifFalse: ['.
+ compiler codeReturn: blockId, ' value: ', self retvalVar.
+ compiler add: '] ifTrue: ['.
+ compiler codeReturn: 'failure'.
+ compiler add: '].'.
"Modified: / 23-04-2015 / 15:59:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitAndNode: node
- | mementoVar |
-
- mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
- compiler add: (compiler smartRemember: node child to: mementoVar).
+ | mementoVar |
+
+ mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
+ compiler smartRemember: node child to: mementoVar.
- compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
- compiler add: (compiler smartRestore: node child from: mementoVar).
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
+ compiler smartRestore: node child from: mementoVar.
- compiler codeReturn.
+ compiler codeReturn.
"Modified: / 23-04-2015 / 15:59:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitAnyNode: node
- compiler codeReturn: 'context next ifNil: [ error := true. ].'.
+ compiler codeReturn: 'context next ifNil: [ error := true. ].'.
"Modified: / 23-04-2015 / 20:52:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitCharSetPredicateNode: node
- | classification classificationId |
- classification := node extendClassification: node predicate classification.
- classificationId := compiler idFor: classification prefixed: #classification.
- compiler addConstant: classification as: classificationId.
-
- compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.
- compiler indent.
- compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'.
- compiler add: 'ifTrue: [ '.
- compiler codeReturn: 'context next'.
- compiler add: '].'.
- compiler dedent.
+ | classification classificationId |
+ classification := node extendClassification: node predicate classification.
+ classificationId := compiler idFor: classification prefixed: #classification.
+ compiler addConstant: classification as: classificationId.
+
+ compiler add: '(', classificationId, ' at: context peek asInteger)'.
+ compiler indent.
+ compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'.
+ compiler add: 'ifTrue: [ '.
+ compiler codeReturn: 'context next'.
+ compiler add: '].'.
+ compiler dedent.
!
visitCharacterNode: node
- | chid |
- node character ppcPrintable ifTrue: [
- chid := node character storeString
- ] ifFalse: [
- chid := compiler idFor: node character prefixed: #char.
- compiler addConstant: (Character value: node character asInteger) as: chid .
- ].
-
- compiler add: '(context peek == ', chid, ')'.
- compiler indent.
- compiler add: 'ifFalse: [ self error: ''', node character asInteger asString, ' expected'' at: context position ] '.
- compiler add: 'ifTrue: [ '.
- compiler codeReturn: 'context next'.
- compiler add: '].'.
- compiler dedent.
+ | chid |
+ node character ppcPrintable ifTrue: [
+ chid := node character storeString
+ ] ifFalse: [
+ chid := compiler idFor: node character prefixed: #char.
+ compiler addConstant: (Character value: node character asInteger) as: chid .
+ ].
+
+ compiler add: '(context peek == ', chid, ')'.
+ compiler indent.
+ compiler add: 'ifFalse: [ self error: ''', node character asInteger asString, ' expected'' at: context position ] '.
+ compiler add: 'ifTrue: [ '.
+ compiler codeReturn: 'context next'.
+ compiler add: '].'.
+ compiler dedent.
!
visitChild: child of: node
- | |
+ | |
- (self isOpen: child) ifTrue: [
- "already processing..."
- ^ nil
- ].
+ (self isOpen: child) ifTrue: [
+ "already processing..."
+ ^ nil
+ ].
- "TODO JK: this is is wrong,.. to tired now to fix this :("
+ "TODO JK: this is is wrong,.. to tired now to fix this :("
" (self isCached: child) ifTrue: [
- node replace: child with: (self cachedValue: child).
- ^ nil
- ].
+ node replace: child with: (self cachedValue: child).
+ ^ nil
+ ].
"
- ^ self visit: child.
+ ^ self visit: child.
!
visitChoiceNode: node
- | firsts guard whitespaceConsumed |
-
-
- whitespaceConsumed := false.
- firsts := (node firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]).
+ | firsts guard whitespaceConsumed elementVar |
+ "The code is not ready for inlining"
+ self assert: node isMarkedForInline not.
+
+ whitespaceConsumed := false.
+ firsts := node firstSetWithTokens.
- compiler addVariable: 'element'.
- "If we start with trimming token, we should invoke the whitespace parser"
- (firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [
- self compileTokenWhitespace: firsts anyOne.
- whitespaceConsumed := true.
- ].
+ elementVar := compiler allocateTemporaryVariableNamed: 'element'.
+ "
+ If we want to compile in guard and the choice starts with trimming token,
+ we should invoke the whitespace parser
+ "
+ (arguments guards and: [ firsts allSatisfy: [ :e | e isTrimmingTokenNode ] ]) ifTrue: [
+ self compileTokenWhitespace: firsts anyOne.
+ whitespaceConsumed := true.
+ ].
- 1 to: node children size do: [ :idx | |child allowGuard |
- child := node children at: idx.
-" allowGuard := ((child isKindOf: PPCTrimmingTokenNode) and: [ whitespaceConsumed not ]) not.
-"
- allowGuard := whitespaceConsumed.
+ 1 to: node children size do: [ :idx | |child allowGuard |
+ child := node children at: idx.
+ allowGuard := whitespaceConsumed.
- (allowGuard and: [arguments guards and: [ (guard := PPCGuard on: child) makesSense ]]) ifTrue: [
- guard id: (compiler idFor: guard prefixed: #guard).
- guard compileGuard: compiler.
- compiler add: ' ifTrue: [ '.
- compiler indent.
- compiler add: 'self clearError.'.
- compiler codeStoreValueOf: [self visit: child] intoVariable: 'element'.
- compiler add: 'error ifFalse: [ ^ element ].'.
- compiler dedent.
- compiler add: ' ].'.
- ] ifFalse: [
- compiler add: 'self clearError.'.
- compiler codeStoreValueOf: [self visit: child] intoVariable: 'element'.
- compiler add: 'error ifFalse: [ ^ element ].'.
- ]
- ].
- compiler add: '^ self error: ''no choice suitable'''.
+ (allowGuard and: [arguments guards and: [ (guard := PPCGuard on: child) makesSense ]]) ifTrue: [
+ guard id: (compiler idFor: guard prefixed: #guard).
+ guard compileGuard: compiler.
+ compiler add: ' ifTrue: [ '.
+ compiler indent.
+ compiler add: 'self clearError.'.
+ compiler codeStoreValueOf: [self visit: child] intoVariable: elementVar.
+ compiler add: 'error ifFalse: [ ^ element ].'.
+ compiler dedent.
+ compiler add: ' ].'.
+ ] ifFalse: [
+ compiler add: 'self clearError.'.
+ compiler codeStoreValueOf: [self visit: child] intoVariable: elementVar.
+ compiler add: 'error ifFalse: [ ^ element ].'.
+ ]
+ ].
+ compiler add: '^ self error: ''no choice suitable'''.
"Modified: / 23-04-2015 / 21:40:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitEndOfFileNode: node
- compiler codeReturn: 'context atEnd ifTrue: [ #EOF ] ifFalse: [ self error: ''EOF expected!!'' ].'.
+ compiler codeReturn: 'context atEnd ifTrue: [ #EOF ] ifFalse: [ self error: ''EOF expected!!'' ].'.
+!
+
+visitEndOfInputNode: node
+
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
+ compiler add: 'context atEnd ifTrue: ['.
+ compiler codeReturn.
+ compiler add: '] ifFalse: ['.
+ compiler codeError: 'End of input expected'.
+ compiler add: ']'.
!
visitForwardNode: node
- compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
- compiler codeReturn.
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
+ compiler codeReturn.
!
visitLiteralNode: node
- | positionVar encodedLiteral |
- encodedLiteral := node encodeQuotes: node literal.
- positionVar := compiler allocateTemporaryVariableNamed: 'position'.
+ | positionVar encodedLiteral |
+ encodedLiteral := node encodeQuotes: node literal.
+ positionVar := compiler allocateTemporaryVariableNamed: 'position'.
- compiler codeAssign: 'context position.' to: positionVar.
- compiler add: '((context next: ', node literal size asString, ') = #''', encodedLiteral, ''') ifTrue: ['.
- compiler codeReturn: '#''', encodedLiteral, ''' '.
- compiler add: '] ifFalse: ['.
- compiler add: ' context position: ', positionVar, '.'.
- compiler add: ' self error: ''', encodedLiteral, ' expected'' at: position'.
- compiler add: '].'.
+ compiler codeAssign: 'context position.' to: positionVar.
+ compiler add: '((context next: ', node literal size asString, ') = #''', encodedLiteral, ''') ifTrue: ['.
+ compiler codeReturn: '#''', encodedLiteral, ''' '.
+ compiler add: '] ifFalse: ['.
+ compiler add: ' context position: ', positionVar, '.'.
+ compiler add: ' self error: ''', encodedLiteral, ' expected'' at: position'.
+ compiler add: '].'.
!
visitMessagePredicateNode: node
- compiler add: '(context peek ', node message, ') ifFalse: ['.
- compiler add: ' self error: ''predicate not found'''.
- compiler add: '] ifTrue: [ '.
- compiler codeReturn: ' context next'.
- compiler add: '].'.
+ compiler add: '(context peek ', node message, ') ifFalse: ['.
+ compiler add: ' self error: ''predicate not found'''.
+ compiler add: '] ifTrue: [ '.
+ compiler codeReturn: ' context next'.
+ compiler add: '].'.
"Modified: / 23-04-2015 / 18:39:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitNilNode: node
- compiler codeReturn: 'nil.'.
+ compiler codeReturn: 'nil.'.
!
visitNotCharSetPredicateNode: node
- | classificationId classification |
- classification := node extendClassification: node predicate classification.
- classificationId := (compiler idFor: classification prefixed: #classification).
- compiler addConstant: classification as: classificationId.
-
- compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.
- compiler indent.
- compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.
- compiler add: ' ifFalse: ['.
- compiler codeReturn: 'nil'.
- compiler add: '].'.
- compiler dedent.
+ | classificationId classification |
+ classification := node extendClassification: node predicate classification.
+ classificationId := (compiler idFor: classification prefixed: #classification).
+ compiler addConstant: classification as: classificationId.
+
+ compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.
+ compiler indent.
+ compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.
+ compiler add: ' ifFalse: ['.
+ compiler codeReturn: 'nil'.
+ compiler add: '].'.
+ compiler dedent.
!
visitNotLiteralNode: node
- | encodedLiteral size |
- encodedLiteral := node encodeQuotes: node literal.
- size := node literal size asString.
-
- compiler add: '((context peek: ', size, ') =#''', encodedLiteral, ''')'.
- compiler indent.
- compiler add: 'ifTrue: [ self error: ''', encodedLiteral, ' not expected'' ]'.
- compiler add: 'ifFalse: [ '.
- compiler codeReturn: 'nil' .
- compiler add: '].'.
- compiler dedent.
+ | encodedLiteral size |
+ encodedLiteral := node encodeQuotes: node literal.
+ size := node literal size asString.
+
+ compiler add: '((context peek: ', size, ') =#''', encodedLiteral, ''')'.
+ compiler indent.
+ compiler add: 'ifTrue: [ self error: ''', encodedLiteral, ' not expected'' ]'.
+ compiler add: 'ifFalse: [ '.
+ compiler codeReturn: 'nil' .
+ compiler add: '].'.
+ compiler dedent.
!
visitNotMessagePredicateNode: node
- compiler addOnLine: '(context peek ', node message, ')'.
- compiler indent.
- compiler add: ' ifTrue: [ '.
- compiler codeError: 'predicate not expected'.
- compiler add: '] ifFalse: ['.
- compiler codeReturn: 'nil'.
- compiler add: ' ].'.
- compiler dedent.
+ compiler addOnLine: '(context peek ', node message, ')'.
+ compiler indent.
+ compiler add: ' ifTrue: [ '.
+ compiler codeError: 'predicate not expected'.
+ compiler add: '] ifFalse: ['.
+ compiler codeReturn: 'nil'.
+ compiler add: ' ].'.
+ compiler dedent.
!
visitNotNode: node
-
+ | mementoVar |
- compiler addVariable: 'memento'.
- compiler add: (compiler smartRemember: node child).
-
- compiler call: (self visit: node child).
- compiler add: (compiler smartRestore: node child).
+ mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
+ compiler smartRemember: node child to: mementoVar.
+
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
+ compiler smartRestore: node child from: mementoVar.
- compiler add: '^ error ifFalse: [ self error ] ifTrue: [ self clearError. nil ]'.
+ compiler add: '^ error ifFalse: [ self error ] ifTrue: [ self clearError. nil ]'.
!
visitOptionalNode: node
- compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
- compiler add: 'error ifTrue: [ '.
- compiler add: ' self clearError. '.
- compiler codeAssign: 'nil.' to: self retvalVar.
- compiler add: '].'.
- compiler codeReturn.
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
+ compiler add: 'error ifTrue: [ '.
+ compiler add: ' self clearError. '.
+ compiler codeAssign: 'nil.' to: self retvalVar.
+ compiler add: '].'.
+ compiler codeReturn.
!
visitPluggableNode: node
- | blockId |
- blockId := compiler idFor: node block prefixed: #block.
-
- compiler addConstant: node block as: blockId.
- compiler codeReturn: blockId, ' value: context.'.
+ | blockId |
+ blockId := compiler idFor: node block prefixed: #block.
+
+ compiler addConstant: node block as: blockId.
+ compiler codeReturn: blockId, ' value: context.'.
!
visitPlusNode: node
- | elementVar |
+ | elementVar |
- elementVar := compiler allocateTemporaryVariableNamed: 'element'.
+ elementVar := compiler allocateTemporaryVariableNamed: 'element'.
- compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
- compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
+ compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
- compiler add: 'error ifTrue: [ self error: ''at least one occurence expected'' ] ifFalse: ['.
- compiler indent.
- compiler add: self retvalVar , ' add: ',elementVar , '.'.
+ compiler add: 'error ifTrue: [ self error: ''at least one occurence expected'' ] ifFalse: ['.
+ compiler indent.
+ compiler add: self retvalVar , ' add: ',elementVar , '.'.
- compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
- compiler add: '[ error ] whileFalse: ['.
- compiler indent.
- compiler add: self retvalVar , ' add: ',elementVar , '.'.
- compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
- compiler dedent.
- compiler add: '].'.
- compiler add: 'self clearError.'.
- compiler codeReturn: self retvalVar , ' asArray.'.
- compiler dedent.
- compiler add: '].'.
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
+ compiler add: '[ error ] whileFalse: ['.
+ compiler indent.
+ compiler add: self retvalVar , ' add: ',elementVar , '.'.
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
+ compiler dedent.
+ compiler add: '].'.
+ compiler add: 'self clearError.'.
+ compiler codeReturn: self retvalVar , ' asArray.'.
+ compiler dedent.
+ compiler add: '].'.
"Modified (comment): / 23-04-2015 / 21:30:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitPredicateNode: node
- | pid |
- pid := (compiler idFor: node predicate prefixed: #predicate).
+ | pid |
+ pid := (compiler idFor: node predicate prefixed: #predicate).
- compiler addConstant: node predicate as: pid.
+ compiler addConstant: node predicate as: pid.
- compiler add: '(context atEnd not and: [ ', pid , ' value: context uncheckedPeek])'.
- compiler indent.
- compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'.
- compiler add: 'ifTrue: [ ', self retvalVar ,' := context next ].'.
- compiler dedent.
- compiler codeReturn.
+ compiler add: '(context atEnd not and: [ ', pid , ' value: context uncheckedPeek])'.
+ compiler indent.
+ compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'.
+ compiler add: 'ifTrue: [ ', self retvalVar ,' := context next ].'.
+ compiler dedent.
+ compiler codeReturn.
"Modified: / 23-04-2015 / 21:48:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+visitRecognizingSequenceNode: node
+ | mementoVar |
+
+ mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
+ compiler smartRemember: node to: mementoVar.
+
+" self addGuard: compiler."
+
+ compiler codeStoreValueOf: [ self visit: (node children at: 1) ] intoVariable: #whatever.
+ compiler add: 'error ifTrue: [ ^ failure ].'.
+
+ 2 to: (node children size) do: [ :idx | |child|
+ child := node children at: idx.
+ compiler codeStoreValueOf: [ self visit: child ] intoVariable: #whatever.
+ compiler add: 'error ifTrue: [ '.
+ compiler indent.
+ compiler smartRestore: node from: mementoVar.
+ compiler add: ' ^ failure .'.
+ compiler dedent.
+ compiler add: '].'.
+ ].
+!
+
visitSequenceNode: node
- | elementVar mementoVar |
+ | elementVar mementoVar |
- elementVar := compiler allocateTemporaryVariableNamed: 'element'.
- mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
+ elementVar := compiler allocateTemporaryVariableNamed: 'element'.
+ mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
- compiler add: (compiler smartRemember: node to: mementoVar).
- compiler codeAssign: 'Array new: ', node children size asString, '.' to: self retvalVar.
- self addGuard: node.
+ compiler smartRemember: node to: mementoVar.
+ compiler codeAssign: 'Array new: ', node children size asString, '.' to: self retvalVar.
+ self addGuard: node.
- 1 to: (node children size) do: [ :idx | |child|
- child := node children at: idx.
- compiler codeStoreValueOf: [ self visit: child ] intoVariable: elementVar.
+ 1 to: (node children size) do: [ :idx | |child|
+ child := node children at: idx.
+ compiler codeStoreValueOf: [ self visit: child ] intoVariable: elementVar.
- compiler add: 'error ifTrue: [ ', (compiler smartRestore: node) ,' ^ failure ].'.
- compiler add: self retvalVar , ' at: ', idx asString, ' put: ',elementVar,'.'.
- ].
- compiler codeReturn
+ compiler add: 'error ifTrue: [ '.
+ compiler indent.
+ compiler smartRestore: node from: mementoVar.
+ compiler add: '^ failure.'.
+ compiler dedent.
+ compiler add: '].'.
+ compiler add: self retvalVar , ' at: ', idx asString, ' put: ',elementVar,'.'.
+ ].
+ compiler codeReturn
"Modified: / 23-04-2015 / 22:03:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitStarAnyNode: node
- compiler addVariable: 'retval size'.
- compiler add: 'size := context size - context position.'.
- compiler add: 'retval := Array new: size.'.
- compiler add: '(1 to: size) do: [ :e | retval at: e put: context next ].'.
- compiler add: '^ retval'.
-
+ compiler addVariable: 'retval size'.
+ compiler add: 'size := context size - context position.'.
+ compiler add: 'retval := Array new: size.'.
+ compiler add: '(1 to: size) do: [ :e | retval at: e put: context next ].'.
+ compiler add: '^ retval'.
+
!
visitStarCharSetPredicateNode: node
- | classification classificationId |
-
+ | classification classificationId |
+
- classification := node extendClassification: node predicate classification.
- classificationId := compiler idFor: classification prefixed: #classification.
- compiler addConstant: classification as: classificationId.
-
- compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
- compiler add: '[ ', classificationId, ' at: context peek asInteger ] whileTrue: ['.
- compiler indent.
- compiler add: self retvalVar, ' add: context next.'.
- compiler dedent.
- compiler add: '].'.
+ classification := node extendClassification: node predicate classification.
+ classificationId := compiler idFor: classification prefixed: #classification.
+ compiler addConstant: classification as: classificationId.
+
+ compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
+ compiler add: '[ ', classificationId, ' at: context peek asInteger ] whileTrue: ['.
+ compiler indent.
+ compiler add: self retvalVar, ' add: context next.'.
+ compiler dedent.
+ compiler add: '].'.
compiler codeReturn: 'retval asArray'.
!
visitStarMessagePredicateNode: node
- compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
- compiler add: '[ context peek ', node message, ' ] whileTrue: ['.
- compiler indent.
- compiler add: self retvalVar, ' add: context next.'.
- compiler dedent.
- compiler add: '].'.
+ compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
+ compiler add: '[ context peek ', node message, ' ] whileTrue: ['.
+ compiler indent.
+ compiler add: self retvalVar, ' add: context next.'.
+ compiler dedent.
+ compiler add: '].'.
compiler codeReturn: 'retval asArray'.
!
visitStarNode: node
- | elementVar |
-
- elementVar := compiler allocateTemporaryVariableNamed: 'element'.
+ | elementVar |
+
+ elementVar := compiler allocateTemporaryVariableNamed: 'element'.
- compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
- compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
- compiler add: '[ error ] whileFalse: ['.
- compiler indent.
- compiler add: self retvalVar, ' add: element.'.
- compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
- compiler dedent.
- compiler add: '].'.
- compiler codeClearError.
- compiler codeReturn: self retvalVar, ' asArray'.
+ compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
+ compiler add: '[ error ] whileFalse: ['.
+ compiler indent.
+ compiler add: self retvalVar, ' add: ', elementVar, '.'.
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
+ compiler dedent.
+ compiler add: '].'.
+ compiler codeClearError.
+ compiler codeReturn: self retvalVar, ' asArray.'.
!
visitSymbolActionNode: node
- | elementVar |
-
- elementVar := compiler allocateTemporaryVariableNamed: 'element'.
- compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
- compiler add: 'error ifFalse: [ '.
- compiler codeReturn: elementVar, ' ', node block asString, '.'.
- compiler add: '] ifTrue: ['.
- compiler codeReturn: 'failure'.
- compiler add: ']'.
+ | elementVar |
+
+ elementVar := compiler allocateTemporaryVariableNamed: 'element'.
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
+ compiler add: 'error ifFalse: [ '.
+ compiler codeReturn: elementVar, ' ', node block asString, '.'.
+ compiler add: '] ifTrue: ['.
+ compiler codeReturn: 'failure'.
+ compiler add: ']'.
!
visitTokenActionNode: node
- "
- Actually, do nothing, we are in Token mode and the
- child does not return any result and token takes only
- the input value.
- "
+ "
+ Actually, do nothing, we are in Token mode and the
+ child does not return any result and token takes only
+ the input value.
+ "
- compiler add: '^ '.
- compiler callOnLine: (node child compileWith: compiler).
+ compiler add: '^ '.
+ compiler callOnLine: (node child compileWith: compiler).
!
visitTokenNode: node
- | startVar endVar |
- startVar := compiler allocateTemporaryVariableNamed: 'start'.
- endVar := compiler allocateTemporaryVariableNamed: 'end'.
-
- compiler codeAssign: 'context position + 1.' to: startVar.
- compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
- compiler add: 'error ifFalse: [ '.
- compiler indent.
- compiler codeAssign: 'context position.' to: endVar.
-
- compiler codeReturn: node tokenClass asString, ' on: (context collection)
- start: ', startVar, '
- stop: ', endVar, '
- value: nil.'.
- compiler dedent.
- compiler add: '].'.
-!
-
-visitTokenSequenceNode: node
-
-
- compiler addVariable: 'memento'.
- compiler add: (compiler smartRemember: node).
-
-" self addGuard: compiler."
-
- compiler codeStoreValueOf: [ self visit: (node children at: 1) ] intoVariable: #whatever.
- compiler add: 'error ifTrue: [ ^ failure ].'.
-
- 2 to: (node children size) do: [ :idx | |child|
- child := node children at: idx.
- compiler codeStoreValueOf: [ self visit: child ] intoVariable: #whatever.
- compiler add: 'error ifTrue: [ ', (compiler smartRestore: node) ,' ^ failure ].'.
- ].
+ | startVar endVar |
+ startVar := compiler allocateTemporaryVariableNamed: 'start'.
+ endVar := compiler allocateTemporaryVariableNamed: 'end'.
+
+ compiler codeAssign: 'context position + 1.' to: startVar.
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
+ compiler add: 'error ifFalse: [ '.
+ compiler indent.
+ compiler codeAssign: 'context position.' to: endVar.
+
+ compiler codeReturn: node tokenClass asString, ' on: (context collection)
+ start: ', startVar, '
+ stop: ', endVar, '
+ value: nil.'.
+ compiler dedent.
+ compiler add: '].'.
!
visitTokenStarMessagePredicateNode: node
- compiler add: '[ context peek ', node message,' ] whileTrue: ['.
- compiler indent.
- compiler add: 'context next'.
- compiler indent.
- compiler dedent.
- compiler add: '].'.
+ compiler add: '[ context peek ', node message,' ] whileTrue: ['.
+ compiler indent.
+ compiler add: 'context next'.
+ compiler indent.
+ compiler dedent.
+ compiler add: '].'.
!
visitTokenStarSeparatorNode: node
- compiler add: 'context skipSeparators.'.
+ compiler add: 'context skipSeparators.'.
+!
+
+visitTokenWhitespaceNode: node
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
+ compiler codeReturn.
!
visitTrimNode: node
- | mementoVar |
- "TODO: This ignores the TrimmingParser trimmer object!!"
+ | mementoVar |
+ "TODO: This ignores the TrimmingParser trimmer object!!"
- mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
+ mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
- compiler add: (compiler smartRemember: node child to: mementoVar).
- compiler add: 'context skipSeparators.'.
+ compiler smartRemember: node child to: mementoVar.
+ compiler add: 'context skipSeparators.'.
- compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
-
- compiler add: 'error ifTrue: [ '.
- compiler indent.
- compiler add: (compiler smartRestore: node child from: mementoVar).
- compiler codeReturn.
- compiler dedent.
- compiler add: '] ifFalse: [' .
- compiler indent.
- compiler add: 'context skipSeparators.'.
- compiler codeReturn.
- compiler dedent.
- compiler add: '].'.
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
+
+ compiler add: 'error ifTrue: [ '.
+ compiler indent.
+ compiler smartRestore: node child from: mementoVar.
+ compiler codeReturn.
+ compiler dedent.
+ compiler add: '] ifFalse: [' .
+ compiler indent.
+ compiler add: 'context skipSeparators.'.
+ compiler codeReturn.
+ compiler dedent.
+ compiler add: '].'.
!
visitTrimmingTokenNode: node
- | id guard startVar endVar |
+ | id guard startVar endVar |
- startVar := compiler allocateTemporaryVariableNamed: 'start'.
- endVar := compiler allocateTemporaryVariableNamed: 'end'.
-
- id := compiler idFor: node.
+ startVar := compiler allocateTemporaryVariableNamed: 'start'.
+ endVar := compiler allocateTemporaryVariableNamed: 'end'.
+
+ id := compiler idFor: node.
" (id beginsWith: 'kw') ifTrue: [ self halt. ]."
- "self compileFirstWhitespace: compiler."
- self compileTokenWhitespace: node.
+ "self compileFirstWhitespace: compiler."
+ self compileTokenWhitespace: node.
+
+ (arguments guards and: [(guard := PPCGuard on: node) makesSense]) ifTrue: [
+ guard id: id, '_guard'.
+ compiler add: 'context atEnd ifTrue: [ self error ].'.
+ guard compileGuard: compiler.
+ compiler addOnLine: 'ifFalse: [ self error ].'.
+ compiler add: 'error ifFalse: ['.
+ compiler indent.
+ ].
- (arguments guards and: [(guard := PPCGuard on: node) makesSense]) ifTrue: [
- compiler add: 'context atEnd ifTrue: [ ^ self error ].'.
- guard id: id, '_guard'.
- guard compileGuard: compiler.
- compiler addOnLine: 'ifFalse: [ ^ self error ].'
- ].
+ compiler codeAssign: 'context position + 1.' to: startVar.
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
+
+ (arguments guards and: [(guard := PPCGuard on: node) makesSense]) ifTrue: [
+ compiler dedent.
+ compiler add: '].'.
+ ].
- compiler codeAssign: 'context position + 1.' to: startVar.
- compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
- compiler add: 'error ifFalse: [ '.
- compiler indent.
- compiler codeAssign: 'context position.' to: endVar.
-
+ compiler add: 'error ifFalse: [ '.
+ compiler indent.
+ compiler codeAssign: 'context position.' to: endVar.
+
" self compileSecondWhitespace: compiler."
- self compileTokenWhitespace: node.
+ self compileTokenWhitespace: node.
- compiler codeReturn: node tokenClass asString, ' on: (context collection)
- start: ', startVar, '
- stop: ', endVar, '
- value: nil'.
- compiler dedent.
- compiler add: '].'
+ compiler codeReturn: node tokenClass asString, ' on: (context collection)
+ start: ', startVar, '
+ stop: ', endVar, '
+ value: nil'.
+ compiler dedent.
+ compiler add: '].'
!
visitUnknownNode: node
- | compiledChild compiledParser id |
+ | compiledChild compiledParser id |
- id := compiler idFor: node.
-
- compiledParser := node parser copy.
- "Compile all the children and call compiled version of them instead of the original one"
- compiledParser children do: [ :child |
- compiledChild := self visit: child.
- compiledParser replace: child with: compiledChild bridge.
- ].
-
- compiler addConstant: compiledParser as: id.
-
- compiler codeClearError.
- compiler add: '(', self retvalVar, ' := ', id, ' parseOn: context) isPetitFailure'.
- compiler indent.
- compiler add: ' ifTrue: [self error: retval message at: ', self retvalVar, ' position ].'.
- compiler dedent.
- compiler add: 'error := ', self retvalVar, ' isPetitFailure.'.
- compiler codeReturn.
+ id := compiler idFor: node.
+
+ compiledParser := node parser copy.
+ "Compile all the children and call compiled version of them instead of the original one"
+ compiledParser children do: [ :child |
+ compiledChild := self visit: child.
+ compiledParser replace: child with: compiledChild bridge.
+ ].
+
+ compiler addConstant: compiledParser as: id.
+
+ compiler codeClearError.
+ compiler add: '(', self retvalVar, ' := ', id, ' parseOn: context) isPetitFailure'.
+ compiler indent.
+ compiler add: ' ifTrue: [self error: retval message at: ', self retvalVar, ' position ].'.
+ compiler dedent.
+ compiler add: 'error := ', self retvalVar, ' isPetitFailure.'.
+ compiler codeReturn.
! !
--- a/compiler/PPCCompiledMethod.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCCompiledMethod.st Sun May 10 06:28:36 2015 +0100
@@ -13,15 +13,15 @@
!PPCCompiledMethod methodsFor:'as yet unclassified'!
call
- ^ 'self ', self methodName, '.'.
+ ^ 'self ', self methodName, '.'.
!
id: value
- id := value
+ id := value
!
methodName
- ^ id
+ ^ id
! !
!PPCCompiledMethod class methodsFor:'documentation'!
--- a/compiler/PPCCompiler.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCCompiler.st Sun May 10 06:28:36 2015 +0100
@@ -3,8 +3,9 @@
"{ NameSpace: Smalltalk }"
Object subclass:#PPCCompiler
- instanceVariableNames:'compilerStack compiledParser cache currentMethod ids rootNode
- constants compiledParserName returnVariable arguments'
+ instanceVariableNames:'compilerStack compiledParser cache currentMethod ids constants
+ compiledParserName compiledParserSuperclass returnVariable
+ arguments'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Core'
@@ -36,85 +37,85 @@
!PPCCompiler methodsFor:'accessing'!
arguments: args
- arguments := args
+ arguments := args
!
compiledParser
- ^ compiledParser
+ ^ compiledParser
+!
+
+compiledParserSuperclass
+ ^ compiledParserSuperclass ifNil: [ PPCompiledParser ]
!
currentNonInlineMethod
- ^ compilerStack
- detect:[:m | m isInline not ]
- ifNone:[ self error: 'No non-inlined method']
+ ^ compilerStack
+ detect:[:m | m isInline not ]
+ ifNone:[ self error: 'No non-inlined method']
"Created: / 23-04-2015 / 17:33:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
currentReturnVariable
- ^ currentMethod returnVariable
+ ^ currentMethod returnVariable
!
ids
- ^ ids
-!
-
-rootNode
- ^ rootNode
+ ^ ids
! !
!PPCCompiler methodsFor:'cleaning'!
clean: class
" Transcript crShow: 'Cleaning time: ',
- [
+ [
" self cleanGeneratedMethods: class.
- self cleanInstVars: class.
- self cleanConstants: class.
+ self cleanInstVars: class.
+ self cleanConstants: class.
" ] timeToRun asMilliSeconds asString, 'ms'."
!
cleanConstants: class
- class constants removeAll.
+ class constants removeAll.
!
cleanGeneratedMethods: class
- ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
- class methodsDo: [ :mthd |
- mthd category = #generated ifTrue:[
- class removeSelector: mthd selector.
- ]
- ]
- ] ifFalse: [
- (class allSelectorsInProtocol: #generated) do: [ :selector |
- class removeSelectorSilently: selector ].
- ]
+ ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
+ class methodsDo: [ :mthd |
+ mthd category = #generated ifTrue:[
+ class removeSelector: mthd selector.
+ ]
+ ]
+ ] ifFalse: [
+ (class allSelectorsInProtocol: #generated) do: [ :selector |
+ class removeSelectorSilently: selector ].
+ ]
!
cleanInstVars: class
- class class instanceVariableNames: ''.
+ class class instanceVariableNames: ''.
!
cleanParsers: class
- class parsers removeAll.
+ class parsers removeAll.
! !
!PPCCompiler methodsFor:'code generation'!
add: string
- currentMethod add: string.
+ currentMethod add: string.
!
addComment: string
- currentMethod add: '"', string, '"'.
+ currentMethod add: '"', string, '"'.
!
addConstant: value as: name
- constants at: name put: value
+ constants at: name put: value
!
addOnLine: string
- currentMethod addOnLine: string.
+ currentMethod addOnLine: string.
!
addVariable: name
@@ -124,74 +125,81 @@
!
call: anotherMethod
- currentMethod add: anotherMethod call.
+ currentMethod add: anotherMethod call.
!
callOnLine: anotherMethod
- currentMethod addOnLine: anotherMethod call.
+ currentMethod addOnLine: anotherMethod call.
!
dedent
- currentMethod dedent
+ currentMethod dedent
!
indent
- currentMethod indent
+ currentMethod indent
!
nl
- currentMethod nl
-!
-
-smartRemember: parser
- self flag: 'deprecated'.
- ^ self smartRemember: parser to: #memento
+ currentMethod nl
!
-smartRemember: parser to: variableName
- parser isContextFree ifTrue: [
- ^ variableName, ' := context lwRemember.'.
- ].
- ^ variableName, ':= context remember.'
-!
-
-smartRestore: parser
- self flag: 'deprecated'.
- ^ self smartRestore: parser from: #memento
+smartRemember: parser to: variableName
+ parser isContextFree ifTrue: [
+ self codeAssign: 'context lwRemember.'
+ to: variableName.
+ ] ifFalse: [
+ self codeAssign: 'context remember.'
+ to: variableName.
+ ]
!
smartRestore: parser from: mementoName
- parser isContextFree ifTrue: [
- ^ 'context lwRestore: ', mementoName, '.'.
- ].
- ^ 'context restore: ', mementoName, '.'.
+ parser isContextFree ifTrue: [
+ self add: 'context lwRestore: ', mementoName, '.'.
+ ] ifFalse: [
+ self add: 'context restore: ', mementoName, '.'.
+ ]
! !
!PPCCompiler methodsFor:'code generation - coding'!
codeAssign: code to: variable
- self assert: variable isNil not.
-
- "TODO JK: Hack alert, whatever is magic constant!!"
- (variable == #whatever) ifFalse: [
- "Do not assign, if somebody does not care!!"
- self add: variable ,' := ', code.
+ self assert: variable isNil not.
+
+ "TODO JK: Hack alert, whatever is magic constant!!"
+ (variable == #whatever) ifFalse: [
+ "Do not assign, if somebody does not care!!"
+ self add: variable ,' := ', code.
] ifTrue: [
- "In case code hava a side effect"
+ "In case code hava a side effect"
self add: code
- ]
+ ]
!
codeClearError
- self add: 'self clearError.'.
+ self add: 'self clearError.'.
!
codeError: errorMessage
- self add: 'self error: ''', errorMessage, '''.'
+ self add: 'self error: ''', errorMessage, '''.'
!
codeHalt
- self add: 'self halt. '
+ self add: 'self halt. '
+!
+
+codeHaltIfShiftPressed
+ arguments debug ifTrue: [
+ self add: 'Halt ifShiftPressed.'
+ ]
+!
+
+codeNextToken
+ self add: 'self nextToken.'
+
+ "Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 23-04-2015 / 20:51:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
codeReturn
@@ -206,155 +214,179 @@
!
codeReturn: code
- " - returns whatever is in code OR
- - assigns whatever is in code into the returnVariable"
+ " - returns whatever is in code OR
+ - assigns whatever is in code into the returnVariable"
currentMethod isInline ifTrue:[
- self codeAssign: code to: currentMethod returnVariable.
+ self codeAssign: code to: currentMethod returnVariable.
] ifFalse: [
- self add: '^ ', code
- ]
+ self add: '^ ', code
+ ]
"Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 23-04-2015 / 20:51:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
codeStoreValueOf: aBlock intoVariable: aString
- | tmpVarirable method |
- self assert: aBlock isBlock.
- self assert: aString isNil not.
-
- tmpVarirable := returnVariable.
- returnVariable := aString.
- method := [
- aBlock value
- ] ensure: [
- returnVariable := tmpVarirable
- ].
-
- method isInline ifTrue: [
- self callOnLine: method
- ] ifFalse: [
- self codeAssign: (method call) to: aString.
- ]
-
- "Created: / 23-04-2015 / 18:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ | tmpVarirable method |
+ self assert: aBlock isBlock.
+ self assert: aString isNil not.
+
+ tmpVarirable := returnVariable.
+ returnVariable := aString.
+ method := [
+ aBlock value
+ ] ensure: [
+ returnVariable := tmpVarirable
+ ].
+
+ method isInline ifTrue: [
+ self callOnLine: method
+ ] ifFalse: [
+ self codeAssign: (method call) to: aString.
+ ]
+
+ "Created: / 23-04-2015 / 18:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeTranscriptShow: text
+ (arguments profile) ifTrue: [
+ self add: 'Transcript show: ', text storeString, '; cr.'.
+ ]
! !
!PPCCompiler methodsFor:'code generation - ids'!
+asSelector: string
+ "e.g. '234znak 43 ) 2' asLegalSelector = #v234znak432"
+
+ | toUse |
+ toUse := string select: [:char | char isAlphaNumeric or: [ char = $_ ] ].
+ (toUse isEmpty or: [ toUse first isLetter not ])
+ ifTrue: [ toUse := 'v', toUse ].
+ ^ toUse uncapitalized asSymbol.
+!
+
idFor: object
- self assert: (object isKindOf: PPCNode).
- ^ self idFor: object prefixed: object prefix suffixed: object suffix effect: #none
+ self assert: (object isKindOf: PPCNode).
+ ^ self idFor: object prefixed: object prefix suffixed: object suffix effect: #none
!
idFor: object prefixed: prefix
- ^ self idFor: object prefixed: prefix effect: #none
+ ^ self idFor: object prefixed: prefix effect: #none
!
idFor: object prefixed: prefix effect: effect
- ^ self idFor: object prefixed: prefix suffixed: '' effect: effect.
+ ^ self idFor: object prefixed: prefix suffixed: '' effect: effect.
!
idFor: object prefixed: prefix suffixed: suffix effect: effect
- | name id |
- ^ ids at: object ifAbsentPut: [
- ((object isKindOf: PPCNode) and: [object name isNotNil]) ifTrue: [
- "Do not use prefix, if there is a name"
- name := object name asLegalSelector.
- id := (name, suffix) asSymbol.
-
- "Make sure, that the generated ID is uniqe!!"
- (ids includes: id) ifTrue: [
- (id, '_', ids size asString) asSymbol
- ] ifFalse: [
- id
- ]
- ] ifFalse: [
- (prefix, '_', (ids size asString), suffix) asSymbol
- ]
- ]
+ | name id |
+ ^ ids at: object ifAbsentPut: [
+ ((object isKindOf: PPCNode) and: [object name isNotNil]) ifTrue: [
+ "Do not use prefix, if there is a name"
+ name := self asSelector: object name.
+ id := (name, suffix) asSymbol.
+
+ "Make sure, that the generated ID is uniqe!!"
+ (ids includes: id) ifTrue: [
+ (id, '_', ids size asString) asSymbol
+ ] ifFalse: [
+ id
+ ]
+ ] ifFalse: [
+ (prefix, '_', (ids size asString), suffix) asSymbol
+ ]
+ ]
+!
+
+idFor: object suffixed: suffix
+ self assert: (object isKindOf: PPCNode) description: 'Shold use PPCNode for ids'.
+ ^ self idFor: object prefixed: object prefix suffixed: suffix effect: #none
! !
!PPCCompiler methodsFor:'code generation - support'!
cache: id as: value
- cache at: id put: value.
+ cache at: id put: value.
!
cachedValue: id
- ^ cache at: id ifAbsent: [ nil ]
+ ^ cache at: id ifAbsent: [ nil ]
!
checkCache: id
- | method |
- "Check if method is hand written"
- method := compiledParser ifNotNil: [ compiledParser compiledMethodAt: id ifAbsent: [ nil ] ].
- method ifNotNil: [ ^ PPCCompiledMethod new id: id; yourself ].
-
- ^ self cachedValue: id
+ | method |
+ "Check if method is hand written"
+ method := compiledParser ifNotNil: [ compiledParser compiledMethodAt: id ifAbsent: [ nil ] ].
+ method ifNotNil: [ ^ PPCCompiledMethod new id: id; yourself ].
+
+ ^ self cachedValue: id
!
pop
- | retval |
- retval := compilerStack pop.
- currentMethod := compilerStack isEmpty
- ifTrue: [ nil ]
- ifFalse: [ compilerStack top ].
- ^ retval
+ | retval |
+ retval := compilerStack pop.
+ currentMethod := compilerStack isEmpty
+ ifTrue: [ nil ]
+ ifFalse: [ compilerStack top ].
+ ^ retval
"Modified: / 21-11-2014 / 12:27:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
push
- compilerStack push: currentMethod.
- (compilerStack size > 500 )ifTrue: [ self error: 'unless it is very complex grammar, there is an error somewhere' ]
+ compilerStack push: currentMethod.
+ (compilerStack size > 500 )ifTrue: [ self error: 'unless it is very complex grammar, there is an error somewhere' ]
"Modified: / 21-11-2014 / 12:27:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
startInline: id
- (cache includesKey: id) ifTrue: [ self error: 'OOOUPS!!' ].
-
- currentMethod := PPCInlinedMethod new.
- currentMethod id: id.
- currentMethod profile: arguments profile.
- currentMethod returnVariable: returnVariable.
- self push.
+ | indentationLevel |
+ (cache includesKey: id) ifTrue: [ self error: 'OOOUPS!!' ].
+ indentationLevel := currentMethod indentationLevel.
+
+ currentMethod := PPCInlinedMethod new.
+ currentMethod id: id.
+ currentMethod profile: arguments profile.
+ currentMethod returnVariable: returnVariable.
+ currentMethod indentationLevel: indentationLevel.
+ self push.
"Modified: / 23-04-2015 / 18:28:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
startMethod: id
- (cache includesKey: id) ifTrue: [ self error: 'OOOUPS!!' ].
+ (cache includesKey: id) ifTrue: [ self error: 'OOOUPS!!' ].
- currentMethod := PPCMethod new.
- currentMethod id: id.
- currentMethod profile: arguments profile.
- self push.
+ currentMethod := PPCMethod new.
+ currentMethod id: id.
+ currentMethod profile: arguments profile.
+ self push.
- self cache: id as: currentMethod.
+ self cache: id as: currentMethod.
"Modified: / 23-04-2015 / 18:36:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
stopInline
- ^ self pop.
+ ^ self pop.
"Modified: / 23-04-2015 / 18:28:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
stopMethod
- self cache: currentMethod methodName as: currentMethod.
-
- arguments profile ifTrue: [ Transcript crShow: currentMethod code ].
- ^ self pop.
+ self cache: currentMethod methodName as: currentMethod.
+
+ arguments profile ifTrue: [ Transcript crShow: currentMethod code ].
+ ^ self pop.
"Modified: / 23-04-2015 / 18:36:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
top
- ^ compilerStack top
+ ^ compilerStack top
! !
!PPCCompiler methodsFor:'code generation - variables'!
@@ -380,104 +412,73 @@
!PPCCompiler methodsFor:'compiling'!
compileParser
- self installVariables.
- self installMethods.
- self installClassConstants.
+ self installVariables.
+ self installMethods.
+ self installClassConstants.
- ^ compiledParser
+ ^ compiledParser
!
copy: parser
- ^ parser transform: [ :p | p copy ].
+ ^ parser transform: [ :p | p copy ].
!
installClassConstants
- constants keysAndValuesDo: [ :key :value |
- compiledParser constants at: key put: value
- ]
+ constants keysAndValuesDo: [ :key :value |
+ compiledParser constants at: key put: value
+ ]
!
installMethods
- cache keysAndValuesDo: [ :key :method |
- compiledParser compileSilently: method code classified: 'generated'.
- ]
+ cache keysAndValuesDo: [ :key :method |
+ compiledParser compileSilently: method code classified: 'generated'.
+ ]
!
installVariables
- | varString |
- varString := constants keys inject: '' into: [:r :e | r, ' ', e ].
-
- PPCompiledParser
- subclass: compiledParserName
- instanceVariableNames: varString
- classVariableNames: ''
- poolDictionaries: ''
- category: 'PetitCompiler-Generated'.
-
- compiledParser := Smalltalk at: compiledParserName.
-!
-
-precomputeFirstSets: root
- | firstSets |
- firstSets := root firstSets.
-
- root allNodesDo: [ :node |
- node firstSet: (firstSets at: node).
- ]
-
-!
+ | varString |
+ varString := constants keys inject: '' into: [:r :e | r, ' ', e ].
-precomputeFollowSets: root
- | followSets |
- followSets := root followSets.
-
- root allNodesDo: [ :node |
- node followSet: (followSets at: node).
- ]
-
-!
+ (self compiledParserSuperclass)
+ subclass: compiledParserName
+ instanceVariableNames: varString
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'PetitCompiler-Generated'.
-precomputeFollowSetsWithTokens: root
- | followSets |
- followSets := root followSetsSuchThat: [:e | e isTerminal or: [ e isKindOf: PPCTrimmingTokenNode ]].
-
- root allNodesDo: [ :node |
- node followSetWithTokens: (followSets at: node).
- ]
-
-!
-
-toCompilerTree: parser
- ^ parser asCompilerTree
+ compiledParser := Smalltalk at: compiledParserName.
! !
!PPCCompiler methodsFor:'initialization'!
initializeForCompiledClassName: aString
-
- self initialize.
- compilerStack := Stack new.
- cache := IdentityDictionary new.
- constants := IdentityDictionary new.
- ids := IdentityDictionary new.
-
+
+ self initialize.
+ compilerStack := Stack new.
+ cache := IdentityDictionary new.
+ constants := IdentityDictionary new.
+ ids := IdentityDictionary new.
+
- compiledParserName := aString asSymbol.
-
- ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
- | rPackageOrganizer |
- rPackageOrganizer := Smalltalk at: #RPackageOrganizer.
- rPackageOrganizer notNil ifTrue:[
- rPackageOrganizer default registerPackageNamed: 'PetitCompiler-Generated'.
- ].
- ] ifFalse: [
- RPackageOrganizer default registerPackageNamed: 'PetitCompiler-Generated'.
- ].
+ compiledParserName := aString asSymbol.
+
+ ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
+ | rPackageOrganizer |
+ rPackageOrganizer := Smalltalk at: #RPackageOrganizer.
+ rPackageOrganizer notNil ifTrue:[
+ rPackageOrganizer default registerPackageNamed: 'PetitCompiler-Generated'.
+ ].
+ ] ifFalse: [
+ RPackageOrganizer default registerPackageNamed: 'PetitCompiler-Generated'.
+ ].
- Smalltalk at: compiledParserName ifPresent: [ :class |
- compiledParser := class.
- self clean: compiledParser.
- ].
+ Smalltalk at: compiledParserName ifPresent: [ :class |
+ compiledParser := class.
+ self clean: compiledParser.
+ ].
+
+
+ Transcript cr; show: 'intialized for: ', aString; cr.
! !
!PPCCompiler class methodsFor:'documentation'!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCCompilerTokenRememberStrategy.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,45 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCCompilerTokenRememberStrategy
+ instanceVariableNames:'compiler'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Core'
+!
+
+!PPCCompilerTokenRememberStrategy class methodsFor:'instance creation'!
+
+on: aPPCCompiler
+ ^ self new
+ compiler: aPPCCompiler;
+ yourself
+! !
+
+!PPCCompilerTokenRememberStrategy methodsFor:'accessing'!
+
+compiler: aPPCCompiler
+ compiler := aPPCCompiler
+! !
+
+!PPCCompilerTokenRememberStrategy methodsFor:'as yet unclassified'!
+
+smartRemember: parser to: variableName
+ parser isContextFree ifTrue: [
+ compiler codeAssign: 'context lwRemember.'
+ to: variableName.
+ ] ifFalse: [
+ compiler codeAssign: 'context remember.'
+ to: variableName.
+ ]
+!
+
+smartRestore: parser from: mementoName
+ parser isContextFree ifTrue: [
+ compiler add: 'context lwRestore: ', mementoName, '.'.
+ ] ifFalse: [
+ compiler add: 'context restore: ', mementoName, '.'.
+ ].
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCCompilerTokenizingRememberStrategy.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,47 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCCompilerTokenizingRememberStrategy
+ instanceVariableNames:'compiler'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Core'
+!
+
+!PPCCompilerTokenizingRememberStrategy class methodsFor:'instance creation'!
+
+on: aPPCCompiler
+ ^ self new
+ compiler: aPPCCompiler;
+ yourself
+! !
+
+!PPCCompilerTokenizingRememberStrategy methodsFor:'accessing'!
+
+compiler: aPPCCompiler
+ compiler := aPPCCompiler
+! !
+
+!PPCCompilerTokenizingRememberStrategy methodsFor:'as yet unclassified'!
+
+smartRemember: parser to: variableName
+ parser isContextFree ifTrue: [
+ compiler codeAssign: '{ context lwRemember. currentTokenType . currentTokenValue }.'
+ to: variableName.
+ ] ifFalse: [
+ compiler codeAssign: '{ context remember. currentTokenType . currentTokenValue }.'
+ to: variableName.
+ ]
+!
+
+smartRestore: parser from: mementoName
+ parser isContextFree ifTrue: [
+ compiler add: 'context lwRestore: ', mementoName, ' first.'.
+ ] ifFalse: [
+ compiler add: 'context restore: ', mementoName, ' first.'.
+ ].
+ compiler codeAssign: mementoName, ' second.' to: 'currentTokenType'.
+ compiler codeAssign: mementoName, ' third.' to: 'currentTokenValue'.
+! !
+
--- a/compiler/PPCConfiguration.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCConfiguration.st Sun May 10 06:28:36 2015 +0100
@@ -11,125 +11,226 @@
!PPCConfiguration class methodsFor:'as yet unclassified'!
+LL1
+ ^ PPCLL1Configuration new
+!
+
default
- ^ PPCFirstPrototype new
+ ^ self universal
!
new
- ^ self basicNew
- initialize;
- yourself
+ ^ self basicNew
+ initialize;
+ yourself
+!
+
+universal
+ ^ PPCUniversalConfiguration new
! !
!PPCConfiguration methodsFor:'accessing'!
+arguments
+ arguments isNil ifTrue: [ arguments := self defaultArguments ].
+ ^ arguments
+!
+
arguments: args
- arguments := args
+ arguments := args
+!
+
+defaultArguments
+ ^ PPCArguments default
!
input: whatever
- ir := whatever.
- self remember: #input.
+ ir := whatever.
+ self remember: #input.
!
ir
- ^ ir
+ ^ ir
!
ir: whatever
- ir := whatever
+ ir := whatever
! !
-!PPCConfiguration methodsFor:'as yet unclassified'!
+!PPCConfiguration methodsFor:'caching'!
+
+cacheFirstSet
+ "Creates a PPCNodes from a PPParser"
+ | firstSets |
+ firstSets := ir firstSets.
+ ir allNodesDo: [ :node |
+ node firstSet: (firstSets at: node)
+ ]
+!
+
+cacheFirstSetWithProductions
+ "Creates a PPCNodes from a PPParser"
+ | firstSets |
+ firstSets := ir firstSetsSuchThat: [:e | e name isNil not ].
+ ir allNodesDo: [ :node |
+ node firstSetWithProductions: (firstSets at: node)
+ ]
+!
+
+cacheFirstSetWithTokens
+ "Creates a PPCNodes from a PPParser"
+ | firstSets |
+ firstSets := ir firstSetsSuchThat: [:e | e isTerminal or: [ e isTokenNode ] ].
+ ir allNodesDo: [ :node |
+ node firstSetWithTokens: (firstSets at: node)
+ ]
+!
+
+cacheFollowSet
+ "Creates a PPCNodes from a PPParser"
+ | followSets |
+ followSets := ir followSets.
+ ir allNodesDo: [ :node |
+ node followSet: (followSets at: node)
+ ]
+!
+
+cacheFollowSetWithTokens
+ "Creates a PPCNodes from a PPParser"
+ | followSets |
+ followSets := ir firstSetsSuchThat: [:e | e isTerminal or: [ e isTokenNode ] ].
+ ir allNodesDo: [ :node |
+ node followSetWithTokens: (followSets at: node)
+ ]
+! !
+
+!PPCConfiguration methodsFor:'compiling'!
compile: whatever
- self input: whatever.
- self invokePhases.
- ^ ir
+ self input: whatever.
+ self invokePhases.
+ ^ ir
!
-compile: whatever arguments: args
- self arguments: args.
- ^ self compile: whatever.
+invokePhases
+ self subclassResponsibility
+! !
+
+!PPCConfiguration methodsFor:'debugging'!
+
+copy: somethingTransformable
+ ^ somethingTransformable transform: [ :e | e copy ]
!
remember: key
- arguments debug ifTrue: [
- history add: key -> (ir copy).
- ]
+ self arguments debug ifTrue: [
+ history add: key -> (self copy: ir).
+ ]
+! !
+
+!PPCConfiguration methodsFor:'hooks'!
+
+codeCompilerOn: args
+ ^ PPCCompiler on: args
+!
+
+codeGeneratorVisitorOn: compiler
+ ^ arguments codeGenerator on: compiler
! !
!PPCConfiguration methodsFor:'initialization'!
initialize
- history := OrderedCollection new
+ history := OrderedCollection new
! !
!PPCConfiguration methodsFor:'phases'!
+cacheFirstFollow
+ arguments cacheFirstFollow ifFalse: [ ^ self ] .
+
+ self cacheFirstSet.
+ self cacheFollowSet.
+ self cacheFirstSetWithTokens.
+ self cacheFollowSetWithTokens.
+!
+
check
- ir checkTree
+ ir checkTree
+!
+
+createRecognizingComponents
+ arguments recognizingComponents ifFalse: [ ^ self ] .
+
+ ir := PPCRecognizerComponentDetector new
+ arguments: arguments;
+ visit: ir.
+ self remember: #recognizingComponents
+!
+
+createTokens
+ arguments detectTokens ifFalse: [ ^ self ] .
+
+ ir := PPCTokenDetector new
+ arguments: arguments;
+ visit: ir.
+ self remember: #createTokens
!
generate
- | compiler rootMethod compiledParser |
- arguments generate ifFalse: [ ^ self ].
-
- compiler := PPCCompiler on: arguments.
-
- rootMethod := (PPCCodeGenerator on: compiler)
- arguments: arguments;
- visit: ir.
-
- compiler compileParser.
- compiler compiledParser startSymbol: rootMethod methodName.
- compiledParser := compiler compiledParser new.
-
- ir := compiledParser.
+ | compiler rootMethod compiledParser |
+ arguments generate ifFalse: [ ^ self ].
+
+ compiler := self codeCompilerOn: arguments.
+
+ rootMethod := (self codeGeneratorVisitorOn: compiler)
+ arguments: arguments;
+ visit: ir.
+
+ compiler compileParser.
+ compiler compiledParser startSymbol: rootMethod methodName.
+ compiledParser := compiler compiledParser new.
+
+ ir := compiledParser.
!
inline
- arguments inline ifFalse: [ ^ self ].
-
- ir := PPCInliningVisitor new
- arguments: arguments;
- visit: ir.
- self remember: #inline.
+ arguments inline ifFalse: [ ^ self ].
+
+ ir := PPCInliningVisitor new
+ arguments: arguments;
+ visit: ir.
+ self remember: #inline.
!
merge
- arguments merge ifFalse: [ ^ self ].
-
- ir := PPCMergingVisitor new
- arguments: arguments;
- visit: ir.
- self remember: #merge
+ "Merge equivalent nodes under one object with single identity"
+ arguments merge ifFalse: [ ^ self ].
+
+ ir := PPCMergingVisitor new
+ arguments: arguments;
+ visit: ir.
+ self remember: #merge
!
specialize
- arguments specialize ifFalse: [ ^ self ].
+ arguments specialize ifFalse: [ ^ self ].
- "
- Invokes a visitor that creates specialized nodes
- for some patterns of PPCNodes
- "
- ir := (PPCOptimizingVisitor new
- arguments: arguments;
- visit: ir).
- self remember: #specialize
+ "
+ Invokes a visitor that creates specialized nodes
+ for some patterns of PPCNodes,
+
+ e.g. $a astar can be represented by PPCCharacterStarNode
+ "
+ ir := (PPCSpecializingVisitor new
+ arguments: arguments;
+ visit: ir).
+ self remember: #specialize
!
toPPCIr
- ir := ir asCompilerTree.
- self remember: #ppcNodes
-!
-
-tokenize
- arguments tokenize ifFalse: [ ^ self ] .
-
- ir := PPCTokenDetector new
- arguments: arguments;
- visit: ir.
- self remember: #tokenize
+ "Creates a PPCNodes from a PPParser"
+ ir := ir asCompilerTree.
+ self remember: #ppcNodes
! !
--- a/compiler/PPCContext.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCContext.st Sun May 10 06:28:36 2015 +0100
@@ -3,7 +3,8 @@
"{ NameSpace: Smalltalk }"
PPStream subclass:#PPCContext
- instanceVariableNames:'root properties globals furthestFailure compiledParser rc ws'
+ instanceVariableNames:'root properties globals furthestFailure compiledParser rc ws
+ currentTokenType currentTokenValue'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Context'
@@ -13,269 +14,269 @@
!PPCContext class methodsFor:'as yet unclassified'!
new
- ^ self basicNew initialize
+ ^ self basicNew initialize
!
on: aPPParser stream: aStream
- ^ self basicNew
- initialize;
- root: aPPParser;
- stream: aStream asPetitStream;
- yourself
+ ^ self basicNew
+ initialize;
+ root: aPPParser;
+ stream: aStream asPetitStream;
+ yourself
! !
!PPCContext methodsFor:'accessing-globals'!
globalAt: aKey
- "Answer the global property value associated with aKey."
-
- ^ self globalAt: aKey ifAbsent: [ self error: 'Property not found' ]
+ "Answer the global property value associated with aKey."
+
+ ^ self globalAt: aKey ifAbsent: [ self error: 'Property not found' ]
!
globalAt: aKey ifAbsent: aBlock
- "Answer the global property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
-
- ^ globals isNil
- ifTrue: [ aBlock value ]
- ifFalse: [ globals at: aKey ifAbsent: aBlock ]
+ "Answer the global property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
+
+ ^ globals isNil
+ ifTrue: [ aBlock value ]
+ ifFalse: [ globals at: aKey ifAbsent: aBlock ]
!
globalAt: aKey ifAbsentPut: aBlock
- "Answer the global property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value."
-
- ^ self globalAt: aKey ifAbsent: [ self globalAt: aKey put: aBlock value ]
+ "Answer the global property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value."
+
+ ^ self globalAt: aKey ifAbsent: [ self globalAt: aKey put: aBlock value ]
!
globalAt: aKey put: anObject
- "Set the global property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
+ "Set the global property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
- ^ (globals ifNil: [ globals := Dictionary new: 1 ])
- at: aKey put: anObject
+ ^ (globals ifNil: [ globals := Dictionary new: 1 ])
+ at: aKey put: anObject
!
hasGlobal: aKey
- "Test if the global property aKey is present."
-
- ^ globals notNil and: [ globals includesKey: aKey ]
+ "Test if the global property aKey is present."
+
+ ^ globals notNil and: [ globals includesKey: aKey ]
!
invoke: parser
- ^ parser parseOn: self
+ ^ parser parseOn: self
!
peek2
- position = readLimit ifTrue: [ ^ nil ].
- ^ collection at: (position + 1)
+ position = readLimit ifTrue: [ ^ nil ].
+ ^ collection at: (position + 1)
!
removeGlobal: aKey
- "Remove the property with aKey. Answer the property or raise an error if aKey isn't found."
-
- ^ self removeGlobal: aKey ifAbsent: [ self error: 'Property not found' ]
+ "Remove the property with aKey. Answer the property or raise an error if aKey isn't found."
+
+ ^ self removeGlobal: aKey ifAbsent: [ self error: 'Property not found' ]
!
removeGlobal: aKey ifAbsent: aBlock
- "Remove the global property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."
-
- | answer |
- globals isNil ifTrue: [ ^ aBlock value ].
- answer := globals removeKey: aKey ifAbsent: aBlock.
- globals isEmpty ifTrue: [ globals := nil ].
- ^ answer
+ "Remove the global property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."
+
+ | answer |
+ globals isNil ifTrue: [ ^ aBlock value ].
+ answer := globals removeKey: aKey ifAbsent: aBlock.
+ globals isEmpty ifTrue: [ globals := nil ].
+ ^ answer
! !
!PPCContext methodsFor:'accessing-properties'!
hasProperty: aKey
- "Test if the property aKey is present."
-
- ^ properties notNil and: [ properties includesKey: aKey ]
+ "Test if the property aKey is present."
+
+ ^ properties notNil and: [ properties includesKey: aKey ]
!
propertyAt: aKey
- "Answer the property value associated with aKey."
-
- ^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ]
+ "Answer the property value associated with aKey."
+
+ ^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ]
!
propertyAt: aKey ifAbsent: aBlock
- "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
-
- ^ properties isNil
- ifTrue: [ aBlock value ]
- ifFalse: [ properties at: aKey ifAbsent: aBlock ]
+ "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
+
+ ^ properties isNil
+ ifTrue: [ aBlock value ]
+ ifFalse: [ properties at: aKey ifAbsent: aBlock ]
!
propertyAt: aKey ifAbsentPut: aBlock
- "Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value."
-
- ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]
+ "Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value."
+
+ ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]
!
propertyAt: aKey put: anObject
- "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
+ "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
- ^ (properties ifNil: [ properties := Dictionary new: 1 ])
- at: aKey put: anObject
+ ^ (properties ifNil: [ properties := Dictionary new: 1 ])
+ at: aKey put: anObject
!
removeProperty: aKey
- "Remove the property with aKey. Answer the property or raise an error if aKey isn't found."
-
- ^ self removeProperty: aKey ifAbsent: [ self error: 'Property not found' ]
+ "Remove the property with aKey. Answer the property or raise an error if aKey isn't found."
+
+ ^ self removeProperty: aKey ifAbsent: [ self error: 'Property not found' ]
!
removeProperty: aKey ifAbsent: aBlock
- "Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."
-
- | answer |
- properties isNil ifTrue: [ ^ aBlock value ].
- answer := properties removeKey: aKey ifAbsent: aBlock.
- properties isEmpty ifTrue: [ properties := nil ].
- ^ answer
+ "Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."
+
+ | answer |
+ properties isNil ifTrue: [ ^ aBlock value ].
+ answer := properties removeKey: aKey ifAbsent: aBlock.
+ properties isEmpty ifTrue: [ properties := nil ].
+ ^ answer
! !
!PPCContext methodsFor:'acessing'!
initializeFor: parser
- rc := 0.
- parser == root ifTrue: [ ^ self ].
-
- root := parser.
+ rc := 0.
+ parser == root ifTrue: [ ^ self ].
+
+ root := parser.
!
root
- ^ root
+ ^ root
!
stream
- ^ self
+ ^ self
!
stream: aStream
- collection := aStream collection.
- position := aStream position.
- readLimit := collection size.
+ collection := aStream collection.
+ position := aStream position.
+ readLimit := collection size.
! !
!PPCContext methodsFor:'converting'!
asCompiledParserContext
- ^ self
+ ^ self
! !
!PPCContext methodsFor:'failures'!
furthestFailure
- ^ furthestFailure
+ ^ furthestFailure
!
noteFailure: aPPFailure
- (aPPFailure position > furthestFailure position)
- ifTrue: [ furthestFailure := aPPFailure ].
+ (aPPFailure position > furthestFailure position)
+ ifTrue: [ furthestFailure := aPPFailure ].
! !
!PPCContext methodsFor:'initialization'!
compiledParser
- ^ compiledParser
+ ^ compiledParser
!
compiledParser: anObject
- compiledParser := anObject
+ compiledParser := anObject
!
initialize
-
- rc := 0.
- "Note a failure at -1"
- furthestFailure := PPFailure new position: -1; yourself.
+
+ rc := 0.
+ "Note a failure at -1"
+ furthestFailure := PPFailure new position: -1; yourself.
! !
!PPCContext methodsFor:'memoization'!
lwRemember
- ^ position
+ ^ position
!
lwRestore: aPPContextMemento
-
- position := aPPContextMemento.
+
+ position := aPPContextMemento.
!
remember
- | memento |
+ | memento |
"
- ^ position
+ ^ position
"
- memento := PPCContextMemento new
- position: position;
- yourself.
-
- self rememberProperties: memento.
- "JK: Just while developing"
- rc := rc + 1.
- (rc > ((self size + 1)* 1000*1000)) ifTrue: [ self error: 'Hey, this is not normal, is it?' ].
- ^ memento
+ memento := PPCContextMemento new
+ position: position;
+ yourself.
+
+ self rememberProperties: memento.
+ "JK: Just while developing"
+ rc := rc + 1.
+ (rc > ((self size + 1)* 1000*1000)) ifTrue: [ self error: 'Hey, this is not normal, is it?' ].
+ ^ memento
!
rememberProperties: aPPContextMemento
- properties ifNil: [ ^ self ].
-
- properties keysAndValuesDo: [ :key :value |
- aPPContextMemento propertyAt: key put: value
- ].
+ properties ifNil: [ ^ self ].
+
+ properties keysAndValuesDo: [ :key :value |
+ aPPContextMemento propertyAt: key put: value
+ ].
!
restore: aPPContextMemento
"
- position := aPPContextMemento.
+ position := aPPContextMemento.
"
- position := aPPContextMemento position.
-
- self restoreProperties: aPPContextMemento.
-
+ position := aPPContextMemento position.
+
+ self restoreProperties: aPPContextMemento.
+
!
restoreProperties: aPPContextMemento
- properties ifNil: [ ^ self ].
-
- properties keysDo: [ :key |
- (aPPContextMemento hasProperty: key)
- ifTrue: [ properties at: key put: (aPPContextMemento propertyAt: key) ]
- ifFalse: [ properties removeKey: key ].
- ].
+ properties ifNil: [ ^ self ].
+
+ properties keysDo: [ :key |
+ (aPPContextMemento hasProperty: key)
+ ifTrue: [ properties at: key put: (aPPContextMemento propertyAt: key) ]
+ ifFalse: [ properties removeKey: key ].
+ ].
- aPPContextMemento keysAndValuesDo: [ :key :value |
- properties at: key put: value
- ]
+ aPPContextMemento keysAndValuesDo: [ :key :value |
+ properties at: key put: value
+ ]
! !
!PPCContext methodsFor:'whitespace'!
atWs
- ^ position = ws
+ ^ position = ws
!
goUpTo: char
- [ position < readLimit ] whileTrue: [
- (collection at: position + 1) == char ifTrue: [ position := position + 1. ^ char ] .
- position := position + 1.
- ]
-
+ [ position < readLimit ] whileTrue: [
+ (collection at: position + 1) == char ifTrue: [ position := position + 1. ^ char ] .
+ position := position + 1.
+ ]
+
!
setWs
- ^ ws := position
+ ^ ws := position
!
ws
- ^ ws
+ ^ ws
!
ws: anInteger
- ws := anInteger
+ ws := anInteger
! !
!PPCContext class methodsFor:'documentation'!
--- a/compiler/PPCContextMemento.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCContextMemento.st Sun May 10 06:28:36 2015 +0100
@@ -12,99 +12,99 @@
!PPCContextMemento methodsFor:'accessing'!
position
- ^ position
+ ^ position
!
position: anInteger
- position := anInteger
+ position := anInteger
! !
!PPCContextMemento methodsFor:'accessing - properties'!
hasProperty: aKey
- "Test if the property aKey is present."
-
- ^ properties notNil and: [ properties includesKey: aKey ]
+ "Test if the property aKey is present."
+
+ ^ properties notNil and: [ properties includesKey: aKey ]
!
keysAndValuesDo: aBlock
- properties ifNil: [ ^ self ].
- properties keysAndValuesDo: [ :key :value | aBlock value: key value: value copy ]
+ properties ifNil: [ ^ self ].
+ properties keysAndValuesDo: [ :key :value | aBlock value: key value: value copy ]
!
propertiesSize
- properties ifNil: [ ^ 0 ].
- ^ properties size.
+ properties ifNil: [ ^ 0 ].
+ ^ properties size.
!
propertyAt: aKey
- "Answer the property value associated with aKey."
-
- ^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ]
+ "Answer the property value associated with aKey."
+
+ ^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ]
!
propertyAt: aKey ifAbsent: aBlock
- "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
+ "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
- properties isNil ifFalse: [
- (properties includesKey: aKey) ifTrue: [
- ^ (properties at: aKey) copy
- ].
- ].
- ^ aBlock value
+ properties isNil ifFalse: [
+ (properties includesKey: aKey) ifTrue: [
+ ^ (properties at: aKey) copy
+ ].
+ ].
+ ^ aBlock value
"Modified: / 15-04-2015 / 11:19:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
propertyAt: aKey ifAbsentPut: aBlock
- "Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value."
-
- ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]
+ "Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value."
+
+ ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]
!
propertyAt: aKey put: anObject
- "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
+ "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
- ^ (properties ifNil: [ properties := Dictionary new: 1 ])
- at: aKey put: (anObject copy)
+ ^ (properties ifNil: [ properties := Dictionary new: 1 ])
+ at: aKey put: (anObject copy)
!
removeProperty: aKey
- "Remove the property with aKey. Answer the property or raise an error if aKey isn't found."
-
- ^ self removeProperty: aKey ifAbsent: [ self error: 'Property not found' ]
+ "Remove the property with aKey. Answer the property or raise an error if aKey isn't found."
+
+ ^ self removeProperty: aKey ifAbsent: [ self error: 'Property not found' ]
!
removeProperty: aKey ifAbsent: aBlock
- "Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."
-
- | answer |
- properties isNil ifTrue: [ ^ aBlock value ].
- answer := properties removeKey: aKey ifAbsent: aBlock.
- properties isEmpty ifTrue: [ properties := nil ].
- ^ answer
+ "Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."
+
+ | answer |
+ properties isNil ifTrue: [ ^ aBlock value ].
+ answer := properties removeKey: aKey ifAbsent: aBlock.
+ properties isEmpty ifTrue: [ properties := nil ].
+ ^ answer
! !
!PPCContextMemento methodsFor:'comparing'!
= anObject
-
- (self == anObject) ifTrue: [ ^ true ].
- (anObject class = PPCContextMemento) ifFalse: [ ^ false ].
-
- (anObject position = position) ifFalse: [ ^ false ].
+
+ (self == anObject) ifTrue: [ ^ true ].
+ (anObject class = PPCContextMemento) ifFalse: [ ^ false ].
+
+ (anObject position = position) ifFalse: [ ^ false ].
- (self propertiesSize = anObject propertiesSize) ifFalse: [ ^ false ].
+ (self propertiesSize = anObject propertiesSize) ifFalse: [ ^ false ].
- self keysAndValuesDo: [ :key :value |
- (anObject hasProperty: key) ifFalse: [ ^ false ].
- ((anObject propertyAt: key) = value) ifFalse: [ ^ false ].
+ self keysAndValuesDo: [ :key :value |
+ (anObject hasProperty: key) ifFalse: [ ^ false ].
+ ((anObject propertyAt: key) = value) ifFalse: [ ^ false ].
].
-
- ^ true.
+
+ ^ true.
!
hash
- ^ position hash bitXor: properties hash.
+ ^ position hash bitXor: properties hash.
! !
--- a/compiler/PPCCopyVisitor.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCCopyVisitor.st Sun May 10 06:28:36 2015 +0100
@@ -12,9 +12,9 @@
!PPCCopyVisitor methodsFor:'as yet unclassified'!
visitNode: node
- | newNode |
- self change.
- newNode := node copy.
- ^ super visitNode: newNode.
+ | newNode |
+ self change.
+ newNode := node copy.
+ ^ super visitNode: newNode.
! !
--- a/compiler/PPCDelegateNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCDelegateNode.st Sun May 10 06:28:36 2015 +0100
@@ -13,35 +13,39 @@
!PPCDelegateNode methodsFor:'accessing'!
child
- ^ child
+ ^ child
!
child: whatever
- child := whatever
+ child := whatever
!
children
- ^ { child }
+ ^ { child }
! !
!PPCDelegateNode methodsFor:'analysis'!
acceptsEpsilon
- ^ child acceptsEpsilonOpenSet: (IdentitySet with: self).
+ ^ child acceptsEpsilonOpenSet: (IdentitySet with: self).
!
acceptsEpsilonOpenSet: set
- (set includes: child) ifFalse: [
- set add: child.
- ^ child acceptsEpsilonOpenSet: set
- ].
- ^ false
+ (set includes: child) ifFalse: [
+ set add: child.
+ ^ child acceptsEpsilonOpenSet: set
+ ].
+ ^ false
+!
+
+recognizedSentencesPrim
+ ^ self child recognizedSentencesPrim
! !
!PPCDelegateNode methodsFor:'transformation'!
replace: node with: anotherNode
- child == node ifTrue: [ child := anotherNode ]
+ child == node ifTrue: [ child := anotherNode ]
! !
!PPCDelegateNode class methodsFor:'documentation'!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCDeterministicChoiceNode.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,17 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCChoiceNode subclass:#PPCDeterministicChoiceNode
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Nodes'
+!
+
+!PPCDeterministicChoiceNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitDeterministicChoiceNode: self
+! !
+
--- a/compiler/PPCEndOfFileNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCEndOfFileNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,12 +12,24 @@
!PPCEndOfFileNode methodsFor:'accessing'!
prefix
- ^ #eof
+ ^ #eof
+! !
+
+!PPCEndOfFileNode methodsFor:'analysis'!
+
+acceptsEpsilon
+ self halt.
+ ^ false
+!
+
+acceptsEpsilonOpenSet: set
+ self halt.
+ ^ false
! !
!PPCEndOfFileNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitEndOfFileNode: self.
+ ^ visitor visitEndOfFileNode: self.
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCEndOfInputNode.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,21 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCDelegateNode subclass:#PPCEndOfInputNode
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Nodes'
+!
+
+!PPCEndOfInputNode methodsFor:'as yet unclassified'!
+
+accept: visitor
+ ^ visitor visitEndOfInputNode: self
+!
+
+prefix
+ ^ #endOfInput
+! !
+
--- a/compiler/PPCFirstPrototype.st Thu Apr 30 23:43:14 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,24 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCConfiguration subclass:#PPCFirstPrototype
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Core'
-!
-
-!PPCFirstPrototype methodsFor:'as yet unclassified'!
-
-invokePhases
- self toPPCIr.
- self specialize.
- self tokenize.
- self specialize.
- self inline.
- self merge.
- self check.
- self generate.
-! !
-
--- a/compiler/PPCForwardNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCForwardNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,21 +12,21 @@
!PPCForwardNode methodsFor:'accessing'!
prefix
- ^ #fw
+ ^ #fw
! !
!PPCForwardNode methodsFor:'analysis'!
check
- ^ (self name notNil and: [
- child name = self name and: [
- child suffix = self suffix
- ]]) ifTrue: [ 'referring to itself!!' ]
+ ^ (self name notNil and: [
+ child name = self name and: [
+ child suffix = self suffix
+ ]]) ifTrue: [ 'referring to itself!!' ]
! !
!PPCForwardNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitForwardNode: self
+ ^ visitor visitForwardNode: self
! !
--- a/compiler/PPCGuard.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCGuard.st Sun May 10 06:28:36 2015 +0100
@@ -12,104 +12,76 @@
!PPCGuard class methodsFor:'as yet unclassified'!
on: aPPCNode
- ^ self new
- initializeFor: aPPCNode;
- yourself
+ ^ self new
+ initializeFor: aPPCNode;
+ yourself
! !
!PPCGuard methodsFor:'accessing'!
classification
- ^ classification
+ ^ classification
!
id
-
- ^ id
+
+ ^ id
!
id: anObject
-
- id := anObject
+
+ id := anObject
!
message
- (message == #unknown) ifTrue: [
- (self testMessage: #isLetter) ifTrue: [ ^ message := #isLetter ].
- (self testMessage: #isAlphaNumeric) ifTrue: [ ^ message := #isAlphaNumeric ].
- (self testMessage: #isDigit) ifTrue: [ ^ message := #isDigit ].
-
- ^ message := nil.
- ].
- ^ message
+ (message == #unknown) ifTrue: [
+ (self testMessage: #isLetter) ifTrue: [ ^ message := #isLetter ].
+ (self testMessage: #isAlphaNumeric) ifTrue: [ ^ message := #isAlphaNumeric ].
+ (self testMessage: #isDigit) ifTrue: [ ^ message := #isDigit ].
+
+ ^ message := nil.
+ ].
+ ^ message
! !
!PPCGuard methodsFor:'as yet unclassified'!
classificationOn: aBlock
- classification := Array new: 255.
- 1 to: classification size do: [ :index |
- classification at: index put: (aBlock
- value: (Character value: index)) ].
+ classification := Array new: 255.
+ 1 to: classification size do: [ :index |
+ classification at: index put: (aBlock
+ value: (Character value: index)) ].
!
compileAny: compiler
- compiler add: '(context atEnd not)'.
+ compiler add: '(context atEnd not)'.
!
compileCharacter: compiler
- self assert: (classification select: [ :e | e ]) size = 1.
-
- classification keysAndValuesDo: [ :index :value | value ifTrue: [
- (index > 32 and: [ index < 127 ]) ifTrue: [
- compiler add: '(context peek = ', (Character value: index) storeString, ')'
- ] ifFalse: [
- id := compiler idFor: (Character value: index) prefixed: #character.
- compiler addConstant: (Character value: index) as: id.
- compiler add: '(context peek = ', id, ')'.
- ]
- ] ].
-
+ self assert: (classification select: [ :e | e ]) size = 1.
+
+ classification keysAndValuesDo: [ :index :value | value ifTrue: [
+ (index > 32 and: [ index < 127 ]) ifTrue: [
+ compiler add: '(context peek = ', (Character value: index) storeString, ')'
+ ] ifFalse: [
+ id := compiler idFor: (Character value: index) prefixed: #character.
+ compiler addConstant: (Character value: index) as: id.
+ compiler add: '(context peek = ', id, ')'.
+ ]
+ ] ].
!
compileGuard: compiler id: symbol
- self id: symbol.
- ^ self compileGuard: compiler
+ self id: symbol.
+ ^ self compileGuard: compiler
!
compileMessage: compiler
- compiler add: '(context peek ', message, ')'
-!
-
-initializeFor: node
- message := #unknown.
- id := nil.
-
- "No Guards for trimming parser so far"
- ((node firstSetSuchThat: [ :e | e isKindOf: PPCTrimNode ]) isEmpty) ifFalse: [
- ^ self initializeForNoGuard
- ].
- (node acceptsEpsilon) ifTrue: [
- ^ self initializeForEpsilon
- ].
-
- self classificationOn: [:char | node firstSet anySatisfy: [:e | (e firstCharSetCached value: char) ]]
-
-" self classificationOn: [ :char | node firstSet anySatisfy: [ :e | (e firstCharParser parse: char asString) isPetitFailure not ] ]"
-!
-
-initializeForEpsilon
- classification := nil
-
-!
-
-initializeForNoGuard
- classification := nil
-
+ compiler add: '(context peek ', message, ')'
!
testAny
- ^ classification allSatisfy: [ :e | e ].
+ ^ classification allSatisfy: [ :e | e ].
!
testMessage: selector
@@ -122,33 +94,62 @@
!
testSingleCharacter
- ^ (classification select: [ :e | e ]) size = 1
+ ^ (classification select: [ :e | e ]) size = 1
! !
!PPCGuard methodsFor:'code generation'!
compileArray: compiler
- | array |
- self assert: id isNotNil.
+ | array |
+ self assert: id isNotNil.
- array := ((classification asOrderedCollection) addLast: false; yourself) asArray.
- compiler addConstant: array as: id.
- compiler add: '(', id, ' at: context peek asInteger)'.
+ array := ((classification asOrderedCollection) addLast: false; yourself) asArray.
+ compiler addConstant: array as: id.
+ compiler add: '(', id, ' at: context peek asInteger)'.
!
compileGuard: compiler
- self assert: self makesSense description: 'No Guard could be compiled'.
- self assert: id notNil.
-
-
- self message ifNotNil: [ ^ self compileMessage: compiler ].
- self testAny ifTrue: [ ^ self compileAny: compiler ].
- self testSingleCharacter ifTrue: [ ^ self compileCharacter: compiler ].
-
- ^ self compileArray: compiler
+ self assert: self makesSense description: 'No Guard could be compiled'.
+ self assert: id notNil.
+
+
+ self message ifNotNil: [ ^ self compileMessage: compiler ].
+ self testAny ifTrue: [ ^ self compileAny: compiler ].
+ self testSingleCharacter ifTrue: [ ^ self compileCharacter: compiler ].
+
+ ^ self compileArray: compiler
!
makesSense
- ^ classification isNil not
+ ^ classification isNil not
! !
+!PPCGuard methodsFor:'initialization'!
+
+initializeFor: node
+ message := #unknown.
+ id := nil.
+
+ "No Guards for trimming parser so far"
+" ((node firstSetSuchThat: [ :e | e isKindOf: PPCTrimNode ]) isEmpty) ifFalse: [
+ ^ self initializeForNoGuard
+ ]."
+ (node acceptsEpsilon) ifTrue: [
+ ^ self initializeForEpsilon
+ ].
+
+ self classificationOn: [:char | node firstSet anySatisfy: [:e | (e firstCharSetCached value: char) ]]
+
+" self classificationOn: [ :char | node firstSet anySatisfy: [ :e | (e firstCharParser parse: char asString) isPetitFailure not ] ]"
+!
+
+initializeForEpsilon
+ classification := nil
+
+!
+
+initializeForNoGuard
+ classification := nil
+
+! !
+
--- a/compiler/PPCInlinedMethod.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCInlinedMethod.st Sun May 10 06:28:36 2015 +0100
@@ -12,27 +12,27 @@
!PPCInlinedMethod methodsFor:'as yet unclassified'!
call
- ^ self code
+ ^ self code
!
code
- ^ buffer contents trimRight
+ ^ buffer contents trimRight
!
isInline
- ^ true
+ ^ true
! !
!PPCInlinedMethod methodsFor:'code generation - variables'!
allocateReturnVariable
- self error: 'return variable must be assigned by the non-inlined method....'
+ self error: 'return variable must be assigned by the non-inlined method....'
"Created: / 23-04-2015 / 21:06:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
allocateTemporaryVariableNamed:aString
- self error: 'sorry, I can''t allocate variables....'
+ self error: 'sorry, I can''t allocate variables....'
"Created: / 23-04-2015 / 21:06:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
--- a/compiler/PPCInliningVisitor.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCInliningVisitor.st Sun May 10 06:28:36 2015 +0100
@@ -12,61 +12,61 @@
!PPCInliningVisitor methodsFor:'initialization'!
initialize
- super initialize.
-
- acceptedNodes := 0
+ super initialize.
+
+ acceptedNodes := 0
! !
!PPCInliningVisitor methodsFor:'testing'!
canInline
- ^ acceptedNodes > 1
+ ^ acceptedNodes > 1
! !
!PPCInliningVisitor methodsFor:'visiting'!
beforeAccept: node
- acceptedNodes := acceptedNodes + 1.
- super beforeAccept: node
+ acceptedNodes := acceptedNodes + 1.
+ super beforeAccept: node
!
markForInline: node
- self canInline ifTrue: [
- node markForInline.
- ].
- ^ node
+ self canInline ifTrue: [
+ node markForInline.
+ ].
+ ^ node
!
visitCharSetPredicateNode: node
- ^ self markForInline: node
+ ^ self markForInline: node
!
visitCharacterNode: node
- ^ self markForInline: node
+ ^ self markForInline: node
!
visitLiteralNode: node
- ^ self markForInline: node
+ ^ self markForInline: node
!
visitMessagePredicateNode: node
- ^ self markForInline: node
+ ^ self markForInline: node
!
visitNilNode: node
- ^ self markForInline: node
+ ^ self markForInline: node
!
visitNotCharSetPredicateNode: node
- ^ self markForInline: node
+ ^ self markForInline: node
!
visitNotLiteralNode: node
- ^ self markForInline: node
+ ^ self markForInline: node
!
visitNotMessagePredicateNode: node
- ^ self markForInline: node
+ ^ self markForInline: node
!
visitPluggableNode: node
@@ -74,18 +74,32 @@
the VM does not provide enough information to map
it back to source code. Very bad indeed!!"
((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifFalse:[
- ^ self markForInline: node
+ self markForInline: node
].
^ super visitPluggableNode: node.
"Modified: / 23-04-2015 / 12:15:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+visitTokenConsumeNode: node
+ super visitTokenConsumeNode: node.
+ node name isNil ifTrue: [
+ self markForInline: node
+ ].
+ ^ node
+!
+
visitTokenStarMessagePredicateNode: node
- ^ self markForInline: node
+ ^ self markForInline: node
!
visitTokenStarSeparatorNode: node
- ^ self markForInline: node
+ ^ self markForInline: node
+!
+
+visitTokenWhitespaceNode: node
+ super visitTokenWhitespaceNode: node.
+ self markForInline: node.
+ ^ node
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCLL1Configuration.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,72 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCConfiguration subclass:#PPCLL1Configuration
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Core'
+!
+
+!PPCLL1Configuration methodsFor:'accessing'!
+
+defaultArguments
+ ^ PPCArguments default
+ guards: false;
+ yourself
+! !
+
+!PPCLL1Configuration methodsFor:'compiling'!
+
+invokePhases
+ self toPPCIr.
+ self createTokens.
+ self cacheFirstFollow.
+ self createLL1Choices.
+ self tokenize.
+
+ "Merge duplicate tokens and recompute first follow"
+ self merge.
+ self cacheFirstFollow.
+
+ self specialize.
+ self createRecognizingComponents.
+ self specialize.
+ self inline.
+ self merge.
+ self check.
+ self generate.
+! !
+
+!PPCLL1Configuration methodsFor:'hooks'!
+
+codeCompilerOn: args
+ ^ PPCTokenizingCompiler on: args
+!
+
+codeGeneratorVisitorOn: compiler
+ ^ PPCTokenizingCodeGenerator on: compiler
+! !
+
+!PPCLL1Configuration methodsFor:'phases'!
+
+createLL1Choices
+ ir := PPCLL1Visitor new
+ arguments: arguments;
+ visit: ir.
+ self remember: #LL1
+!
+
+tokenize
+ "
+ This will try transform the parser into the tokenizing parser
+ "
+ arguments tokenize ifFalse: [ ^ self ] .
+
+ ir := PPCTokenizingVisitor new
+ arguments: arguments;
+ visit: ir.
+ self remember: #tokenize
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCLL1Visitor.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,54 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCRewritingVisitor subclass:#PPCLL1Visitor
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Visitors'
+!
+
+!PPCLL1Visitor methodsFor:'as yet unclassified'!
+
+isDeterministicChoice: node
+ | firsts |
+ firsts := OrderedCollection new.
+ node children do: [ :child |
+ (self startsWithToken: child) ifFalse: [ ^ false ].
+ firsts addAll: child firstSetWithTokens.
+ ].
+ (firsts asIdentitySet size = firsts size) ifFalse: [ ^ false ].
+
+ firsts allPairsDo: [ :e1 :e2 |
+ e1 == e2 ifFalse: [
+ (e1 overlapsWith: e2) ifTrue: [ ^ false ] ].
+ ].
+ ^ true
+!
+
+startsWithToken: node
+ | firstSet terminal total |
+ total := 0.
+ firstSet := node firstSetWithTokens.
+
+ terminal := (firstSet detect: [ :e | e isTerminal ] ifNone: [ nil ]).
+ terminal isNil ifFalse: [ ^ false ].
+
+ ^ true
+!
+
+visitChoiceNode: node
+ super visitChoiceNode: node.
+ (self isDeterministicChoice: node) ifTrue: [
+ self change.
+ ^ PPCDeterministicChoiceNode new
+ children: node children;
+ name: node name;
+ firstFollowCache: node firstFollowCache;
+ yourself
+ ].
+
+ ^ node
+! !
+
--- a/compiler/PPCLLChoiceNode.st Thu Apr 30 23:43:14 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,17 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCChoiceNode subclass:#PPCLLChoiceNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-!PPCLLChoiceNode methodsFor:'visiting'!
-
-accept: visitor
- ^ visitor visitLLChoiceNode: self
-! !
-
--- a/compiler/PPCListNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCListNode.st Sun May 10 06:28:36 2015 +0100
@@ -13,51 +13,51 @@
!PPCListNode class methodsFor:'as yet unclassified'!
withAll: aCollection
- ^ self basicNew children: aCollection
+ ^ self basicNew children: aCollection
! !
!PPCListNode methodsFor:'accessing'!
children
- ^ children
+ ^ children
!
children: anObject
-
- children := anObject
+
+ children := anObject
!
firstChild
- ^ self children first
+ ^ self children first
!
secondChild
- ^ self children second
+ ^ self children second
! !
!PPCListNode methodsFor:'analysis'!
acceptsEpsilon
- self subclassResponsibility
+ self subclassResponsibility
!
acceptsEpsilonOpenSet: set
- self subclassResponsibility
+ self subclassResponsibility
! !
!PPCListNode methodsFor:'copying'!
postCopy
- super postCopy.
- children := children copy
+ super postCopy.
+ children := children copy
! !
!PPCListNode methodsFor:'transformation'!
replace: node with: anotherNode
- children keysAndValuesDo: [ :index :child |
- child == node ifTrue: [ children at: index put: anotherNode ]
- ]
+ children keysAndValuesDo: [ :index :child |
+ child == node ifTrue: [ children at: index put: anotherNode ]
+ ]
! !
!PPCListNode class methodsFor:'documentation'!
--- a/compiler/PPCLiteralNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCLiteralNode.st Sun May 10 06:28:36 2015 +0100
@@ -9,9 +9,22 @@
category:'PetitCompiler-Nodes'
!
+!PPCLiteralNode methodsFor:'comparing'!
+
+recognizedSentencesPrim
+ ^ Array with: literal.
+! !
+
+!PPCLiteralNode methodsFor:'printing'!
+
+printNameOn: aStream
+ super printNameOn: aStream.
+ aStream nextPutAll: ', '; print: literal
+! !
+
!PPCLiteralNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitLiteralNode: self
+ ^ visitor visitLiteralNode: self
! !
--- a/compiler/PPCMergingVisitor.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCMergingVisitor.st Sun May 10 06:28:36 2015 +0100
@@ -12,34 +12,34 @@
!PPCMergingVisitor methodsFor:'as yet unclassified'!
equivalentNode: node
- ^ nodeSet detect: [ :e | e = node ]
+ ^ nodeSet detect: [ :e | e = node ]
!
hasEquivalentNode: node
- ^ nodeSet includes: node
+ ^ nodeSet includes: node
!
initialize
- super initialize.
-
- nodeSet := Set new
+ super initialize.
+
+ nodeSet := Set new
!
store: node
- self assert: (self hasEquivalentNode: node) not.
- nodeSet add: node
+ self assert: (self hasEquivalentNode: node) not.
+ nodeSet add: node
!
visitNode: node
- super visitNode: node.
-
- (self hasEquivalentNode: node) ifTrue: [
- self change.
- ^ self equivalentNode: node
- ] ifFalse: [
- self store: node
- ].
+ super visitNode: node.
+
+ (self hasEquivalentNode: node) ifTrue: [
+ self change.
+ ^ self equivalentNode: node
+ ] ifFalse: [
+ self store: node
+ ].
- ^ node
+ ^ node
! !
--- a/compiler/PPCMessagePredicateNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCMessagePredicateNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,19 +12,19 @@
!PPCMessagePredicateNode methodsFor:'accessing'!
message
-
- ^ message
+
+ ^ message
!
message: anObject
-
- message := anObject
+
+ message := anObject
! !
!PPCMessagePredicateNode methodsFor:'analysis'!
firstCharSet
- ^ PPCharSetPredicate on: [:e | e perform: message ]
+ ^ PPCharSetPredicate on: [:e | e perform: message ]
"Modified: / 23-04-2015 / 22:13:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
@@ -32,17 +32,24 @@
!PPCMessagePredicateNode methodsFor:'comparing'!
= anotherNode
- super = anotherNode ifFalse: [ ^ false ].
- ^ message = anotherNode message.
+ super = anotherNode ifFalse: [ ^ false ].
+ ^ message = anotherNode message.
!
hash
- ^ super hash bitXor: message hash
+ ^ super hash bitXor: message hash
+! !
+
+!PPCMessagePredicateNode methodsFor:'printing'!
+
+printNameOn: aStream
+ super printNameOn: aStream.
+ aStream nextPutAll: ', '; print: message
! !
!PPCMessagePredicateNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitMessagePredicateNode: self
+ ^ visitor visitMessagePredicateNode: self
! !
--- a/compiler/PPCMethod.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCMethod.st Sun May 10 06:28:36 2015 +0100
@@ -18,118 +18,87 @@
^ self basicNew initialize.
! !
-!PPCMethod methodsFor:'as yet unclassified'!
-
-add: string
- self nl.
- indentation timesRepeat: [ buffer nextPut: Character tab ].
- self addOnLine: string.
-!
-
-addOnLine: string
- buffer nextPutAll: string.
-!
-
-addVariable: name
- (variables includes: name) ifTrue:[
- self error:'Duplicate variable name, must rename'.
- ].
- variables add: name.
-
- "Modified: / 23-04-2015 / 12:29:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
+!PPCMethod methodsFor:'accessing'!
body
- ^ buffer contents
+ ^ buffer contents
!
bridge
- ^ PPCBridge on: self methodName.
-!
-
-call
- ^ 'self ', self methodName, '.'.
+ ^ PPCBridge on: self methodName.
!
code
- ^ self methodName, Character cr asString,
- self variables, Character cr asString,
- self profilingBegin, Character cr asString,
- self body, Character cr asString
+ ^ self methodName, Character cr asString,
+ self variables, Character cr asString,
+ self profilingBegin, Character cr asString,
+ self body, Character cr asString
" self profilingEnd"
"Modified: / 23-04-2015 / 19:26:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-dedent
- indentation := indentation - 1
-!
-
id: value
- id := value
-!
-
-indent
- indentation := indentation + 1
-!
-
-isInline
- ^ false
-!
-
-isMethod
- ^ true
+ id := value
!
methodName
- ^ id
-!
-
-nl
- ^ buffer nextPut: Character cr
+ ^ id
!
profile
- ^ profile
+ ^ profile
!
profile: aBoolean
- profile := aBoolean
+ profile := aBoolean
+! !
+
+!PPCMethod methodsFor:'as yet unclassified'!
+
+add: string
+ self nl.
+ indentation timesRepeat: [ buffer nextPut: Character tab ].
+ self addOnLine: string.
+!
+
+addOnLine: string
+ buffer nextPutAll: string.
+!
+
+call
+ ^ 'self ', self methodName, '.'.
+!
+
+nl
+ ^ buffer nextPut: Character cr
!
profilingBegin
- self profile ifTrue: [
+ self profile ifTrue: [
^ ' context methodInvoked: #', id, '.'
- ].
- ^ ''
+ ].
+ ^ ''
!
profilingEnd
- self profile ifTrue: [
+ self profile ifTrue: [
^ ' context methodFinished: #', id, '.'
- ].
- ^ ''
-!
-
-returnVariable
- ^ variableForReturn
-
- "Created: / 23-04-2015 / 20:50:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-returnVariable: aString
- ^ variableForReturn := aString
-
- "Created: / 23-04-2015 / 18:23:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 23-04-2015 / 21:08:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-variables
- ^ ' | ', (variables inject: '' into: [ :s :e | s, ' ', e]), ' |'
+ ].
+ ^ ''
! !
!PPCMethod methodsFor:'code generation - variables'!
+addVariable: name
+ (variables includes: name) ifTrue:[
+ self error:'Duplicate variable name, must rename'.
+ ].
+ variables add: name.
+
+ "Modified: / 23-04-2015 / 12:29:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
allocateReturnVariable
^ variableForReturn isNil ifTrue:[
@@ -157,17 +126,52 @@
].
"Created: / 23-04-2015 / 17:37:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+returnVariable
+ ^ variableForReturn
+
+ "Created: / 23-04-2015 / 20:50:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+returnVariable: aString
+ ^ variableForReturn := aString
+
+ "Created: / 23-04-2015 / 18:23:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 23-04-2015 / 21:08:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+variables
+ ^ ' | ', (variables inject: '' into: [ :s :e | s, ' ', e]), ' |'
+! !
+
+!PPCMethod methodsFor:'indentation'!
+
+dedent
+ indentation := indentation - 1
+!
+
+indent
+ indentation := indentation + 1
+!
+
+indentationLevel
+ ^ indentation
+!
+
+indentationLevel: value
+ indentation := value
! !
!PPCMethod methodsFor:'initialization'!
initialize
- buffer := WriteStream on: ''.
- indentation := 1.
- variables := OrderedCollection new.
+ buffer := WriteStream on: ''.
+ indentation := 1.
+ variables := OrderedCollection new.
! !
-!PPCMethod methodsFor:'printing & storing'!
+!PPCMethod methodsFor:'printing'!
printOn:aStream
"append a printed representation if the receiver to the argument, aStream"
@@ -179,6 +183,16 @@
"Modified: / 23-04-2015 / 12:32:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!PPCMethod methodsFor:'testing'!
+
+isInline
+ ^ false
+!
+
+isMethod
+ ^ true
+! !
+
!PPCMethod class methodsFor:'documentation'!
version_HG
--- a/compiler/PPCNegateNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCNegateNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,6 +12,6 @@
!PPCNegateNode methodsFor:'accessing'!
prefix
- ^ #negate
+ ^ #negate
! !
--- a/compiler/PPCNilNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCNilNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,26 +12,26 @@
!PPCNilNode methodsFor:'accessing'!
prefix
- ^ #nil
+ ^ #nil
! !
!PPCNilNode methodsFor:'analysis'!
acceptsEpsilon
- ^ true
+ ^ true
!
firstCharSet
- ^ PPCharSetPredicate on: [:e | false ]
+ ^ PPCharSetPredicate on: [:e | false ]
!
isNullable
- ^ true
+ ^ true
! !
!PPCNilNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitNilNode: self
+ ^ visitor visitNilNode: self
! !
--- a/compiler/PPCNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCNode.st Sun May 10 06:28:36 2015 +0100
@@ -3,7 +3,7 @@
"{ NameSpace: Smalltalk }"
Object subclass:#PPCNode
- instanceVariableNames:'contextFree name firstFollowCache firstCharSet properties'
+ instanceVariableNames:'contextFree name properties'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Nodes'
@@ -12,13 +12,39 @@
!PPCNode class methodsFor:'as yet unclassified'!
new
- ^ self basicNew initialize
+ ^ self basicNew initialize
+! !
+
+!PPCNode methodsFor:'PetitParser mimicry'!
+
+allParsersDo: aBlock
+ "I need to mimic PetitParser protocol in order to get transformed from PPParser to PPCNode"
+ ^ self allNodesDo: aBlock
+!
+
+allParsersDo: aBlock seen: aSet
+ "I need to mimic PetitParser protocol in order to get transformed from PPParser to PPCNode"
+ ^ self allNodesDo: aBlock seen: aSet
! !
!PPCNode methodsFor:'accessing'!
children
- ^ #()
+ ^ #()
+!
+
+firstFollowCache
+ ^ self propertyAt: #firstFollowCache ifAbsentPut: [ IdentityDictionary new ]
+!
+
+firstFollowCache: value
+ self propertyAt: #firstFollowCache put: value
+!
+
+markForGuard
+ "Marks receiver for guards, i.e., it's guard code
+ should be part of the generated code"
+ self propertyAt: #guard put: true
!
markForInline
@@ -30,20 +56,35 @@
!
name
- ^ name
+ ^ name
!
name: anObject
-
- name := anObject
+
+ name := anObject
+!
+
+parser
+ ^ self propertyAt: #parser ifAbsent: [ nil ]
+!
+
+parser: value
+ self propertyAt: #parser put: value
!
prefix
- ^ 'anode'
+ ^ 'node'
!
suffix
- ^ ''
+ ^ ''
+!
+
+unmarkForGuard
+ "Forbids compiling of guards, if guards would be available"
+ self propertyAt: #guard put: false
+
+ "Created: / 23-04-2015 / 15:39:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
unmarkForInline
@@ -56,354 +97,397 @@
!PPCNode methodsFor:'accessing-properties'!
hasProperty: aKey
- "Test if the property aKey is present."
-
- ^ properties notNil and: [ properties includesKey: aKey ]
+ "Test if the property aKey is present."
+
+ ^ properties notNil and: [ properties includesKey: aKey ]
!
properties
- ^ properties
+ ^ properties
!
properties: aDictionary
- properties := aDictionary
+ properties := aDictionary
!
propertyAt: aKey
- ^ self propertyAt: [ aKey ] ifAbsent: [ nil ]
+ ^ self propertyAt: aKey ifAbsent: [ nil ]
!
propertyAt: aKey ifAbsent: aBlock
- "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
-
- ^ properties isNil
- ifTrue: [ aBlock value ]
- ifFalse: [ properties at: aKey ifAbsent: aBlock ]
+ "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
+
+ ^ properties isNil
+ ifTrue: [ aBlock value ]
+ ifFalse: [ properties at: aKey ifAbsent: aBlock ]
+!
+
+propertyAt: aKey ifAbsentPut: aBlock
+ "Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value."
+
+ ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]
!
propertyAt: aKey put: anObject
- "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
+ "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
- ^ (properties ifNil: [ properties := Dictionary new: 1 ])
- at: aKey put: anObject
+ ^ (properties ifNil: [ properties := Dictionary new: 1 ])
+ at: aKey put: anObject
! !
!PPCNode methodsFor:'analysis'!
acceptsEpsilon
- "return true, if parser can accept epsilon without failure"
- ^ self subclassResponsibility
+ "return true, if parser can accept epsilon without failure"
+ ^ self subclassResponsibility
!
acceptsEpsilonOpenSet: set
- "private helper for acceptsEmpsilon that makes sure to avoid cycles (using open set)"
- self children isEmpty ifTrue: [ ^ self acceptsEpsilon ].
-
- self shouldBeImplemented .
+ "private helper for acceptsEmpsilon that makes sure to avoid cycles (using open set)"
+ self children isEmpty ifTrue: [ ^ self acceptsEpsilon ].
+
+ self shouldBeImplemented .
!
allNodes
- | result |
- result := OrderedCollection new.
- self allParsersDo: [ :parser | result add: parser ].
- ^ result
+ | result |
+ result := OrderedCollection new.
+ self allParsersDo: [ :parser | result add: parser ].
+ ^ result
!
allNodesDo: aBlock
- "Iterate over all the parse nodes of the receiver."
+ "Iterate over all the parse nodes of the receiver."
- self allNodesDo: aBlock seen: IdentitySet new
+ self allNodesDo: aBlock seen: IdentitySet new
!
allNodesDo: aBlock seen: aSet
- "Iterate over all the parse nodes of the receiver, do not visit and follow the ones contained in aSet."
+ "Iterate over all the parse nodes of the receiver, do not visit and follow the ones contained in aSet."
- (aSet includes: self)
- ifTrue: [ ^ self ].
- aSet add: self.
- aBlock value: self.
- self children
- do: [ :each | each allNodesDo: aBlock seen: aSet ]
+ (aSet includes: self) ifTrue: [ ^ self ].
+
+ aSet add: self.
+ aBlock value: self.
+ self children do: [ :each |
+ each allNodesDo: aBlock seen: aSet
+ ]
!
check
- "nothing to do"
- ^ nil
+ "nothing to do"
+ ^ nil
+!
+
+checkTree
+ | message |
+ self allNodes do: [ :node | (message := node check) ifNotNil: [ self error: message ] ].
!
firstCharSetCached
- firstCharSet ifNil: [
- firstCharSet := self firstCharSet.
- ].
- ^ firstCharSet
-!
-
-firstSetSuchThat: block
- ^ self firstSetSuchThat: block into: (OrderedCollection new) openSet: IdentitySet new.
+ ^ self propertyAt: #firstCharSet ifAbsentPut: [ self firstCharSet ].
!
-firstSetSuchThat: block into: aCollection openSet: aSet
- (aSet includes: self) ifTrue: [ ^ aCollection ].
- aSet add: self.
-
- (block value: self) ifTrue: [aCollection add: self. ^ aCollection ].
- self children do: [ :child |
- child firstSetSuchThat: block into: aCollection openSet: aSet
- ].
- ^ aCollection
+hasFiniteLanguage
+ ^ self recognizedSentences isEmpty not
!
isContextFree
- ^ contextFree ifNil: [ contextFree := self allNodes allSatisfy: [ :n | n isContextFreePrim ] ]
+ ^ contextFree ifNil: [ contextFree := self allNodes allSatisfy: [ :n | n isContextFreePrim ] ]
!
isContextFreePrim
- ^ true
+ ^ true
!
isFirstSetTerminal
- "Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser."
+ "Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser."
- ^ self isTerminal
+ ^ self isTerminal
!
isNullable
- "Answer true if the receiver is a nullable parser, e.g. it can successfully parse nothing."
-
- ^ false
+ "Answer true if the receiver is a nullable parser, e.g. it can successfully parse nothing."
+
+ ^ false
!
isTerminal
- "Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser."
+ "Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser."
+
+ ^ self children isEmpty
+!
- ^ self children isEmpty
+overlapsWith: anotherNode
+ | finite infinite |
+ "infinite - infinite"
+ (self hasFiniteLanguage not and: [ anotherNode hasFiniteLanguage not ]) ifTrue: [
+ ^ false
+ ].
+
+ "finite - finite"
+ (self hasFiniteLanguage and: [ anotherNode hasFiniteLanguage ]) ifTrue: [
+ | union cnt|
+ cnt := self recognizedSentences size + anotherNode recognizedSentences size.
+
+ union := Set new
+ addAll: self recognizedSentences;
+ addAll: anotherNode recognizedSentences;
+ yourself.
+ ^ (union size = cnt) not.
+ ].
+
+ self hasFiniteLanguage ifTrue: [
+ finite := self.
+ infinite := anotherNode.
+ ] ifFalse: [
+ finite := anotherNode.
+ infinite := self.
+ ].
+
+ finite recognizedSentences do: [ :sentence |
+ (infinite parser matches: sentence) ifTrue: [ ^ true ].
+ ].
+ ^ false
+
+!
+
+recognizedSentences
+ ^ self propertyAt: #recognizedSentences ifAbsentPut: [ self recognizedSentencesPrim ].
+!
+
+recognizedSentencesPrim
+ ^ #()
! !
!PPCNode methodsFor:'comparing'!
= anotherNode
- (self == anotherNode) ifTrue: [ ^ true ].
- (anotherNode class = self class) ifFalse: [ ^ false ].
-
- (anotherNode name = name) ifFalse: [ ^ false ].
- ^ anotherNode children = self children.
+ (self == anotherNode) ifTrue: [ ^ true ].
+ (anotherNode class = self class) ifFalse: [ ^ false ].
+
+ (anotherNode name = name) ifFalse: [ ^ false ].
+ ^ anotherNode children = self children.
!
hash
- "TODO JK: IMO not a good hashing function bacause of children size,
- but at least it is not recursive, which would be worse :)
- "
- ^ self class hash bitXor: (name hash bitXor: self children size hash)
+ "TODO JK: IMO not a good hashing function bacause of children size,
+ but at least it is not recursive, which would be worse :)
+ "
+ ^ self class hash bitXor: (name hash bitXor: self children size hash)
+! !
+
+!PPCNode methodsFor:'copying'!
+
+postCopy
+ super postCopy.
+ properties := properties copy
! !
!PPCNode methodsFor:'first follow next'!
firstSet
- ^ firstFollowCache at: #firstSet ifAbsentPut: [
- self firstSets at: self
- ]
+ ^ self firstFollowCache at: #firstSet ifAbsentPut: [
+ self firstSets at: self
+ ]
!
firstSet: set
- firstFollowCache at: #firstSet put: set
+ self firstFollowCache at: #firstSet put: set
+!
+
+firstSetSuchThat: block
+ ^ (self firstSetsSuchThat: block) at: self
+!
+
+firstSetWithProductions
+ ^ self firstFollowCache at: #firstSetWithProductions ifAbsentPut: [
+ self firstSetSuchThat: [:e | e name isNil not ].
+ ]
+!
+
+firstSetWithProductions: aSet
+ ^ self firstFollowCache at: #firstSetWithProductions put: aSet
+!
+
+firstSetWithTokens
+ ^ self firstFollowCache at: #firstSetWithTokens ifAbsentPut: [
+ self firstSetSuchThat: [:e | e isTerminal or: [ e isTokenNode ] ].
+ ]
+!
+
+firstSetWithTokens: aSet
+ ^ self firstFollowCache at: #firstSetWithTokens put: aSet
!
firstSets
- ^ self firstSetsSuchThat: [ :e | e isFirstSetTerminal ]
+ ^ self firstSetsSuchThat: [ :e | e isFirstSetTerminal ]
!
firstSets: aFirstDictionary into: aSet suchThat: aBlock
- "PRIVATE: Try to add additional elements to the first-set aSet of the receiver, use the incomplete aFirstDictionary."
+ "PRIVATE: Try to add additional elements to the first-set aSet of the receiver, use the incomplete aFirstDictionary."
- (aBlock value: self) ifFalse: [
- self children do: [ :node | aSet addAll: (aFirstDictionary at: node) ]
- ]
+ (aBlock value: self) ifFalse: [
+ self children do: [ :node | aSet addAll: (aFirstDictionary at: node) ]
+ ]
!
firstSetsSuchThat: block
- | firstSets |
- firstSets := IdentityDictionary new.
- self allParsersDo: [ :each |
- firstSets at: each put: ((block value: each)
- ifTrue: [ IdentitySet with: each ]
- ifFalse: [ IdentitySet new ]).
- each isNullable
- ifTrue: [ (firstSets at: each) add: PPCSentinelNode instance ] ].
-
-
- [ | changed tally |
- changed := false.
- firstSets keysAndValuesDo: [ :node :first |
- tally := first size.
- node firstSets: firstSets into: first suchThat: block.
- changed := changed or: [ tally ~= first size ] ].
- changed ] whileTrue.
- ^ firstSets
+ | firstSets |
+ firstSets := IdentityDictionary new.
+ self allNodesDo: [ :each |
+ firstSets at: each put: ((block value: each)
+ ifTrue: [ IdentitySet with: each ]
+ ifFalse: [ IdentitySet new ]).
+ each isNullable
+ ifTrue: [ (firstSets at: each) add: PPCSentinelNode instance ] ].
+
+
+ [ | changed tally |
+ changed := false.
+ firstSets keysAndValuesDo: [ :node :first |
+ tally := first size.
+ node firstSets: firstSets into: first suchThat: block.
+ changed := changed or: [ tally ~= first size ] ].
+ changed ] whileTrue.
+ ^ firstSets
!
followSet
- ^ firstFollowCache at: #followSet ifAbsent: [ self error: 'no follow set cached' ]
+ ^ self firstFollowCache at: #followSet ifAbsent: [
+ self error: 'no follow set cached'
+ ]
!
followSet: aSet
- ^ firstFollowCache at: #followSet put: aSet
+ ^ self firstFollowCache at: #followSet put: aSet
!
followSetIn: rootNode
- ^ rootNode followSets at: self
+ ^ rootNode followSets at: self
!
followSetWithTokens
- ^ firstFollowCache at: #followSetWithTokens ifAbsent: [ self error: 'no follow with tokens cached' ]
+ ^ self firstFollowCache at: #followSetWithTokens ifAbsent: [
+ self error: 'no follow with tokens cached'
+ ]
!
followSetWithTokens: aSet
- ^ firstFollowCache at: #followSetWithTokens put: aSet
+ ^ self firstFollowCache at: #followSetWithTokens put: aSet
!
followSets
- ^ self followSetsSuchThat: [ :e | e isFirstSetTerminal ]
+ ^ self followSetsSuchThat: [ :e | e isFirstSetTerminal ]
!
followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet suchThat: aBlock
- "PRIVATE: Try to add additional elements to the follow-set aSet of the receiver, use the incomplete aFollowDictionary and the complete aFirstDictionary."
-
- self children do: [ :node | (aFollowDictionary at: node) addAll: aSet ]
+ "PRIVATE: Try to add additional elements to the follow-set aSet of the receiver, use the incomplete aFollowDictionary and the complete aFirstDictionary."
+
+ self children do: [ :node | (aFollowDictionary at: node) addAll: aSet ]
!
followSetsSuchThat: aBlock
- "Answer a dictionary with all the parsers reachable from the receiver as key and their follow-set as value. The follow-set of a parser is the list of terminal parsers that can appear immediately to the right of that parser."
-
- | current previous continue firstSets followSets |
- current := previous := 0.
- firstSets := self firstSetsSuchThat: aBlock.
- followSets := IdentityDictionary new.
- self allNodesDo: [ :each | followSets at: each put: IdentitySet new ].
- (followSets at: self) add: PPCSentinelNode instance.
- [ followSets keysAndValuesDo: [ :node :follow |
- node
- followSets: followSets
- firstSets: firstSets
- into: follow
- suchThat: aBlock ].
- current := followSets
- inject: 0
- into: [ :result :each | result + each size ].
- continue := previous < current.
- previous := current.
- continue ] whileTrue.
- ^ followSets
+ "Answer a dictionary with all the parsers reachable from the receiver as key and their follow-set as value. The follow-set of a parser is the list of terminal parsers that can appear immediately to the right of that parser."
+
+ | current previous continue firstSets followSets |
+ current := previous := 0.
+ firstSets := self firstSetsSuchThat: aBlock.
+ followSets := IdentityDictionary new.
+ self allNodesDo: [ :each | followSets at: each put: IdentitySet new ].
+ (followSets at: self) add: PPCSentinelNode instance.
+ [ followSets keysAndValuesDo: [ :node :follow |
+ node
+ followSets: followSets
+ firstSets: firstSets
+ into: follow
+ suchThat: aBlock ].
+ current := followSets
+ inject: 0
+ into: [ :result :each | result + each size ].
+ continue := previous < current.
+ previous := current.
+ continue ] whileTrue.
+ ^ followSets
!
nextSetIn: rootNode
- ^ rootNode nextSets at: self
+ ^ rootNode nextSets at: self
!
nextSets
- | nextSets |
-
- nextSets := IdentityDictionary new.
- self allNodesDo: [ :each | nextSets at: each put: IdentitySet new ].
-
- (nextSets at: self) add: PPCSentinelNode instance.
-
- [ | changed |
- changed := false.
-
- nextSets keysAndValuesDo: [:node :next |
- changed := (node
- nextSets: nextSets
- into: next) or: [ changed ].
- ].
- changed ] whileTrue.
-
- ^ nextSets
+ | nextSets |
+
+ nextSets := IdentityDictionary new.
+ self allNodesDo: [ :each | nextSets at: each put: IdentitySet new ].
+
+ (nextSets at: self) add: PPCSentinelNode instance.
+
+ [ | changed |
+ changed := false.
+
+ nextSets keysAndValuesDo: [:node :next |
+ changed := (node
+ nextSets: nextSets
+ into: next) or: [ changed ].
+ ].
+ changed ] whileTrue.
+
+ ^ nextSets
!
nextSets: aNextDictionary into: aSet
- "return true/false, if something has changed or not...."
- | childSet change tally |
-
- change := false.
-
- self children do: [:each |
- childSet := aNextDictionary at: each.
- tally := childSet size.
- childSet addAll: aSet.
- change := change or: [ tally ~= childSet size ].
- ].
+ "return true/false, if something has changed or not...."
+ | childSet change tally |
+
+ change := false.
+
+ self children do: [:each |
+ childSet := aNextDictionary at: each.
+ tally := childSet size.
+ childSet addAll: aSet.
+ change := change or: [ tally ~= childSet size ].
+ ].
- ^ change
-
+ ^ change
+
! !
!PPCNode methodsFor:'gt'!
gtTreeViewIn: composite
- <gtInspectorPresentationOrder: 40>
-
- composite tree
- title: 'Tree';
- children: [:n | n children ];
- format: [:n| String streamContents: [:s | n printOn: s. n printHashOn: s] ];
- shouldExpandToLevel: 6
-! !
-
-!PPCNode methodsFor:'initialization'!
-
-initialize
- super initialize.
- firstFollowCache := IdentityDictionary new.
-! !
-
-!PPCNode methodsFor:'optimizing'!
+ <gtInspectorPresentationOrder: 40>
-checkTree
- | message |
- self allNodes do: [ :node | (message := node check) ifNotNil: [ self error: message ] ].
-!
-
-optimizeTree
- ^ self optimizeTree: #(#token #inline #rewrite #merge)
-!
-
-optimizeTree: params
- | retval |
-
- "Default optimization sequence"
- retval := self.
-
- (params includes: #rewrite) ifTrue: [ retval := PPCOptimizingVisitor new visit: retval ].
- (params includes: #token) ifTrue: [ retval := PPCTokenDetector new visit: retval ].
- (params includes: #rewrite) ifTrue: [ retval := PPCOptimizingVisitor new visit: retval ].
- (params includes: #inline) ifTrue: [ retval := PPCInliningVisitor new visit: retval ].
- (params includes: #merge) ifTrue: [ retval := PPCMergingVisitor new visit: retval ].
- ^ retval
+ composite tree
+ title: 'Tree';
+ children: [:n | n children ];
+ format: [:n| String streamContents: [:s | n printOn: s. n printHashOn: s] ];
+ shouldExpandToLevel: 6
! !
!PPCNode methodsFor:'printing'!
printHashOn: aStream
- aStream print: 'Hash:', self hash asString
+ aStream print: 'Hash:', self hash asString
!
printIdOn: aStream
- aStream print: 'ID:', self identityHash asString
+ aStream print: 'ID:', self identityHash asString
!
printNameOn: aStream
- self name isNil
- ifFalse: [ aStream nextPutAll: self name. aStream nextPut: $-. ].
-
- aStream print: self identityHash
+ self name isNil
+ ifFalse: [ aStream nextPutAll: self name. aStream nextPut: $-. ].
+
+ aStream print: self identityHash
!
printOn: aStream
- super printOn: aStream.
- aStream nextPut: $(.
- self printNameOn: aStream.
- aStream nextPut: $)
+ super printOn: aStream.
+ aStream nextPut: $(.
+ self printNameOn: aStream.
+ aStream nextPut: $)
! !
!PPCNode methodsFor:'testing'!
@@ -412,60 +496,48 @@
^ self propertyAt: #inlined ifAbsent: [ false ].
"Created: / 23-04-2015 / 15:40:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
-!PPCNode methodsFor:'todel'!
-
-allParsersDo: aBlock
- "Iterate over all the parse nodes of the receiver."
-
- self allParsersDo: aBlock seen: IdentitySet new
!
-allParsersDo: aBlock seen: aSet
- "Iterate over all the parse nodes of the receiver, do not visit and follow the ones contained in aSet."
+isTokenNode
+ ^ false
+!
- (aSet includes: self)
- ifTrue: [ ^ self ].
- aSet add: self.
- aBlock value: self.
- self children
- do: [ :each | each allParsersDo: aBlock seen: aSet ]
+isTrimmingTokenNode
+ ^ false
! !
!PPCNode methodsFor:'transformation'!
asCompilerNode
- ^ self
+ ^ self
!
replace: node with: anotherNode
!
transform: aBlock
- "Answer a copy of all parsers reachable from the receiver transformed using aBlock."
- | mapping root |
- self halt: 'doprecate?'.
- mapping := IdentityDictionary new.
- self allParsersDo: [ :each |
- mapping
- at: each
- put: (aBlock value: each copy) ].
- root := mapping at: self.
- [ | changed |
- changed := false.
- root allParsersDo: [ :each |
- each children do: [ :old |
- mapping at: old ifPresent: [ :new |
- each replace: old with: new.
- changed := true ] ] ].
- changed ] whileTrue.
- ^ root
+ "Answer a copy of all parsers reachable from the receiver transformed using aBlock."
+ | mapping root |
+ mapping := IdentityDictionary new.
+ self allNodesDo: [ :each |
+ mapping
+ at: each
+ put: (aBlock value: each copy) ].
+ root := mapping at: self.
+ [ | changed |
+ changed := false.
+ root allNodesDo: [ :each |
+ each children do: [ :old |
+ mapping at: old ifPresent: [ :new |
+ each replace: old with: new.
+ changed := true ] ] ].
+ changed ] whileTrue.
+ ^ root
! !
!PPCNode methodsFor:'visiting'!
accept: visitor
- visitor visitNode: self
+ visitor visitNode: self
! !
--- a/compiler/PPCNodeVisitor.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCNodeVisitor.st Sun May 10 06:28:36 2015 +0100
@@ -12,307 +12,275 @@
!PPCNodeVisitor class methodsFor:'instance creation'!
new
- ^ self basicNew initialize
+ ^ self basicNew initialize
! !
!PPCNodeVisitor methodsFor:'accessing'!
arguments: args
- arguments := args
+ arguments := args
! !
!PPCNodeVisitor methodsFor:'hooks'!
afterAccept: node retval: retval
- "nothing to do"
- ^ retval
+ "nothing to do"
+ ^ retval
!
beforeAccept: node
- "nothing to do"
+ "nothing to do"
!
closedDetected: node
- ^ #closed
+ ^ #closed
!
openDetected: node
- ^ #open
+ ^ #open
! !
!PPCNodeVisitor methodsFor:'initialization'!
initialize
- super initialize.
- openSet := IdentitySet new.
- closeSet := IdentitySet new.
- cache := IdentityDictionary new.
+ super initialize.
+ openSet := IdentitySet new.
+ closeSet := IdentitySet new.
+ cache := IdentityDictionary new.
! !
!PPCNodeVisitor methodsFor:'traversing'!
close: node
- self assert: (self isOpen: node) description: 'should be opened first!!'.
-
- openSet remove: node.
- closeSet add: node
+ self assert: (self isOpen: node) description: 'should be opened first!!'.
+
+ openSet remove: node.
+ closeSet add: node
!
isClosed: child
- ^ closeSet includes: child
+ ^ closeSet includes: child
!
isOpen: child
- ^ openSet includes: child
+ ^ openSet includes: child
!
open: node
- self assert: (self isOpen: node) not description: 'already opened!!'.
- openSet add: node
+ self assert: (self isOpen: node) not description: 'already opened!!'.
+ openSet add: node
!
visit: node
- | retval |
- (self isOpen: node) ifTrue: [
- ^ self openDetected: node
- ].
+ | retval |
+ (self isOpen: node) ifTrue: [
+ ^ self openDetected: node
+ ].
- (self isCached: node) ifTrue: [
- ^ self cachedDetected: node.
- ].
+ (self isCached: node) ifTrue: [
+ ^ self cachedDetected: node.
+ ].
- (self isClosed: node) ifTrue: [
- self closedDetected: node
- ].
+ (self isClosed: node) ifTrue: [
+ self closedDetected: node
+ ].
- self open: node.
- self beforeAccept: node.
- retval := node accept: self.
- retval := self afterAccept: node retval: retval.
- self close: node.
- self cache: node value: retval.
-
- ^ retval
+ self open: node.
+ self beforeAccept: node.
+ retval := node accept: self.
+ retval := self afterAccept: node retval: retval.
+ self close: node.
+ self cache: node value: retval.
+
+ ^ retval
!
visitChildren: node
- node children do: [ :child |
- self visit: child
- ]
+ node children do: [ :child |
+ self visit: child
+ ]
! !
!PPCNodeVisitor methodsFor:'traversing - caching'!
cache: node value: retval
- self assert: (cache includesKey: node) not.
- cache at: node put: retval
+ self assert: (cache includesKey: node) not.
+ cache at: node put: retval
!
cachedDetected: node
- ^ self cachedValue: node
+ ^ self cachedValue: node
!
cachedValue: node
- ^ cache at: node
+ ^ cache at: node
!
isCached: node
- ^ cache includesKey: node
+ ^ cache includesKey: node
! !
!PPCNodeVisitor methodsFor:'visiting'!
visitActionNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitAndNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitAnyNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitCharSetPredicateNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitCharacterNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitChoiceNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
+!
+
+visitDeterministicChoiceNode: node
+ ^ self visitNode: node
!
visitEndOfFileNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
+!
+
+visitEndOfInputNode: node
+ ^ self visitNode: node
!
visitForwardNode: node
- ^ self visitNode: node
-!
-
-visitInlineAnyNode: node
- ^ self visitNode: node
-!
-
-visitInlineCharSetPredicateNode: node
- ^ self visitNode: node
-!
-
-visitInlineCharacterNode: node
- ^ self visitNode: node
-!
-
-visitInlineLiteralNode: node
- ^ self visitNode: node
-!
-
-visitInlineMessagePredicateNode: node
- ^ self visitNode: node
-!
-
-visitInlineNilNode: node
- ^ self visitNode: node
-!
-
-visitInlineNotCharSetPredicateNode: node
- ^ self visitNode: node
-!
-
-visitInlineNotLiteralNode: node
- ^ self visitNode: node
-!
-
-visitInlineNotMessagePredicateNode: node
- ^ self visitNode: node
-!
-
-visitInlinePluggableNode: node
- ^ self visitNode: node
-!
-
-visitInlineTokenStarMessagePredicateNode: node
- ^ self visitNode: node
-!
-
-visitInlineTokenStarSeparatorNode: node
- ^ self visitNode: node
-!
-
-visitLLChoiceNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitLiteralNode: node
- "default implementation"
- ^ self visitNode: node.
+ "default implementation"
+ ^ self visitNode: node.
!
visitMessagePredicateNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitNilNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitNode: node
- self visitChildren: node.
- ^ node
+ self visitChildren: node.
+ ^ node
!
visitNotCharSetPredicateNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitNotLiteralNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitNotMessagePredicateNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitNotNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitOptionalNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitPluggableNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitPlusNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitPredicateNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
+!
+
+visitRecognizingSequenceNode: node
+ ^ self visitNode: node
!
visitSequenceNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitStarAnyNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitStarCharSetPredicateNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitStarMessagePredicateNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitStarNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitSymbolActionNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitTokenActionNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
+!
+
+visitTokenChoiceNode: node
+ ^ self visitNode: node
!
visitTokenConsumeNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitTokenNode: node
- ^ self visitNode: node
-!
-
-visitTokenSequenceNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitTokenStarMessagePredicateNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitTokenStarSeparatorNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
+!
+
+visitTokenWhitespaceNode: node
+ ^ self visitNode: node
+!
+
+visitTokenizingParserNode: node
+ ^ self visitNode: node
!
visitTrimNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitTrimmingTokenNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
!
visitUnknownNode: node
- ^ self visitNode: node
+ ^ self visitNode: node
! !
--- a/compiler/PPCNotCharSetPredicateNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCNotCharSetPredicateNode.st Sun May 10 06:28:36 2015 +0100
@@ -13,14 +13,14 @@
!PPCNotCharSetPredicateNode methodsFor:'analysis'!
firstCharSet
- ^ firstCharSet := PPCharSetPredicate on: [:e | (predicate value:e) not ]
-
+ ^ PPCharSetPredicate on: [:e | (predicate value:e) not ]
+
! !
!PPCNotCharSetPredicateNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitNotCharSetPredicateNode: self
+ ^ visitor visitNotCharSetPredicateNode: self
! !
!PPCNotCharSetPredicateNode class methodsFor:'documentation'!
--- a/compiler/PPCNotLiteralNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCNotLiteralNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,16 +12,16 @@
!PPCNotLiteralNode methodsFor:'accessing'!
firstCharSet
- ^ PPCharSetPredicate on: [:e | true ]
+ ^ PPCharSetPredicate on: [:e | true ]
!
prefix
- ^ #notLit
+ ^ #notLit
! !
!PPCNotLiteralNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitNotLiteralNode: self
+ ^ visitor visitNotLiteralNode: self
! !
--- a/compiler/PPCNotMessagePredicateNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCNotMessagePredicateNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,19 +12,19 @@
!PPCNotMessagePredicateNode methodsFor:'accessing'!
message
-
- ^ message
+
+ ^ message
!
message: anObject
-
- message := anObject
+
+ message := anObject
! !
!PPCNotMessagePredicateNode methodsFor:'analysis'!
firstCharSet
- ^ PPCharSetPredicate on: [:e | (predicate value:e) not ]
+ ^ PPCharSetPredicate on: [:e | (predicate value:e) not ]
"Modified: / 23-04-2015 / 22:11:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
@@ -32,17 +32,17 @@
!PPCNotMessagePredicateNode methodsFor:'comparison'!
= anotherNode
- super = anotherNode ifFalse: [ ^ false ].
- ^ message = anotherNode message.
+ super = anotherNode ifFalse: [ ^ false ].
+ ^ message = anotherNode message.
!
hash
- ^ super hash bitXor: message hash
+ ^ super hash bitXor: message hash
! !
!PPCNotMessagePredicateNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitNotMessagePredicateNode: self
+ ^ visitor visitNotMessagePredicateNode: self
! !
--- a/compiler/PPCNotNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCNotNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,22 +12,22 @@
!PPCNotNode methodsFor:'accessing'!
prefix
- ^ #not
+ ^ #not
! !
!PPCNotNode methodsFor:'analysis'!
firstCharSet
- ^ PPCharSetPredicate on: [:e | true ]
+ ^ PPCharSetPredicate on: [:e | true ]
!
isFirstSetTerminal
- ^ true
+ ^ true
! !
!PPCNotNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitNotNode: self
+ ^ visitor visitNotNode: self
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCOptimizeChoices.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,37 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCRewritingVisitor subclass:#PPCOptimizeChoices
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Visitors'
+!
+
+!PPCOptimizeChoices methodsFor:'as yet unclassified'!
+
+hasCommonPrefix: nodes
+ | firstSets |
+ firstSets := IdentityDictionary new.
+
+ nodes do: [ :node |
+ firstSets at: node put: node firstSetWithProductions.
+ ].
+
+ firstSets values allPairsDo: [ :p1 :p2 | (p1 = p2) ifFalse: [ ^ false ] ].
+ ^ true
+!
+
+visitChoiceNode: node
+ | firstSets commonPrefix |
+ firstSets := IdentityDictionary new.
+
+ node children do: [ :child |
+ firstSets at: child put: child firstProductions.
+ ].
+
+ commonPrefix := true.
+ firstSets values allPairsDo: [ :p1 :p2 | (p1 = p2) ifFalse: [ commonPrefix := false ] ].
+! !
+
--- a/compiler/PPCOptimizingVisitor.st Thu Apr 30 23:43:14 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,189 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCRewritingVisitor subclass:#PPCOptimizingVisitor
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Visitors'
-!
-
-!PPCOptimizingVisitor methodsFor:'visiting'!
-
-visitActionNode: node
-" ^ super visitActionNode: node."
- self visitChildren: node.
-
- ((node hasProperty: #trimmingToken) not and: [ node block isSymbol ]) ifTrue: [
- self change.
- ^ PPCSymbolActionNode new
- block: node block;
- name: node name;
- child: node child;
- yourself
- ].
-
- ^ node
-!
-
-visitForwardNode: node
-
- self visitChildren: node.
-
- node child name ifNil: [
- self change.
- node child name: node name.
- ^ node child
- ].
-
- (node child name = node name) ifTrue: [
- self change.
- ^ node child
- ].
-
- ^ node
-!
-
-visitNotNode: node
- self visitChildren: node.
-
- (node child isKindOf: PPCAbstractLiteralNode) ifTrue: [
- self change.
- ^ PPCNotLiteralNode new
- name: node name;
- literal: node child literal;
- yourself
- ].
-
- (node child isKindOf: PPCMessagePredicateNode) ifTrue: [
- self change.
- ^ PPCNotMessagePredicateNode new
- name: node name;
- message: node child message;
- yourself
- ].
-
- (node child isKindOf: PPCCharSetPredicateNode) ifTrue: [
- self change.
- ^ PPCNotCharSetPredicateNode new
- name: node name;
- predicate: node child predicate;
- yourself
- ].
-
- ^ node
-
- "Modified: / 23-04-2015 / 12:02:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-visitPredicateNode: node
- | charSet |
-
- (node predicate class == PPCharSetPredicate) ifTrue: [
- charSet := node predicate.
- ].
- charSet := PPCharSetPredicate on: node predicate.
-
-
- (charSet equals: (PPCharSetPredicate on: [ :char | char isLetter])) ifTrue: [
- change := true.
- ^ PPCMessagePredicateNode new
- name: node name;
- message: #isLetter;
- predicate: node predicate;
- yourself
- ].
-
-
- (charSet equals: (PPCharSetPredicate on: [ :char | char isDigit])) ifTrue: [
- change := true.
- ^ PPCMessagePredicateNode new
- name: node name;
- message: #isDigit;
- predicate: node predicate;
- yourself
- ].
-
- (charSet equals: (PPCharSetPredicate on: [ :char | char isAlphaNumeric])) ifTrue: [
- change := true.
- ^ PPCMessagePredicateNode new
- name: node name;
- message: #isAlphaNumeric;
- predicate: node predicate;
- yourself
- ].
-
- (charSet equals: (PPCharSetPredicate on: [ :char | char isSeparator])) ifTrue: [
- change := true.
- ^ PPCMessagePredicateNode new
- name: node name;
- message: #isSeparator;
- predicate: node predicate;
- yourself
- ].
-
- (charSet equals: (PPCharSetPredicate on: [ :char | true ])) ifTrue: [
- change := true.
- ^ PPCAnyNode new
- name: node name;
- yourself
- ].
-
-
- change := true.
- ^ PPCCharSetPredicateNode new
- name: node name;
- predicate: charSet;
- yourself.
-!
-
-visitStarNode: node
-
- self visitChildren: node.
-
- (node child isKindOf: PPCMessagePredicateNode) ifTrue: [
- self change.
- ^ PPCStarMessagePredicateNode new
- name: node name;
- child: node child;
- message: node child message;
- yourself
- ].
-
- (node child isKindOf: PPCAnyNode) ifTrue: [
- self change.
- ^ PPCStarAnyNode new
- name: node name;
- child: node child;
- yourself
- ].
-
- (node child isKindOf: PPCCharSetPredicateNode) ifTrue: [
- self change.
- ^ PPCStarCharSetPredicateNode new
- name: node name;
- predicate: node child predicate;
- child: node child;
- yourself
- ].
-
- ^ node
-!
-
-visitTokenStarMessagePredicateNode: node
-
- self visitChildren: node.
-
- (node message = #isSeparator) ifTrue: [
- self change.
- ^ PPCTokenStarSeparatorNode new
- name: node name;
- child: node child;
- message: node message;
- yourself.
- ].
-
- ^ node
-! !
-
--- a/compiler/PPCOptionalNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCOptionalNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,26 +12,26 @@
!PPCOptionalNode methodsFor:'accessing'!
prefix
- ^ #opt
+ ^ #opt
! !
!PPCOptionalNode methodsFor:'analysis'!
acceptsEpsilon
- ^ true
+ ^ true
!
acceptsEpsilonOpenSet: set
- ^ true
+ ^ true
!
isNullable
- ^ true
+ ^ true
! !
!PPCOptionalNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitOptionalNode: self
+ ^ visitor visitOptionalNode: self
! !
--- a/compiler/PPCPluggableConfiguration.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCPluggableConfiguration.st Sun May 10 06:28:36 2015 +0100
@@ -2,8 +2,8 @@
"{ NameSpace: Smalltalk }"
-PPCConfiguration subclass:#PPCPluggableConfiguration
- instanceVariableNames:'block'
+Object subclass:#PPCPluggableConfiguration
+ instanceVariableNames:'block base'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Core'
@@ -12,18 +12,41 @@
!PPCPluggableConfiguration class methodsFor:'as yet unclassified'!
on: aBlock
- ^ self new
- block: aBlock;
- yourself
+ ^ self on: aBlock base: PPCConfiguration default
+!
+
+on: aBlock base: aPPCCOnfiguration
+ ^ self new
+ block: aBlock;
+ base: aPPCCOnfiguration;
+ yourself
! !
!PPCPluggableConfiguration methodsFor:'as yet unclassified'!
+arguments: args
+ ^ base arguments: args
+!
+
+base: aPPCConfiguration
+ base := aPPCConfiguration
+!
+
block: aBlock
- block := aBlock
+ block := aBlock
+!
+
+compile: whatever
+ base input: whatever.
+ block value: base.
+ ^ base ir
+!
+
+input: whatever
+ ^ base input: whatever
!
invokePhases
- ^ block value: self
+ ^ block value: base
! !
--- a/compiler/PPCPluggableNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCPluggableNode.st Sun May 10 06:28:36 2015 +0100
@@ -9,50 +9,58 @@
category:'PetitCompiler-Nodes'
!
+
!PPCPluggableNode methodsFor:'accessing'!
block
-
- ^ block
+
+ ^ block
!
block: anObject
-
- block := anObject
+
+ block := anObject
!
prefix
- ^ #plug
+ ^ #plug
! !
!PPCPluggableNode methodsFor:'analysis'!
acceptsEpsilon
- ^ true
+ ^ true
!
acceptsEpsilonOpenSet: set
- ^ true
+ ^ true
!
firstCharSet
- ^ PPCharSetPredicate on: [:char | (block asParser parse: char asString) isPetitFailure not ]
+ ^ PPCharSetPredicate on: [:char | (block asParser parse: char asString) isPetitFailure not ]
! !
!PPCPluggableNode methodsFor:'comparing'!
= anotherNode
- super = anotherNode ifFalse: [ ^ false ].
- ^ block = anotherNode block.
+ super = anotherNode ifFalse: [ ^ false ].
+ ^ block = anotherNode block.
!
hash
- ^ super hash bitXor: block hash
+ ^ super hash bitXor: block hash
! !
!PPCPluggableNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitPluggableNode: self
+ ^ visitor visitPluggableNode: self
! !
+!PPCPluggableNode class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/compiler/PPCPlusNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCPlusNode.st Sun May 10 06:28:36 2015 +0100
@@ -10,24 +10,30 @@
!
+!PPCPlusNode methodsFor:'analysis'!
+
+recognizedSentencesPrim
+ ^ #()
+! !
+
!PPCPlusNode methodsFor:'as yet unclassified'!
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])
+ | 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
+ ^ #plus
! !
!PPCPlusNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitPlusNode: self
+ ^ visitor visitPlusNode: self
! !
!PPCPlusNode class methodsFor:'documentation'!
--- a/compiler/PPCPredicateNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCPredicateNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,6 +12,6 @@
!PPCPredicateNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitPredicateNode: self
+ ^ visitor visitPredicateNode: self
! !
--- a/compiler/PPCProfilingContext.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCProfilingContext.st Sun May 10 06:28:36 2015 +0100
@@ -13,131 +13,131 @@
!PPCProfilingContext methodsFor:'gt'!
gtReport: composite
- <gtInspectorPresentationOrder: 40>
- composite table
- title: 'Report';
- column: 'Info' evaluated: [ :each | each key printString ];
- column: 'Value' evaluated: [ :each | each value printString ];
- display: [:context | context asReportTable ].
+ <gtInspectorPresentationOrder: 40>
+ composite table
+ title: 'Report';
+ column: 'Info' evaluated: [ :each | each key printString ];
+ column: 'Value' evaluated: [ :each | each value printString ];
+ display: [:context | context asReportTable ].
! !
!PPCProfilingContext methodsFor:'initialization'!
initialize
- super initialize.
- self reset
+ super initialize.
+ self reset
!
reset
- invocations := OrderedCollection new.
- remembers := OrderedCollection new.
- restores := OrderedCollection new.
-
- lwRemembers := OrderedCollection new.
- lwRestores := OrderedCollection new.
-
- totalSize := 0.
+ invocations := OrderedCollection new.
+ remembers := OrderedCollection new.
+ restores := OrderedCollection new.
+
+ lwRemembers := OrderedCollection new.
+ lwRestores := OrderedCollection new.
+
+ totalSize := 0.
! !
!PPCProfilingContext methodsFor:'profiling'!
invocations
- ^ invocations
+ ^ invocations
!
lwRemember
- | selector |
- selector := thisContext sender selector.
- lwRemembers add: selector.
+ | selector |
+ selector := thisContext sender selector.
+ lwRemembers add: selector.
- ^ super lwRemember
+ ^ super lwRemember
!
lwRestore: whatever
- | selector |
- selector := thisContext sender selector.
- lwRestores add: selector.
+ | selector |
+ selector := thisContext sender selector.
+ lwRestores add: selector.
- ^ super lwRestore: whatever.
+ ^ super lwRestore: whatever.
!
methodFinished: selector
- "Nothing to do for now"
+ "Nothing to do for now"
!
methodInvoked: selector
- invocations add: selector
+ invocations add: selector
!
remember
- | sender selector |
+ | sender selector |
- sender := thisContext sender.
- selector := (sender receiver isKindOf: PPCompiledParser) ifTrue: [
+ sender := thisContext sender.
+ selector := (sender receiver isKindOf: PPCompiledParser) ifTrue: [
sender selector.
- ] ifFalse: [
+ ] ifFalse: [
sender receiver class.
- ].
- remembers add: selector.
- ^ super remember
+ ].
+ remembers add: selector.
+ ^ super remember
!
restore: whatever
- | selector sender |
-
- sender := thisContext sender.
- selector := (sender receiver isKindOf: PPCompiledParser) ifTrue: [
+ | selector sender |
+
+ sender := thisContext sender.
+ selector := (sender receiver isKindOf: PPCompiledParser) ifTrue: [
sender selector.
- ] ifFalse: [
+ ] ifFalse: [
sender receiver class.
- ].
-
-
- restores add: selector.
-
- ^ super restore: whatever
+ ].
+
+
+ restores add: selector.
+
+ ^ super restore: whatever
!
stream: aStream
- totalSize := totalSize + aStream size.
- ^ super stream: aStream
+ totalSize := totalSize + aStream size.
+ ^ super stream: aStream
! !
!PPCProfilingContext methodsFor:'reporting'!
asReportTable
- ^{
- #'invocations per character (NOT PRECISE YET)' -> (self invocationCount / (totalSize + 1.0)).
- #'lwBacktrack per character' -> (self lwRestoreCount / (totalSize + 1.0)).
- #'backtrack per character' -> (self restoreCount / (totalSize + 1.0)).
- #'total stream size' -> totalSize .
- #'invocation count' -> self invocationCount.
- #'lwRemember count' -> self lwRememberCount.
- #'lwRestore count' -> self lwRestoreCount.
- #'remember count' -> self rememberCount.
- #'restore count' -> self restoreCount.
-
- }
+ ^{
+ #'invocations per character (NOT PRECISE YET)' -> (self invocationCount / (totalSize + 1.0)).
+ #'lwBacktrack per character' -> (self lwRestoreCount / (totalSize + 1.0)).
+ #'backtrack per character' -> (self restoreCount / (totalSize + 1.0)).
+ #'total stream size' -> totalSize .
+ #'invocation count' -> self invocationCount.
+ #'lwRemember count' -> self lwRememberCount.
+ #'lwRestore count' -> self lwRestoreCount.
+ #'remember count' -> self rememberCount.
+ #'restore count' -> self restoreCount.
+
+ }
!
invocationCount
- ^ invocations size
+ ^ invocations size
!
lwRememberCount
- ^ lwRemembers size
+ ^ lwRemembers size
!
lwRestoreCount
- ^ lwRestores size
+ ^ lwRestores size
!
rememberCount
- ^ remembers size
+ ^ remembers size
!
restoreCount
- ^ restores size
+ ^ restores size
! !
!PPCProfilingContext class methodsFor:'documentation'!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCRecognizerComponentDetector.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,64 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCRewritingVisitor subclass:#PPCRecognizerComponentDetector
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Visitors'
+!
+
+!PPCRecognizerComponentDetector methodsFor:'visiting'!
+
+visitNotNode: node
+ "We don't need result of the not,..."
+ | child newChild |
+ self change.
+ child := node child.
+ newChild := self visitWithRecognizingComponentVisitor: child.
+ node replace: child with: newChild.
+ ^ node
+!
+
+visitTokenNode: node
+ | child newChild |
+
+ self change.
+ child := node child.
+ newChild := self visitWithRecognizingComponentVisitor: child.
+ node replace: child with: newChild.
+
+ ^ node
+!
+
+visitTrimmingTokenNode: node
+ | child newChild whitespace newWhitespace |
+
+ self change.
+ child := node child.
+ newChild := self visitWithRecognizingComponentVisitor: child.
+ node replace: child with: newChild.
+
+ whitespace := node whitespace.
+ newWhitespace := self visitWithRecognizingComponentVisitor: whitespace.
+ node replace: whitespace with: newWhitespace.
+
+
+ ^ node
+!
+
+visitWithRecognizingComponentVisitor: node
+ | retval forbiddenNodes copyVisitor tokenVisitor |
+
+ copyVisitor := PPCCopyVisitor new.
+ tokenVisitor := PPCRecognizerComponentVisitor new.
+
+ forbiddenNodes := openSet copy.
+ tokenVisitor forbiddenNodes: forbiddenNodes.
+
+ retval := copyVisitor visit: node.
+ retval := tokenVisitor visit: retval.
+ ^ retval
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCRecognizerComponentVisitor.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,83 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCRewritingVisitor subclass:#PPCRecognizerComponentVisitor
+ instanceVariableNames:'forbiddenNodes'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Visitors'
+!
+
+!PPCRecognizerComponentVisitor methodsFor:'accessing'!
+
+forbiddenNodes: nodeSet
+ forbiddenNodes := nodeSet.
+! !
+
+!PPCRecognizerComponentVisitor methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ forbiddenNodes := IdentitySet new.
+! !
+
+!PPCRecognizerComponentVisitor methodsFor:'traversing'!
+
+beforeAccept: node
+ self assert: (forbiddenNodes includes: node) not description: 'Does not look like a token'
+! !
+
+!PPCRecognizerComponentVisitor methodsFor:'visiting'!
+
+visitActionNode: node
+ self visitChildren: node.
+
+ self change.
+ ^ node child
+!
+
+visitSequenceNode: node
+ self visitChildren: node.
+
+ self change.
+ ^ PPCRecognizingSequenceNode new
+ children: node children;
+ name: node name;
+ properties: node properties;
+ yourself
+!
+
+visitStarMessagePredicateNode: node
+ self visitChildren: node.
+
+ (node message = #isSeparator) ifTrue: [
+ self change.
+ ^ PPCTokenStarSeparatorNode new
+ name: node name;
+ child: node child;
+ message: node message;
+ yourself.
+ ].
+
+ self change.
+ ^ PPCTokenStarMessagePredicateNode new
+ name: node name;
+ message: node message;
+ child: node child;
+ yourself
+!
+
+visitSymbolActionNode: node
+ self visitChildren: node.
+
+ self change.
+ ^ node child
+!
+
+visitTokenNode: node
+ self visitChildren: node.
+ self change.
+ ^ node child
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCRecognizingSequenceNode.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,23 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCSequenceNode subclass:#PPCRecognizingSequenceNode
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Nodes'
+!
+
+!PPCRecognizingSequenceNode methodsFor:'accessing'!
+
+suffix
+ ^ #'_fast'
+! !
+
+!PPCRecognizingSequenceNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitRecognizingSequenceNode: self
+! !
+
--- a/compiler/PPCRewritingVisitor.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCRewritingVisitor.st Sun May 10 06:28:36 2015 +0100
@@ -12,35 +12,35 @@
!PPCRewritingVisitor methodsFor:'as yet unclassified'!
change
- self flag: 'JK: Do we need this?'.
- change := true.
+ self flag: 'JK: Do we need this?'.
+ change := true.
!
visitChild: child of: node
- | newChild |
+ | newChild |
- (self isOpen: child) ifTrue: [
- "already processing..."
- ^ nil
- ].
+ (self isOpen: child) ifTrue: [
+ "already processing..."
+ ^ nil
+ ].
- (self isCached: child) ifTrue: [
- "Use Cached Value"
- node replace: child with: (self cachedValue: child).
- ^ nil
- ].
+ (self isCached: child) ifTrue: [
+ "Use Cached Value"
+ node replace: child with: (self cachedValue: child).
+ ^ nil
+ ].
- change := false.
- newChild := self visit: child.
- change ifTrue: [
- node replace: child with: newChild.
- ].
+ change := false.
+ newChild := self visit: child.
+ change ifTrue: [
+ node replace: child with: newChild.
+ ].
!
visitChildren: node
- node children do: [ :child |
- self visitChild: child of: node
- ]
+ node children do: [ :child |
+ self visitChild: child of: node
+ ]
! !
--- a/compiler/PPCSentinelNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCSentinelNode.st Sun May 10 06:28:36 2015 +0100
@@ -19,6 +19,6 @@
!PPCSentinelNode class methodsFor:'as yet unclassified'!
instance
- ^ Instance ifNil: [ Instance := self basicNew ]
+ ^ Instance ifNil: [ Instance := self basicNew ]
! !
--- a/compiler/PPCSequenceNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCSequenceNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,98 +12,118 @@
!PPCSequenceNode methodsFor:'accessing'!
prefix
- ^ #seq
+ ^ #seq
! !
!PPCSequenceNode methodsFor:'analysis'!
acceptsEpsilon
- ^ self acceptsEpsilonOpenSet: IdentitySet new.
+ ^ self acceptsEpsilonOpenSet: IdentitySet new.
!
acceptsEpsilonOpenSet: set
- set add: self.
- ^ self children allSatisfy: [:e | e acceptsEpsilonOpenSet: set ]
+ set add: self.
+ ^ self children allSatisfy: [:e | e acceptsEpsilonOpenSet: set ]
!
firstSetSuchThat: block into: aCollection openSet: aSet
- (aSet includes: self) ifTrue: [ ^ aCollection ].
- aSet add: self.
-
- (block value: self) ifTrue: [ aCollection add: self. ^ aCollection ].
-
- self children do: [ :child |
- child firstSetSuchThat: block into: aCollection openSet: aSet.
- child acceptsEpsilon ifFalse: [ ^ aCollection ]
- ].
- ^ aCollection
+ (aSet includes: self) ifTrue: [ ^ aCollection ].
+ aSet add: self.
+
+ (block value: self) ifTrue: [ aCollection add: self. ^ aCollection ].
+
+ self children do: [ :child |
+ child firstSetSuchThat: block into: aCollection openSet: aSet.
+ child acceptsEpsilon ifFalse: [ ^ aCollection ]
+ ].
+ ^ aCollection
!
firstSets: aFirstDictionary into: aSet suchThat: aBlock
- | nullable |
-
- "TODO JK: aBlock is ignored by now"
- children do: [ :node |
- nullable := false.
- (aFirstDictionary at: node) do: [ :each |
- each isNullable
- ifTrue: [ nullable := true ]
- ifFalse: [ aSet add: each ] ].
- nullable
- ifFalse: [ ^ self ] ].
- aSet add: PPCSentinelNode instance
+ | nullable |
+
+ "TODO JK: aBlock is ignored by now"
+ children do: [ :node |
+ nullable := false.
+ (aFirstDictionary at: node) do: [ :each |
+ each isNullable
+ ifTrue: [ nullable := true ]
+ ifFalse: [ aSet add: each ] ].
+ nullable
+ ifFalse: [ ^ self ] ].
+ aSet add: PPCSentinelNode instance
+!
+
+recognizedSentencesPrim
+ | retval |
+ (self children anySatisfy: [ :child | child hasFiniteLanguage not ]) ifTrue: [ ^ #() ].
+
+ retval := Set with: ''.
+
+ self children do: [ : child |
+ | set |
+ set := Set new.
+
+ child recognizedSentences do: [ :suffix |
+ retval do: [ :prefix |
+ set add: prefix, suffix.
+ ]
+ ].
+ retval := set.
+ ].
+ ^ retval asArray
! !
!PPCSequenceNode methodsFor:'compiling'!
addGuard: compiler id: id
- | guard firsts |
- (compiler guards not or: [(guard := PPCGuard on: self) makesSense not]) ifTrue: [ ^ self].
+ | guard firsts |
+ (compiler guards not or: [(guard := PPCGuard on: self) makesSense not]) ifTrue: [ ^ self].
- firsts := (self firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]).
+ firsts := (self firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]).
-
- (firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [
- "If we start with trimming, we should invoke the whitespace parser"
- firsts anyOne compileWhitespace: compiler.
-
- compiler add: 'context atEnd ifTrue: [ ^ self error ].'.
- guard id: id, '_guard'.
- guard compileGuard: compiler.
- compiler addOnLine: 'ifFalse: [ ^ self error ].'
- ].
+
+ (firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [
+ "If we start with trimming, we should invoke the whitespace parser"
+ firsts anyOne compileWhitespace: compiler.
+
+ compiler add: 'context atEnd ifTrue: [ ^ self error ].'.
+ guard id: id, '_guard'.
+ guard compileGuard: compiler.
+ compiler addOnLine: 'ifFalse: [ ^ self error ].'
+ ].
- (firsts allSatisfy: [ :e | e isTerminal ]) ifTrue: [
- compiler add: 'context atEnd ifTrue: [ ^ self error ].'.
- guard id: id, '_guard'.
- guard compileGuard: compiler.
- compiler addOnLine: 'ifFalse: [ ^ self error ].'
- ].
+ (firsts allSatisfy: [ :e | e isTerminal ]) ifTrue: [
+ compiler add: 'context atEnd ifTrue: [ ^ self error ].'.
+ guard id: id, '_guard'.
+ guard compileGuard: compiler.
+ compiler addOnLine: 'ifFalse: [ ^ self error ].'
+ ].
! !
!PPCSequenceNode methodsFor:'first follow next'!
followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet suchThat: aBlock
- children keysAndValuesDo: [ :index :node |
- | follow first |
- follow := aFollowDictionary at: node.
- index = children size
- ifTrue: [ follow addAll: aSet ]
- ifFalse: [
- (self class withAll: (children
- copyFrom: index + 1 to: children size))
- firstSets: aFirstDictionary
- into: (first := IdentitySet new)
- suchThat: aBlock.
- (first anySatisfy: [ :each | each isNullable ])
- ifTrue: [ follow addAll: aSet ].
- follow addAll: (first
- reject: [ :each | each isNullable ]) ] ]
+ children keysAndValuesDo: [ :index :node |
+ | follow first |
+ follow := aFollowDictionary at: node.
+ index = children size
+ ifTrue: [ follow addAll: aSet ]
+ ifFalse: [
+ (self class withAll: (children
+ copyFrom: index + 1 to: children size))
+ firstSets: aFirstDictionary
+ into: (first := IdentitySet new)
+ suchThat: aBlock.
+ (first anySatisfy: [ :each | each isNullable ])
+ ifTrue: [ follow addAll: aSet ].
+ follow addAll: (first
+ reject: [ :each | each isNullable ]) ] ]
! !
!PPCSequenceNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitSequenceNode: self
+ ^ visitor visitSequenceNode: self
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCSpecializingVisitor.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,175 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCRewritingVisitor subclass:#PPCSpecializingVisitor
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Visitors'
+!
+
+!PPCSpecializingVisitor methodsFor:'visiting'!
+
+visitActionNode: node
+ ("(node hasProperty: #trimmingToken) not and: [" node block isSymbol "]") ifTrue: [
+ self change.
+ ^ PPCSymbolActionNode new
+ block: node block;
+ name: node name;
+ child: node child;
+ yourself
+ ].
+
+ ^ super visitActionNode: node
+!
+
+visitForwardNode: node
+
+ self visitChildren: node.
+
+ node name ifNil: [
+ self change.
+ ^ node child.
+ ].
+
+ node child name ifNil: [
+ self change.
+ node child name: node name.
+ ^ node child
+ ].
+
+ (node child name = node name) ifTrue: [
+ self change.
+ ^ node child
+ ].
+
+ ^ node
+!
+
+visitNotNode: node
+ self visitChildren: node.
+
+ (node child isKindOf: PPCAbstractLiteralNode) ifTrue: [
+ self change.
+ ^ PPCNotLiteralNode new
+ name: node name;
+ literal: node child literal;
+ yourself
+ ].
+
+ (node child isKindOf: PPCMessagePredicateNode) ifTrue: [
+ self change.
+ ^ PPCNotMessagePredicateNode new
+ name: node name;
+ message: node child message;
+ yourself
+ ].
+
+ (node child isKindOf: PPCCharSetPredicateNode) ifTrue: [
+ self change.
+ ^ PPCNotCharSetPredicateNode new
+ name: node name;
+ predicate: node child predicate;
+ yourself
+ ].
+
+ ^ node
+
+ "Modified: / 23-04-2015 / 12:02:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+visitPredicateNode: node
+ | charSet |
+
+ (node predicate class == PPCharSetPredicate) ifTrue: [
+ charSet := node predicate.
+ ].
+ charSet := PPCharSetPredicate on: node predicate.
+
+
+ (charSet equals: (PPCharSetPredicate on: [ :char | char isLetter])) ifTrue: [
+ change := true.
+ ^ PPCMessagePredicateNode new
+ name: node name;
+ message: #isLetter;
+ predicate: node predicate;
+ yourself
+ ].
+
+
+ (charSet equals: (PPCharSetPredicate on: [ :char | char isDigit])) ifTrue: [
+ change := true.
+ ^ PPCMessagePredicateNode new
+ name: node name;
+ message: #isDigit;
+ predicate: node predicate;
+ yourself
+ ].
+
+ (charSet equals: (PPCharSetPredicate on: [ :char | char isAlphaNumeric])) ifTrue: [
+ change := true.
+ ^ PPCMessagePredicateNode new
+ name: node name;
+ message: #isAlphaNumeric;
+ predicate: node predicate;
+ yourself
+ ].
+
+ (charSet equals: (PPCharSetPredicate on: [ :char | char isSeparator])) ifTrue: [
+ change := true.
+ ^ PPCMessagePredicateNode new
+ name: node name;
+ message: #isSeparator;
+ predicate: node predicate;
+ yourself
+ ].
+
+ (charSet equals: (PPCharSetPredicate on: [ :char | true ])) ifTrue: [
+ change := true.
+ ^ PPCAnyNode new
+ name: node name;
+ yourself
+ ].
+
+
+ change := true.
+ ^ PPCCharSetPredicateNode new
+ name: node name;
+ predicate: charSet;
+ yourself.
+!
+
+visitStarNode: node
+
+ self visitChildren: node.
+
+ (node child isKindOf: PPCMessagePredicateNode) ifTrue: [
+ self change.
+ ^ PPCStarMessagePredicateNode new
+ name: node name;
+ child: node child;
+ message: node child message;
+ yourself
+ ].
+
+ (node child isKindOf: PPCAnyNode) ifTrue: [
+ self change.
+ ^ PPCStarAnyNode new
+ name: node name;
+ child: node child;
+ yourself
+ ].
+
+ (node child isKindOf: PPCCharSetPredicateNode) ifTrue: [
+ self change.
+ ^ PPCStarCharSetPredicateNode new
+ name: node name;
+ predicate: node child predicate;
+ child: node child;
+ yourself
+ ].
+
+ ^ node
+! !
+
--- a/compiler/PPCStarAnyNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCStarAnyNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,12 +12,30 @@
!PPCStarAnyNode methodsFor:'as yet unclassified'!
prefix
- ^ #starAny
+ ^ #starAny
+! !
+
+!PPCStarAnyNode methodsFor:'first follow next'!
+
+firstSets: aFirstDictionary into: aSet suchThat: aBlock
+ "
+ First and follow should be performed on the non-specialized tree, i.e. on a tree
+ with star -> messageNode. Not on myself.
+
+ The reason for that is, that:
+ - I am terminal
+ - I am nullable
+
+ This means, I look like epsilon node for the first follow analysis. And epsilons
+ are ignored in sequences, thus sequence of StarMessagePredicate, Literal
+ leads to { Literal } as firstSet and not expected { MessagePredicate, Literal }
+ "
+ ^ self error: 'Cannot perform first/follow analysis on myself, sorry for that :('
! !
!PPCStarAnyNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitStarAnyNode: self
+ ^ visitor visitStarAnyNode: self
! !
--- a/compiler/PPCStarCharSetPredicateNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCStarCharSetPredicateNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,41 +12,59 @@
!PPCStarCharSetPredicateNode methodsFor:'accessing'!
extendClassification: classification
- ^ (classification asOrderedCollection addLast: false; yourself) asArray
+ ^ (classification asOrderedCollection addLast: false; yourself) asArray
!
firstCharSet
- ^ PPCharSetPredicate on: predicate
+ ^ PPCharSetPredicate on: predicate
!
predicate
-
- ^ predicate
+
+ ^ predicate
!
predicate: anObject
-
- predicate := anObject
+
+ predicate := anObject
!
prefix
- ^ #starPredicate
+ ^ #starPredicate
! !
!PPCStarCharSetPredicateNode methodsFor:'comparing'!
= anotherNode
- super = anotherNode ifFalse: [ ^ false ].
- ^ predicate = anotherNode predicate.
+ super = anotherNode ifFalse: [ ^ false ].
+ ^ predicate = anotherNode predicate.
!
hash
- ^ super hash bitXor: predicate hash
+ ^ super hash bitXor: predicate hash
+! !
+
+!PPCStarCharSetPredicateNode methodsFor:'first follow next'!
+
+firstSets: aFirstDictionary into: aSet suchThat: aBlock
+ "
+ First and follow should be performed on the non-specialized tree, i.e. on a tree
+ with star -> messageNode. Not on myself.
+
+ The reason for that is, that:
+ - I am terminal
+ - I am nullable
+
+ This means, I look like epsilon node for the first follow analysis. And epsilons
+ are ignored in sequences, thus sequence of StarMessagePredicate, Literal
+ leads to { Literal } as firstSet and not expected { MessagePredicate, Literal }
+ "
+ ^ self error: 'Cannot perform first/follow analysis on myself, sorry for that :('
! !
!PPCStarCharSetPredicateNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitStarCharSetPredicateNode: self
+ ^ visitor visitStarCharSetPredicateNode: self
! !
--- a/compiler/PPCStarMessagePredicateNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCStarMessagePredicateNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,41 +12,59 @@
!PPCStarMessagePredicateNode methodsFor:'accessing'!
children
- ^ #()
+ ^ #()
!
firstCharSet
- ^ PPCharSetPredicate on: [:char | char perform: message ]
+ ^ PPCharSetPredicate on: [:char | char perform: message ]
!
message
-
- ^ message
+
+ ^ message
!
message: anObject
-
- message := anObject
+
+ message := anObject
!
prefix
- ^ #starPredicate
+ ^ #starPredicate
+! !
+
+!PPCStarMessagePredicateNode methodsFor:'analysis'!
+
+firstSets: aFirstDictionary into: aSet suchThat: aBlock
+ "
+ First and follow should be performed on the non-specialized tree, i.e. on a tree
+ with star -> messageNode. Not on myself.
+
+ The reason for that is, that:
+ - I am terminal
+ - I am nullable
+
+ This means, I look like epsilon node for the first follow analysis. And epsilons
+ are ignored in sequences, thus sequence of StarMessagePredicate, Literal
+ leads to { Literal } as firstSet and not expected { MessagePredicate, Literal }
+ "
+ ^ self error: 'Cannot perform first/follow analysis on myself, sorry for that :('
! !
!PPCStarMessagePredicateNode methodsFor:'comparing'!
= anotherNode
- super = anotherNode ifFalse: [ ^ false ].
- ^ message = anotherNode message.
+ super = anotherNode ifFalse: [ ^ false ].
+ ^ message = anotherNode message.
!
hash
- ^ super hash bitXor: message hash
+ ^ super hash bitXor: message hash
! !
!PPCStarMessagePredicateNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitStarMessagePredicateNode: self
+ ^ visitor visitStarMessagePredicateNode: self
! !
--- a/compiler/PPCStarNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCStarNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,39 +12,43 @@
!PPCStarNode methodsFor:'accessing'!
acceptsEpsilon
- ^ true
+ ^ true
!
acceptsEpsilonOpenSet: set
- ^ true
+ ^ true
!
prefix
- ^ #star
+ ^ #star
! !
-!PPCStarNode methodsFor:'analyzing'!
+!PPCStarNode methodsFor:'analysis'!
isNullable
- ^ true
+ ^ true
+!
+
+recognizedSentencesPrim
+ ^ #()
! !
!PPCStarNode methodsFor:'first follow next'!
followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet suchThat: aBlock
- | first |
- super followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet suchThat: aBlock.
-
- first := aFirstDictionary at: self.
+ | first |
+ super followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet suchThat: aBlock.
+
+ first := aFirstDictionary at: self.
- self children do: [ :el |
- (aFollowDictionary at: el) addAll: (first reject: [:each | each isNullable])
- ]
+ self children do: [ :el |
+ (aFollowDictionary at: el) addAll: (first reject: [:each | each isNullable])
+ ]
! !
!PPCStarNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitStarNode: self
+ ^ visitor visitStarNode: self
! !
--- a/compiler/PPCSymbolActionNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCSymbolActionNode.st Sun May 10 06:28:36 2015 +0100
@@ -13,17 +13,17 @@
!PPCSymbolActionNode methodsFor:'accessing'!
symbol
- ^ self block
+ ^ self block
!
symbol: aSymbol
- self block: aSymbol
+ self block: aSymbol
! !
!PPCSymbolActionNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitSymbolActionNode: self
+ ^ visitor visitSymbolActionNode: self
! !
!PPCSymbolActionNode class methodsFor:'documentation'!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCTokenChoiceNode.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,17 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCChoiceNode subclass:#PPCTokenChoiceNode
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Nodes'
+!
+
+!PPCTokenChoiceNode methodsFor:'as yet unclassified'!
+
+accept: visitor
+ visitor visitTokenChoiceNode: self.
+! !
+
--- a/compiler/PPCTokenConsumeNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCTokenConsumeNode.st Sun May 10 06:28:36 2015 +0100
@@ -9,13 +9,23 @@
category:'PetitCompiler-Nodes'
!
-!PPCTokenConsumeNode methodsFor:'as yet unclassified'!
+!PPCTokenConsumeNode methodsFor:'accessing'!
-accept: visitor
- ^ visitor visitTokenConsumeNode: self
+name: value
+ super name: value.
+
+ self child name isNil ifTrue: [
+ self child name: self child prefix, '_', value.
+ ]
!
prefix
- ^ #consume
+ ^ #consume
! !
+!PPCTokenConsumeNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitTokenConsumeNode: self
+! !
+
--- a/compiler/PPCTokenDetector.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCTokenDetector.st Sun May 10 06:28:36 2015 +0100
@@ -9,59 +9,76 @@
category:'PetitCompiler-Visitors'
!
-!PPCTokenDetector methodsFor:'visiting'!
+!PPCTokenDetector methodsFor:'as yet unclassified'!
-visitActionNode: node
- (node hasProperty: #trimmingToken) ifTrue: [
- | newWs newChild |
- self change.
-
- newChild := self visitWithTokenVisitor: node child children second child. "Oups, what a chain"
- newWs := self visitWithTokenVisitor: node child children first.
+visitActionNode: node
- ^ PPCTrimmingTokenNode new
- name: node name;
- child: newChild;
- tokenClass: node child children second tokenClass;
- whitespace: newWs;
- yourself.
- ].
+ (node hasProperty: #trimmingToken) ifTrue: [
+ | child whitespace |
+ self change.
+ child := self visitWithTokenVisitor: node child secondChild.
+ whitespace := self visitWithTokenVisitor: node child firstChild.
+
+ ^ PPCTrimmingTokenNode new
+ name: node name;
+ child: child;
+ whitespace: whitespace;
+ tokenClass: node child secondChild tokenClass;
+ properties: node properties copy;
+ yourself.
+ ].
- ^ super visitActionNode: node
+ ^ super visitActionNode: node
!
-visitNotNode: node
- "We don't need result of the not,..."
- | child newChild |
- self change.
- child := node child.
- newChild := self visitWithTokenVisitor: child.
- node replace: child with: newChild.
- ^ node
+visitTokenNode: node
+ | child newChild |
+ self change.
+ child := node child.
+ newChild := self visitWithTokenVisitor: node child.
+ node replace: child with: newChild.
+
+ ^ node
!
-visitTokenNode: node
- | child newChild |
-
- self change.
- child := node child.
- newChild := self visitWithTokenVisitor: child.
- node replace: child with: newChild.
-
- ^ node
+visitTrimNode: node
+ self visitChildren: node.
+
+ (node child isKindOf: PPCTokenNode) ifTrue: [
+ self change.
+ ^ PPCTrimmingTokenNode new
+ name: node name;
+ child: node child child;
+ tokenClass: node child tokenClass;
+ whitespace: node trimmer;
+ yourself
+ ].
+
+ (node child isKindOf: PPCTokenConsumeNode) ifTrue: [
+ self change.
+ ^ PPCTrimmingTokenNode new
+ name: node name;
+ child: node child;
+ tokenClass: node child child tokenClass;
+ whitespace: node trimmer;
+ yourself
+ ].
+
+
+ ^ node
!
visitWithTokenVisitor: node
- | retval forbiddenNodes copyVisitor tokenVisitor |
-
- copyVisitor := PPCCopyVisitor new.
- tokenVisitor := PPCTokenVisitor new.
-
- forbiddenNodes := openSet copy.
- tokenVisitor forbiddenNodes: forbiddenNodes.
+ | retval forbiddenNodes copyVisitor tokenVisitor |
+
+ copyVisitor := PPCCopyVisitor new.
+ tokenVisitor := PPCTokenVisitor new.
+
+ forbiddenNodes := openSet copy.
+ tokenVisitor forbiddenNodes: forbiddenNodes.
- retval := copyVisitor visit: node.
- retval := tokenVisitor visit: retval.
- ^ retval
+ retval := copyVisitor visit: node.
+ retval := tokenVisitor visit: retval.
+ ^ retval
! !
--- a/compiler/PPCTokenNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCTokenNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,37 +12,43 @@
!PPCTokenNode methodsFor:'accessing'!
prefix
- ^ #token
+ ^ #token
!
tokenClass
-
- ^ tokenClass
+
+ ^ tokenClass
!
tokenClass: anObject
-
- tokenClass := anObject
+
+ tokenClass := anObject
!
tokenType
- ^ self identityHash printString
+ ^ self identityHash printString
! !
!PPCTokenNode methodsFor:'comparing'!
= anotherNode
- super = anotherNode ifFalse: [ ^ false ].
- ^ tokenClass = anotherNode tokenClass.
+ super = anotherNode ifFalse: [ ^ false ].
+ ^ tokenClass = anotherNode tokenClass.
!
hash
- ^ super hash bitXor: tokenClass hash
+ ^ super hash bitXor: tokenClass hash
+! !
+
+!PPCTokenNode methodsFor:'testing'!
+
+isTokenNode
+ ^ true
! !
!PPCTokenNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitTokenNode: self
+ ^ visitor visitTokenNode: self
! !
--- a/compiler/PPCTokenSequenceNode.st Thu Apr 30 23:43:14 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,31 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCSequenceNode subclass:#PPCTokenSequenceNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-
-!PPCTokenSequenceNode methodsFor:'accessing'!
-
-suffix
- ^ #'_fast'
-! !
-
-!PPCTokenSequenceNode methodsFor:'visiting'!
-
-accept: visitor
- ^ visitor visitTokenSequenceNode: self
-! !
-
-!PPCTokenSequenceNode class methodsFor:'documentation'!
-
-version_HG
-
- ^ '$Changeset: <not expanded> $'
-! !
-
--- a/compiler/PPCTokenStarMessagePredicateNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCTokenStarMessagePredicateNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,6 +12,6 @@
!PPCTokenStarMessagePredicateNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitTokenStarMessagePredicateNode: self
+ ^ visitor visitTokenStarMessagePredicateNode: self
! !
--- a/compiler/PPCTokenStarSeparatorNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCTokenStarSeparatorNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,6 +12,6 @@
!PPCTokenStarSeparatorNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitTokenStarSeparatorNode: self
+ ^ visitor visitTokenStarSeparatorNode: self
! !
--- a/compiler/PPCTokenVisitor.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCTokenVisitor.st Sun May 10 06:28:36 2015 +0100
@@ -9,86 +9,66 @@
category:'PetitCompiler-Visitors'
!
-!PPCTokenVisitor methodsFor:'accessing'!
+!PPCTokenVisitor methodsFor:'as yet unclassified'!
-forbiddenNodes: nodeSet
- forbiddenNodes := nodeSet.
-! !
+visitActionNode: node
-!PPCTokenVisitor methodsFor:'initialization'!
+ (node hasProperty: #trimmingToken) ifTrue: [
+ | child newChild |
+ "trimming token in token, remove it"
+ self change.
+
+ child := node child secondChild.
+ newChild := self visit: child.
+
+ child name isNil ifTrue: [
+ newChild name: node name.
+ ^ newChild.
+ ].
+ ^ PPCForwardNode new
+ child: newChild;
+ name: node name;
+ yourself
+ ].
-initialize
- super initialize.
- forbiddenNodes := IdentitySet new.
+ ^ super visitActionNode: node
+!
+
+visitTokenNode: node
+ "token in token, remove the token"
+ self visitChildren: node.
+
+ node child name isNil ifTrue: [
+ self change.
+ node child name: node name.
+ ^ node child
+ ].
+
+ self change.
+ ^ PPCForwardNode new
+ child: node child;
+ name: node name;
+ yourself
! !
!PPCTokenVisitor methodsFor:'traversing'!
-beforeAccept: node
- self assert: (forbiddenNodes includes: node) not description: 'Does not look like a token'
-! !
-
-!PPCTokenVisitor methodsFor:'visiting'!
-
-visitActionNode: node
- self visitChildren: node.
+afterAccept: node retval: retval
- (node hasProperty: #trimmingToken) ifTrue: [
- | child |
- "token in token..."
- child := node child children second.
- child name ifNil: [
- self change.
- child name: node name.
- ^ child
- ]
- ].
-
- self change.
- ^ node child
+ (retval name isNil not and: [ (retval name endsWith: '_ws') ]) ifTrue: [
+ self change.
+ ^ PPCTokenWhitespaceNode new
+ child: retval;
+ yourself
+ ].
+ ^ super afterAccept: node retval: retval
!
-visitSequenceNode: node
- self visitChildren: node.
-
- self change.
- ^ PPCTokenSequenceNode new
- children: node children;
- name: node name;
- properties: node properties;
- yourself
-!
-
-visitStarMessagePredicateNode: node
- self visitChildren: node.
-
- self change.
- ^ PPCTokenStarMessagePredicateNode new
- name: node name;
- message: node message;
- child: node child;
- yourself
+beforeAccept: node
+ self assert: (forbiddenNodes includes: node) not description: 'Does not look like a token'
!
-visitSymbolActionNode: node
- self visitChildren: node.
-
- self change.
- ^ node child
-!
-
-visitTokenNode: node
- self visitChildren: node.
- self change.
- ^ node child
-!
-
-visitTrimmingTokenNode: node
- self visitChildren: node.
-
- self change.
- ^ node child
-
- "Modified: / 23-04-2015 / 12:11:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+forbiddenNodes: nodeSet
+ forbiddenNodes := nodeSet.
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCTokenWhitespaceNode.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,17 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCDelegateNode subclass:#PPCTokenWhitespaceNode
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Nodes'
+!
+
+!PPCTokenWhitespaceNode methodsFor:'as yet unclassified'!
+
+accept: visitor
+ visitor visitTokenWhitespaceNode: self.
+! !
+
--- a/compiler/PPCTokenizingCodeGenerator.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCTokenizingCodeGenerator.st Sun May 10 06:28:36 2015 +0100
@@ -11,52 +11,160 @@
!PPCTokenizingCodeGenerator methodsFor:'visiting'!
-visitLLChoiceNode: node
- | dictionary currentTokenVar |
- dictionary := IdentityDictionary new.
-
- node children do: [ :child |
- | firstSet |
- firstSet := child firstSetSuchThat: [ :e | e isKindOf: PPCTokenNode ].
- self assert: firstSet size = 1.
- dictionary at: child
- put: firstSet anyOne.
-
- ].
- "Tokens are unique"
- self assert: dictionary values asSet size = node children size.
-
- compiler addConstant: (dictionary values collect: [ :e | compiler idFor: e ])
- as: #tokenMethods.
-
- currentTokenVar := compiler allocateTemporaryVariableNamed: 'currentToken'.
- compiler codeAssign: 'self currentTokenType.' to: currentTokenVar.
- node children do: [ :child |
- | tokenMethodName |
- tokenMethodName := compiler idFor: (dictionary at: child).
- compiler add: currentTokenVar , ' = ', tokenMethodName storeString.
- compiler add: 'ifTrue: ['.
- compiler codeStoreValueOf: [ self visit: child ] intoVariable: self retvalVar.
- compiler codeReturn: self retvalVar.
- compiler add: '].'
- ].
+visitChoiceNode: node
+" true ifTrue: [ ^ super visitChoiceNode: node ]."
+ "HACK alert: We are inside token..."
+ node firstSetWithTokens detect: [ :e | e isTokenNode not ] ifFound: [ ^ super visitChoiceNode: node ].
+
+ node children do: [ :child |
+ | tokenMethodName |
+
+ child firstSetWithTokens do: [ :first |
+ "For each child, for each first compile this:"
+ tokenMethodName := compiler idFor: first.
+ compiler add: '(self currentTokenTypeIs: ', tokenMethodName storeString, ')'.
+ compiler addOnLine: ' ifTrue: ['.
+ compiler indent.
+ compiler codeStoreValueOf: [ self visit: child ] intoVariable: self retvalVar.
+ compiler add: 'error ifFalse: ['.
+ compiler indent.
+ compiler codeReturn: self retvalVar.
+ compiler dedent.
+ compiler add: '] ifTrue: ['.
+ compiler indent.
+ compiler codeClearError.
+ compiler codeAssign: 'nil.' to: 'currentTokenType'.
+ compiler add: 'context position: currentTokenValue start - 1.'.
+ compiler dedent.
+ compiler add: ']'.
+ compiler dedent.
+ compiler add: '].'
+ ]
+ ].
+
+ compiler codeError: 'no choice found'.
+!
- compiler codeError: 'no choice found'.
+visitDeterministicChoiceNode: node
+ | dictionary |
+ dictionary := IdentityDictionary new.
+
+ node children do: [ :child |
+ | firstSet |
+ firstSet := child firstSetWithTokens.
+ self assert: firstSet size = 1.
+ dictionary at: child
+ put: firstSet anyOne.
+
+ ].
+ "Tokens are unique"
+ self assert: dictionary values asSet size = node children size.
+
+" currentTokenVar := compiler allocateTemporaryVariableNamed: 'currentToken'.
+ compiler codeAssign: 'self currentTokenType.' to: currentTokenVar.
+" node children do: [ :child |
+ | tokenMethodName |
+ tokenMethodName := compiler idFor: (dictionary at: child).
+ compiler add: '(self currentTokenTypeIs: ', tokenMethodName storeString, ')'.
+ compiler addOnLine: ' ifTrue: ['.
+ compiler indent.
+ compiler codeStoreValueOf: [ self visit: child ] intoVariable: self retvalVar.
+ compiler codeReturn: self retvalVar.
+ compiler dedent.
+ compiler add: '].'
+ ].
+
+ compiler codeError: 'no choice found'.
+!
+
+visitTokenChoiceNode: node
+ | trimmingToken |
+ self assert: (node children allSatisfy: [ :e | e isMarkedForInline not ]).
+
+
+ trimmingToken := node children detect: [ :e | e isTrimmingTokenNode ] ifNone: [ nil ].
+ trimmingToken isNil ifFalse: [
+ compiler codeStoreValueOf: [ self visit: trimmingToken whitespace ] intoVariable: #whatever.
+ ].
+ super visitChoiceNode: node.
!
visitTokenConsumeNode: node
- compiler codeReturn: 'self consume: ', (compiler idFor: node child) storeString, '.'
+ compiler codeReturn: 'self consume: ', (compiler idFor: node child) storeString, '.'
!
visitTokenNode: node
- | tokenType |
- self assert: node isMarkedForInline.
+ | id startVar endVar |
+ startVar := compiler allocateTemporaryVariableNamed: 'start'.
+ endVar := compiler allocateTemporaryVariableNamed: 'end'.
+
+ id := compiler idFor: node.
+ compiler toTokenRememberStrategy.
+
+ compiler codeAssign: 'context position + 1.' to: startVar.
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
+ compiler add: 'error ifFalse: [ '.
+ compiler indent.
+ compiler codeAssign: 'context position.' to: endVar.
+
+ 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 codeReturn.
+ compiler dedent.
+ compiler add: '].'.
+ compiler toNormalRememberStrategy.
+!
+
+visitTokenizingParserNode: node
+ self visit: node tokenizer.
+
+" compiler codeNextToken."
+ compiler codeHaltIfShiftPressed.
+ compiler codeStoreValueOf: [ self visit: node parser ] intoVariable: self retvalVar.
+ compiler codeReturn.
+!
- super visitTokenNode: node.
-
- tokenType := compiler idFor: node.
+visitTrimmingTokenNode: node
+ | id startVar endVar |
+
+ startVar := compiler allocateTemporaryVariableNamed: 'start'.
+ endVar := compiler allocateTemporaryVariableNamed: 'end'.
+
+ id := compiler idFor: node.
+ compiler toTokenRememberStrategy.
+
+
+ compiler addComment: 'Consume Whitespace:'.
+ compiler codeStoreValueOf: [ self visit: node whitespace ] intoVariable: #whatever.
+ compiler nl.
+
+ compiler codeAssign: 'context position + 1.' to: startVar.
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
- compiler codeAssign: tokenType storeString, '.' to: 'currentTokenType'.
- compiler codeAssign: self retvalVar, '.' to: 'currentTokenValue'.
+ compiler add: 'error ifFalse: [ '.
+ compiler indent.
+ compiler codeAssign: 'context position.' to: endVar.
+
+ compiler addComment: 'Consume Whitespace:'.
+ compiler codeStoreValueOf: [ self visit: node whitespace ] intoVariable: #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 codeReturn.
+ compiler dedent.
+ compiler add: '].' .
+ compiler toNormalRememberStrategy.
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCTokenizingCompiler.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,52 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCCompiler subclass:#PPCTokenizingCompiler
+ instanceVariableNames:'rememberStrategy'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Core'
+!
+
+!PPCTokenizingCompiler methodsFor:'accessing'!
+
+compiledParserSuperclass
+ ^ compiledParserSuperclass ifNil: [ PPTokenizingCompiledParser ]
+! !
+
+!PPCTokenizingCompiler methodsFor:'code generation'!
+
+smartRemember: parser to: variableName
+ rememberStrategy smartRemember: parser to: variableName
+!
+
+smartRestore: parser from: mementoName
+ rememberStrategy smartRestore: parser from: mementoName
+! !
+
+!PPCTokenizingCompiler methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ rememberStrategy := PPCCompilerTokenizingRememberStrategy on: self
+! !
+
+!PPCTokenizingCompiler methodsFor:'remember strategy'!
+
+toNormalRememberStrategy
+ "
+ When backtracking, currentTokenValue and currentTokenType has
+ to be restored
+ "
+ rememberStrategy := PPCCompilerTokenizingRememberStrategy on: self
+!
+
+toTokenRememberStrategy
+ "
+ We dont have to remember currentTokenType and currentTokenValue,
+ while parsing token
+ "
+ rememberStrategy := PPCCompilerTokenRememberStrategy on: self
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCTokenizingParserNode.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,44 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCListNode subclass:#PPCTokenizingParserNode
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Nodes'
+!
+
+!PPCTokenizingParserNode methodsFor:'accessing'!
+
+initialize
+ super initialize.
+ children := Array new: 2
+!
+
+parser
+ ^ children at: 1
+!
+
+parser: node
+ children at: 1 put: node
+!
+
+prefix
+ ^ #tokenizingParser
+!
+
+tokenizer
+ ^ children at: 2
+!
+
+tokenizer: node
+ ^ children at: 2 put: node
+! !
+
+!PPCTokenizingParserNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitTokenizingParserNode: self
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCTokenizingVisitor.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,105 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCRewritingVisitor subclass:#PPCTokenizingVisitor
+ instanceVariableNames:'tokens'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Visitors'
+!
+
+!PPCTokenizingVisitor methodsFor:'hooks'!
+
+afterAccept: node retval: retval
+ Halt if: [ node name = 'start' ].
+ self isRoot ifTrue: [
+ | tokenizerNode |
+ self change.
+ tokens addLast: self eofToken.
+ tokens do: [ :token | token unmarkForInline ].
+
+ tokenizerNode := PPCTokenChoiceNode new
+ children: tokens asArray;
+ name: 'nextToken';
+ yourself.
+
+ ^ PPCTokenizingParserNode new
+ parser: retval;
+ tokenizer: tokenizerNode;
+ name: #'mainParser';
+ yourself
+ ].
+ ^ retval
+
+!
+
+eofToken
+ | ws |
+ ws := PPCStarNode new
+ child: (PPCMessagePredicateNode new
+ message: #isSeparator;
+ yourself);
+ yourself.
+
+ ^ PPCTrimmingTokenNode new
+ child: PPCEndOfFileNode new;
+ whitespace: ws;
+ tokenClass: PPToken;
+ yourself.
+! !
+
+!PPCTokenizingVisitor methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ tokens := OrderedCollection new.
+! !
+
+!PPCTokenizingVisitor methodsFor:'testing'!
+
+isRoot
+ ^ openSet size = 1
+! !
+
+!PPCTokenizingVisitor methodsFor:'tokens'!
+
+addToken: token
+ (tokens contains: [:e | e == token] ) ifFalse: [
+ tokens addLast: token
+ ]
+! !
+
+!PPCTokenizingVisitor methodsFor:'visiting'!
+
+visitActionNode: node
+ (node hasProperty: #trimmingToken) ifTrue: [
+ self change.
+ self addToken: node.
+
+ ^ PPCTokenConsumeNode new
+ child: node;
+ yourself
+ ].
+
+ ^ super visitActionNode: node
+!
+
+visitTokenNode: node
+ self change.
+ self addToken: node.
+
+ ^ PPCTokenConsumeNode new
+ child: node;
+ yourself.
+!
+
+visitTrimmingTokenNode: node
+ self change.
+ self addToken: node.
+
+ ^ PPCTokenConsumeNode new
+ child: node;
+ yourself.
+! !
+
--- a/compiler/PPCTrimNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCTrimNode.st Sun May 10 06:28:36 2015 +0100
@@ -2,7 +2,7 @@
"{ NameSpace: Smalltalk }"
-PPCDelegateNode subclass:#PPCTrimNode
+PPCSequenceNode subclass:#PPCTrimNode
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
@@ -11,13 +11,63 @@
!PPCTrimNode methodsFor:'accessing'!
+child
+
+ ^ children at: 2
+!
+
+child: anObject
+
+ children at: 2 put: anObject
+!
+
prefix
- ^ #trim
+ ^ #trim
+!
+
+trimmer
+ ^ children at: 1
+!
+
+trimmer: anObject
+ children at: 1 put: anObject
+! !
+
+!PPCTrimNode methodsFor:'analysis'!
+
+acceptsEpsilon
+ ^ self child acceptsEpsilonOpenSet: (IdentitySet with: self).
+!
+
+acceptsEpsilonOpenSet: set
+ (set includes: self child) ifFalse: [
+ set add: self child.
+ ^ self child acceptsEpsilonOpenSet: set
+ ].
+ ^ false
+! !
+
+!PPCTrimNode methodsFor:'initialization'!
+
+defaultTrimmer
+ | message |
+ message := PPCMessagePredicateNode new
+ message: #isSeparator;
+ yourself.
+ ^ PPCStarNode new
+ child: message;
+ yourself.
+!
+
+initialize
+ super initialize.
+ children := Array new: 2.
+ children at: 1 put: self defaultTrimmer.
! !
!PPCTrimNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitTrimNode: self
+ ^ visitor visitTrimNode: self
! !
--- a/compiler/PPCTrimmingTokenNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCTrimmingTokenNode.st Sun May 10 06:28:36 2015 +0100
@@ -12,93 +12,107 @@
!PPCTrimmingTokenNode methodsFor:'accessing'!
child
-
- ^ children at: 2
+
+ ^ children at: 2
!
child: anObject
-
- children at: 2 put: anObject
+
+ children at: 2 put: anObject
!
prefix
- ^ #token
+ ^ #token
!
tokenClass
-
- ^ tokenClass
+
+ ^ tokenClass
!
tokenClass: anObject
-
- tokenClass := anObject
+
+ tokenClass := anObject
!
whitespace
-
- ^ children at: 1
+
+ ^ children at: 1
!
whitespace: anObject
- (anObject name isNil and: [ self child name isNotNil ]) ifTrue: [
- anObject name: self child name, '_ws'.
- ].
- children at: 1 put: anObject
+ (anObject name isNil and: [ self child name isNotNil ]) ifTrue: [
+ anObject name: self child name, '_ws'.
+ ].
+ children at: 1 put: anObject
! !
!PPCTrimmingTokenNode methodsFor:'analyzing'!
acceptsEpsilon
- ^ self child acceptsEpsilonOpenSet: (IdentitySet with: self).
+ ^ self child acceptsEpsilonOpenSet: (IdentitySet with: self).
!
acceptsEpsilonOpenSet: set
- (set includes: self child) ifFalse: [
- set add: self child.
- ^ self child acceptsEpsilonOpenSet: set
- ].
- ^ false
+ (set includes: self child) ifFalse: [
+ set add: self child.
+ ^ self child acceptsEpsilonOpenSet: set
+ ].
+ ^ false
!
firstSetSuchThat: block into: aCollection openSet: aSet
- (aSet includes: self) ifTrue: [ ^ aCollection ].
- aSet add: self.
-
- (block value: self) ifTrue: [ aCollection add: self. ^ aCollection ].
-
- ^ self child firstSetSuchThat: block into: aCollection openSet: aSet.
+ (aSet includes: self) ifTrue: [ ^ aCollection ].
+ aSet add: self.
+
+ (block value: self) ifTrue: [ aCollection add: self. ^ aCollection ].
+
+ ^ self child firstSetSuchThat: block into: aCollection openSet: aSet.
!
firstSets: aFirstDictionary into: aSet suchThat: aBlock
- "PRIVATE: Try to add additional elements to the first-set aSet of the receiver, use the incomplete aFirstDictionary."
+ "PRIVATE: Try to add additional elements to the first-set aSet of the receiver, use the incomplete aFirstDictionary."
- (aBlock value: self) ifFalse: [
- aSet addAll: (aFirstDictionary at: self child)
- ]
+ (aBlock value: self) ifFalse: [
+ aSet addAll: (aFirstDictionary at: self child)
+ ]
+!
+
+recognizedSentencesPrim
+ ^ self child recognizedSentencesPrim
! !
!PPCTrimmingTokenNode methodsFor:'comparing'!
= anotherNode
- super = anotherNode ifFalse: [ ^ false ].
- ^ tokenClass = anotherNode tokenClass.
+ super = anotherNode ifFalse: [ ^ false ].
+ ^ tokenClass = anotherNode tokenClass.
!
hash
- ^ super hash bitXor: tokenClass hash
+ ^ super hash bitXor: tokenClass hash
! !
!PPCTrimmingTokenNode methodsFor:'initialization'!
initialize
- super initialize.
- children := Array new: 2
+ super initialize.
+ children := Array new: 2
+! !
+
+!PPCTrimmingTokenNode methodsFor:'testing'!
+
+isTokenNode
+ ^ true
+!
+
+isTrimmingTokenNode
+ ^ true
! !
!PPCTrimmingTokenNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitTrimmingTokenNode: self
+ ^ visitor visitTrimmingTokenNode: self
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCUniversalConfiguration.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,26 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCConfiguration subclass:#PPCUniversalConfiguration
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Core'
+!
+
+!PPCUniversalConfiguration methodsFor:'compiling'!
+
+invokePhases
+ self toPPCIr.
+ self createTokens.
+ self cacheFirstFollow.
+ self specialize.
+ self createRecognizingComponents.
+ self specialize.
+ self inline.
+ self merge.
+ self check.
+ self generate.
+! !
+
--- a/compiler/PPCUnknownNode.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCUnknownNode.st Sun May 10 06:28:36 2015 +0100
@@ -13,72 +13,79 @@
!PPCUnknownNode class methodsFor:'as yet unclassified'!
new
- ^ self basicNew initialize
+ ^ self basicNew initialize
! !
!PPCUnknownNode methodsFor:'accessing'!
acceptsEpsilon
- ^ parser acceptsEpsilon
+ ^ parser acceptsEpsilon
!
acceptsEpsilonOpenSet: aSet
- ^ parser acceptsEpsilonOpenSet: aSet
+ ^ parser acceptsEpsilonOpenSet: aSet
!
children
- ^ parser children
+ ^ parser children
!
isContextFreePrim
- ^ parser isContextFreePrim
+ ^ parser isContextFreePrim
!
isNullable
- ^ parser isNullable
+ ^ parser isNullable
!
parser
-
- ^ parser
+
+ ^ parser
!
parser: anObject
-
- parser := anObject
+
+ parser := anObject
!
prefix
- ^ #parser
+ ^ #parser
! !
!PPCUnknownNode methodsFor:'analysis'!
firstCharSet
- ^ parser firstCharSet
+ ^ parser firstCharSet
! !
!PPCUnknownNode methodsFor:'comparison'!
= anotherNode
- super = anotherNode ifFalse: [ ^ false ].
- ^ parser = anotherNode parser.
+ super = anotherNode ifFalse: [ ^ false ].
+ ^ parser = anotherNode parser.
!
hash
- ^ super hash bitXor: parser hash
+ ^ super hash bitXor: parser hash
+! !
+
+!PPCUnknownNode methodsFor:'copying'!
+
+postCopy
+ super postCopy.
+ parser := parser copy.
! !
!PPCUnknownNode methodsFor:'transformation'!
replace: node with: anotherNode
- parser replace: node with: anotherNode
+ parser replace: node with: anotherNode
! !
!PPCUnknownNode methodsFor:'visiting'!
accept: visitor
- ^ visitor visitUnknownNode: self
+ ^ visitor visitUnknownNode: self
! !
!PPCUnknownNode class methodsFor:'documentation'!
--- a/compiler/PPCompiledParser.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/PPCompiledParser.st Sun May 10 06:28:36 2015 +0100
@@ -3,11 +3,10 @@
"{ NameSpace: Smalltalk }"
PPParser subclass:#PPCompiledParser
- instanceVariableNames:'startSymbol context failure error currentTokenValue
- currentTokenType'
+ instanceVariableNames:'startSymbol context failure error'
classVariableNames:''
poolDictionaries:''
- category:'PetitCompiler-Core'
+ category:'PetitCompiler-Parsers'
!
PPCompiledParser class instanceVariableNames:'parsers constants referringParser startSymbol'
@@ -20,144 +19,117 @@
!PPCompiledParser class methodsFor:'as yet unclassified'!
addConstant: value as: id
- self constants at: id ifPresent: [
- ((self constants at: id) = value) ifFalse: [self error: 'ooups']].
-
- self constants at: id put: value.
+ self constants at: id ifPresent: [
+ ((self constants at: id) = value) ifFalse: [self error: 'ooups']].
+
+ self constants at: id put: value.
!
constants
- constants ifNil: [ constants := IdentityDictionary new ].
- ^ constants
+ constants ifNil: [ constants := IdentityDictionary new ].
+ ^ constants
!
parse: input
- ^ self new parse: input
+ ^ self new parse: input
!
referringParser
- ^ referringParser ifNil: [ ^ PPSentinel new ]
+ ^ referringParser ifNil: [ ^ PPSentinel new ]
!
referringParser: aPPParser
- referringParser := aPPParser
+ referringParser := aPPParser
!
startSymbol
- ^ startSymbol ifNil: [ ^ #start ]
+ ^ startSymbol ifNil: [ ^ #start ]
!
startSymbol: symbol
- startSymbol := symbol
+ startSymbol := symbol
! !
!PPCompiledParser methodsFor:'as yet unclassified'!
callParser: id
- | retval |
- retval := (self class parsers at: id) parseOn: context.
- retval isPetitFailure ifTrue: [ self error: retval message at: retval position ]
- ifFalse: [ self clearError ].
- ^ retval
+ | retval |
+ retval := (self class parsers at: id) parseOn: context.
+ retval isPetitFailure ifTrue: [ self error: retval message at: retval position ]
+ ifFalse: [ self clearError ].
+ ^ retval
!
clearError
- error := false.
+ error := false.
!
error
- ^ self error: '' at: context position
+ ^ self error: '' at: context position
!
error: message
- ^ self error: message at: context position
+ ^ self error: message at: context position
!
error: aMessage at: position
- failure position < position ifTrue: [
- failure message: aMessage.
- failure position: position
- ].
- error := true.
- ^ failure
+ failure position < position ifTrue: [
+ failure message: aMessage.
+ failure position: position
+ ].
+ error := true.
+ ^ failure
!
initialize
- super initialize.
-
- self class constants keysAndValuesDo: [ :key :value |
- self instVarNamed: key put: value.
- ].
+ super initialize.
+
+ self class constants keysAndValuesDo: [ :key :value |
+ self instVarNamed: key put: value.
+ ].
- startSymbol := self class startSymbol.
+ startSymbol := self class startSymbol.
-
+
!
isCompiled
- ^ true
+ ^ true
!
isError
- ^ error
+ ^ error
!
parse: input rule: symbol
- startSymbol := symbol.
- ^ self parse: input.
+ startSymbol := symbol.
+ ^ self parse: input.
!
start
- ^ self subclassResponsibility
+ ^ self subclassResponsibility
!
startSymbol: aSymbol
- startSymbol := aSymbol
+ startSymbol := aSymbol
! !
!PPCompiledParser methodsFor:'parsing'!
parseOn: aPPContext
- | retval |
+ | retval |
" context := aPPContext asCompiledParserContext."
- context := aPPContext.
- context compiledParser: self.
- failure := PPFailure new message: nil; context: context; position: -1.
- context noteFailure: failure.
- error := false.
+ context := aPPContext.
+ context compiledParser: self.
+ failure := PPFailure new message: nil; context: context; position: -1.
+ context noteFailure: failure.
+ error := false.
- retval := self perform: startSymbol.
- (retval isPetitFailure) ifTrue: [ aPPContext noteFailure: failure ].
- error ifTrue: [ aPPContext noteFailure: failure. retval := failure ].
-
+ retval := self perform: startSymbol.
+ (retval isPetitFailure) ifTrue: [ aPPContext noteFailure: failure ].
+ error ifTrue: [ aPPContext noteFailure: failure. retval := failure ].
+
" aPPContext position: context position."
- ^ retval
+ ^ retval
! !
-!PPCompiledParser methodsFor:'tokenizing'!
-
-consume: tokenType
- (currentTokenType = tokenType) ifTrue: [
- | retval |
- retval := currentTokenValue.
- self nextToken.
- ^ retval
- ] ifFalse: [
- self error: 'expected: ', tokenType storeString, ' got ', currentTokenType storeString.
- ]
-!
-
-currentTokenType
- currentTokenType isNil ifTrue: [ self nextToken ].
- ^ currentTokenType
-!
-
-currentTokenValue
- currentTokenType isNil ifTrue: [ self nextToken ].
- ^ currentTokenType
-!
-
-nextToken
- self shouldBeImplemented
-! !
-
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPTokenizingCompiledParser.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,56 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCompiledParser subclass:#PPTokenizingCompiledParser
+ instanceVariableNames:'currentTokenValue currentTokenType'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Parsers'
+!
+
+!PPTokenizingCompiledParser methodsFor:'tokenizing'!
+
+consume: tokenType
+ (self currentTokenTypeIs: tokenType) ifTrue: [
+ | retval |
+ retval := currentTokenValue.
+ currentTokenType := nil.
+ ^ retval
+ ] ifFalse: [
+ "self error: 'expected: ', tokenType storeString, ' got ', currentTokenType storeString."
+ self error.
+ ]
+!
+
+currentTokenType
+ currentTokenType isNil ifTrue: [ self nextToken ].
+ ^ currentTokenType
+!
+
+currentTokenTypeIs: tokenType
+ "if the type is read"
+ currentTokenType isNil ifFalse: [ ^ currentTokenType = tokenType ].
+
+ "if not, try to read the token"
+ self perform: tokenType.
+ error ifTrue: [
+ ^ error := false.
+ ].
+ ^ true
+!
+
+currentTokenValue
+ currentTokenType isNil ifTrue: [ self nextToken ].
+ ^ currentTokenType
+!
+
+nextToken
+ self shouldBeImplemented
+!
+
+parseOn: input
+ currentTokenType := nil.
+ ^ super parseOn: input.
+! !
+
--- a/compiler/abbrev.stc Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/abbrev.stc Sun May 10 06:28:36 2015 +0100
@@ -5,6 +5,8 @@
PPCBridge PPCBridge stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCCompiledMethod PPCCompiledMethod stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCCompiler PPCCompiler stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
+PPCCompilerTokenRememberStrategy PPCCompilerTokenRememberStrategy stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
+PPCCompilerTokenizingRememberStrategy PPCCompilerTokenizingRememberStrategy stx:goodies/petitparser/compiler 'PetitCompiler-Core' 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
@@ -12,7 +14,8 @@
PPCMethod PPCMethod stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCNode PPCNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCNodeVisitor PPCNodeVisitor stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
-PPCompiledParser PPCompiledParser stx:goodies/petitparser/compiler 'PetitCompiler-Core' 4
+PPCPluggableConfiguration PPCPluggableConfiguration stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
+PPCompiledParser PPCompiledParser stx:goodies/petitparser/compiler 'PetitCompiler-Parsers' 4
stx_goodies_petitparser_compiler stx_goodies_petitparser_compiler stx:goodies/petitparser/compiler '* Projects & Packages *' 3
PPCAbstractCharacterNode PPCAbstractCharacterNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCAbstractLiteralNode PPCAbstractLiteralNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
@@ -21,23 +24,27 @@
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
-PPCFirstPrototype PPCFirstPrototype stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCInlinedMethod PPCInlinedMethod stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCInliningVisitor PPCInliningVisitor stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
+PPCLL1Configuration PPCLL1Configuration stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCListNode PPCListNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCNilNode PPCNilNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCPluggableConfiguration PPCPluggableConfiguration stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
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
+PPCTokenizingCompiler PPCTokenizingCompiler stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
+PPCUniversalConfiguration PPCUniversalConfiguration stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCUnknownNode PPCUnknownNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
+PPTokenizingCompiledParser PPTokenizingCompiledParser stx:goodies/petitparser/compiler 'PetitCompiler-Parsers' 4
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
PPCCharacterNode PPCCharacterNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCChoiceNode PPCChoiceNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCCopyVisitor PPCCopyVisitor stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
+PPCEndOfInputNode PPCEndOfInputNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCForwardNode PPCForwardNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
+PPCLL1Visitor PPCLL1Visitor stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
PPCLiteralNode PPCLiteralNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCMergingVisitor PPCMergingVisitor stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
PPCMessagePredicateNode PPCMessagePredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
@@ -46,26 +53,33 @@
PPCNotLiteralNode PPCNotLiteralNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCNotMessagePredicateNode PPCNotMessagePredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCNotNode PPCNotNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCOptimizingVisitor PPCOptimizingVisitor stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
+PPCOptimizeChoices PPCOptimizeChoices stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
PPCOptionalNode PPCOptionalNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCPlusNode PPCPlusNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCPredicateNode PPCPredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
+PPCRecognizerComponentDetector PPCRecognizerComponentDetector stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
+PPCRecognizerComponentVisitor PPCRecognizerComponentVisitor stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
PPCSentinelNode PPCSentinelNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 1
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
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
PPCTokenVisitor PPCTokenVisitor stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
+PPCTokenWhitespaceNode PPCTokenWhitespaceNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCTokenizingCodeGenerator PPCTokenizingCodeGenerator stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
-PPCTrimNode PPCTrimNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
+PPCTokenizingParserNode PPCTokenizingParserNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
+PPCTokenizingVisitor PPCTokenizingVisitor stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
PPCTrimmingTokenNode PPCTrimmingTokenNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCActionNode PPCActionNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCLLChoiceNode PPCLLChoiceNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
+PPCDeterministicChoiceNode PPCDeterministicChoiceNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
+PPCRecognizingSequenceNode PPCRecognizingSequenceNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCStarAnyNode PPCStarAnyNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCStarCharSetPredicateNode PPCStarCharSetPredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCStarMessagePredicateNode PPCStarMessagePredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCSymbolActionNode PPCSymbolActionNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCTokenSequenceNode PPCTokenSequenceNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
+PPCTokenChoiceNode PPCTokenChoiceNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
+PPCTrimNode PPCTrimNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCTokenStarMessagePredicateNode PPCTokenStarMessagePredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCTokenStarSeparatorNode PPCTokenStarSeparatorNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
--- a/compiler/bc.mak Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/bc.mak Sun May 10 06:28:36 2015 +0100
@@ -82,6 +82,8 @@
$(OUTDIR)PPCBridge.$(O) PPCBridge.$(H): PPCBridge.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCCompiledMethod.$(O) PPCCompiledMethod.$(H): PPCCompiledMethod.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCCompiler.$(O) PPCCompiler.$(H): PPCCompiler.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCCompilerTokenRememberStrategy.$(O) PPCCompilerTokenRememberStrategy.$(H): PPCCompilerTokenRememberStrategy.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCCompilerTokenizingRememberStrategy.$(O) PPCCompilerTokenizingRememberStrategy.$(H): PPCCompilerTokenizingRememberStrategy.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCConfiguration.$(O) PPCConfiguration.$(H): PPCConfiguration.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(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)
@@ -89,6 +91,7 @@
$(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)PPCompiledParser.$(O) PPCompiledParser.$(H): PPCompiledParser.st $(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)PPCAbstractCharacterNode.$(O) PPCAbstractCharacterNode.$(H): PPCAbstractCharacterNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
@@ -98,23 +101,27 @@
$(OUTDIR)PPCCodeGenerator.$(O) PPCCodeGenerator.$(H): PPCCodeGenerator.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNodeVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCDelegateNode.$(O) PPCDelegateNode.$(H): PPCDelegateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCEndOfFileNode.$(O) PPCEndOfFileNode.$(H): PPCEndOfFileNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCFirstPrototype.$(O) PPCFirstPrototype.$(H): PPCFirstPrototype.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCConfiguration.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCInlinedMethod.$(O) PPCInlinedMethod.$(H): PPCInlinedMethod.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCMethod.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCInliningVisitor.$(O) PPCInliningVisitor.$(H): PPCInliningVisitor.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNodeVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLL1Configuration.$(O) PPCLL1Configuration.$(H): PPCLL1Configuration.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCConfiguration.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCListNode.$(O) PPCListNode.$(H): PPCListNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCNilNode.$(O) PPCNilNode.$(H): PPCNilNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCPluggableConfiguration.$(O) PPCPluggableConfiguration.$(H): PPCPluggableConfiguration.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCConfiguration.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(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)PPCTokenizingCompiler.$(O) PPCTokenizingCompiler.$(H): PPCTokenizingCompiler.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCCompiler.$(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)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)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)
$(OUTDIR)PPCCharacterNode.$(O) PPCCharacterNode.$(H): PPCCharacterNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractCharacterNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCChoiceNode.$(O) PPCChoiceNode.$(H): PPCChoiceNode.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)PPCCopyVisitor.$(O) PPCCopyVisitor.$(H): PPCCopyVisitor.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)PPCEndOfInputNode.$(O) PPCEndOfInputNode.$(H): PPCEndOfInputNode.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)PPCForwardNode.$(O) PPCForwardNode.$(H): PPCForwardNode.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)PPCLL1Visitor.$(O) PPCLL1Visitor.$(H): PPCLL1Visitor.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)PPCLiteralNode.$(O) PPCLiteralNode.$(H): PPCLiteralNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractLiteralNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCMergingVisitor.$(O) PPCMergingVisitor.$(H): PPCMergingVisitor.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)PPCMessagePredicateNode.$(O) PPCMessagePredicateNode.$(H): PPCMessagePredicateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractPredicateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
@@ -123,30 +130,37 @@
$(OUTDIR)PPCNotLiteralNode.$(O) PPCNotLiteralNode.$(H): PPCNotLiteralNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractLiteralNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCNotMessagePredicateNode.$(O) PPCNotMessagePredicateNode.$(H): PPCNotMessagePredicateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractPredicateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCNotNode.$(O) PPCNotNode.$(H): PPCNotNode.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)PPCOptimizingVisitor.$(O) PPCOptimizingVisitor.$(H): PPCOptimizingVisitor.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)PPCOptimizeChoices.$(O) PPCOptimizeChoices.$(H): PPCOptimizeChoices.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)PPCOptionalNode.$(O) PPCOptionalNode.$(H): PPCOptionalNode.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)PPCPlusNode.$(O) PPCPlusNode.$(H): PPCPlusNode.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)PPCPredicateNode.$(O) PPCPredicateNode.$(H): PPCPredicateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractPredicateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCRecognizerComponentDetector.$(O) PPCRecognizerComponentDetector.$(H): PPCRecognizerComponentDetector.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)PPCRecognizerComponentVisitor.$(O) PPCRecognizerComponentVisitor.$(H): PPCRecognizerComponentVisitor.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)PPCSentinelNode.$(O) PPCSentinelNode.$(H): PPCSentinelNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNilNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(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)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)
$(OUTDIR)PPCTokenVisitor.$(O) PPCTokenVisitor.$(H): PPCTokenVisitor.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)PPCTokenWhitespaceNode.$(O) PPCTokenWhitespaceNode.$(H): PPCTokenWhitespaceNode.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)PPCTokenizingCodeGenerator.$(O) PPCTokenizingCodeGenerator.$(H): PPCTokenizingCodeGenerator.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)PPCTrimNode.$(O) PPCTrimNode.$(H): PPCTrimNode.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)PPCTokenizingParserNode.$(O) PPCTokenizingParserNode.$(H): PPCTokenizingParserNode.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)PPCTokenizingVisitor.$(O) PPCTokenizingVisitor.$(H): PPCTokenizingVisitor.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)PPCTrimmingTokenNode.$(O) PPCTrimmingTokenNode.$(H): PPCTrimmingTokenNode.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)PPCActionNode.$(O) PPCActionNode.$(H): PPCActionNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractActionNode.$(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)PPCLLChoiceNode.$(O) PPCLLChoiceNode.$(H): PPCLLChoiceNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCChoiceNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCListNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCDeterministicChoiceNode.$(O) PPCDeterministicChoiceNode.$(H): PPCDeterministicChoiceNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCChoiceNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCListNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCRecognizingSequenceNode.$(O) PPCRecognizingSequenceNode.$(H): PPCRecognizingSequenceNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCListNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCSequenceNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCStarAnyNode.$(O) PPCStarAnyNode.$(H): PPCStarAnyNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCDelegateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCStarNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCStarCharSetPredicateNode.$(O) PPCStarCharSetPredicateNode.$(H): PPCStarCharSetPredicateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCDelegateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCStarNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCStarMessagePredicateNode.$(O) PPCStarMessagePredicateNode.$(H): PPCStarMessagePredicateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCDelegateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCStarNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCSymbolActionNode.$(O) PPCSymbolActionNode.$(H): PPCSymbolActionNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractActionNode.$(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)PPCTokenSequenceNode.$(O) PPCTokenSequenceNode.$(H): PPCTokenSequenceNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCListNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCSequenceNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCTokenChoiceNode.$(O) PPCTokenChoiceNode.$(H): PPCTokenChoiceNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCChoiceNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCListNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCTrimNode.$(O) PPCTrimNode.$(H): PPCTrimNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCListNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCSequenceNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)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\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\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)
# ENDMAKEDEPEND --- do not remove this line
--- a/compiler/benchmarks/Make.proto Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/benchmarks/Make.proto Sun May 10 06:28:36 2015 +0100
@@ -122,7 +122,6 @@
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
$(OUTDIR)PPCBenchmark.$(O) PPCBenchmark.$(H): PPCBenchmark.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCBenchmarkResources.$(O) PPCBenchmarkResources.$(H): PPCBenchmarkResources.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)stx_goodies_petitparser_compiler_benchmarks.$(O) stx_goodies_petitparser_compiler_benchmarks.$(H): stx_goodies_petitparser_compiler_benchmarks.st $(INCLUDE_TOP)/stx/libbasic/LibraryDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProjectDefinition.$(H) $(STCHDR)
# ENDMAKEDEPEND --- do not remove this line
--- a/compiler/benchmarks/Make.spec Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/benchmarks/Make.spec Sun May 10 06:28:36 2015 +0100
@@ -52,7 +52,6 @@
COMMON_CLASSES= \
PPCBenchmark \
- PPCBenchmarkResources \
stx_goodies_petitparser_compiler_benchmarks \
@@ -60,7 +59,6 @@
COMMON_OBJS= \
$(OUTDIR_SLASH)PPCBenchmark.$(O) \
- $(OUTDIR_SLASH)PPCBenchmarkResources.$(O) \
$(OUTDIR_SLASH)stx_goodies_petitparser_compiler_benchmarks.$(O) \
--- a/compiler/benchmarks/PPCBenchmark.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/benchmarks/PPCBenchmark.st Sun May 10 06:28:36 2015 +0100
@@ -3,7 +3,8 @@
"{ NameSpace: Smalltalk }"
Object subclass:#PPCBenchmark
- instanceVariableNames:'sources report contextClass compile parser context input'
+ instanceVariableNames:'sources report contextClass compile parser context input
+ configuration'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Benchmarks-Core'
@@ -21,399 +22,437 @@
!PPCBenchmark class methodsFor:'benchmarking-CalipeL'!
run
- | benchmarkSuiteClass |
-
- benchmarkSuiteClass := Smalltalk at: #BenchmarkSuite.
- benchmarkSuiteClass isNil ifTrue:[
- self error: 'CalipeL is not loaded.'
- ].
- ^ (benchmarkSuiteClass class:self) run
+ | benchmarkSuiteClass |
+
+ benchmarkSuiteClass := Smalltalk at: #BenchmarkSuite.
+ benchmarkSuiteClass isNil ifTrue:[
+ self error: 'CalipeL is not loaded.'
+ ].
+ ^ (benchmarkSuiteClass class:self) run
"
- PPCBenchmark run.
- "
+ PPCBenchmark run.
+ "
!
run: selector
- | benchmarkSuiteClass |
-
- benchmarkSuiteClass := Smalltalk at: #BenchmarkSuite.
- benchmarkSuiteClass isNil ifTrue:[
- self error: 'CalipeL is not loaded.'
- ].
- ^ (benchmarkSuiteClass class:self selector: selector ) run
-
- "
- PPCBenchmark run: #benchmarkRBParserC
- "
+ | benchmarkSuiteClass |
+
+ benchmarkSuiteClass := Smalltalk at: #BenchmarkSuite.
+ benchmarkSuiteClass isNil ifTrue:[
+ self error: 'CalipeL is not loaded.'
+ ].
+ ^ (benchmarkSuiteClass class:self selector: selector ) run
+
+ "
+ PPCBenchmark run: #benchmarkRBParserC
+ "
! !
!PPCBenchmark methodsFor:'benchmark support'!
compile: value
- compile := value
-!
-
-createContext
- ^ contextClass new
-!
-
-initialize
- super initialize.
- sources := PPCBenchmarkResources new.
- contextClass := PPCContext.
- compile := false.
+ compile := value
!
measure: aParser on: anInput name: aString
- | time result p |
- context := self createContext.
-
- p := compile ifTrue: [
- aParser end compile
- ] ifFalse: [
- aParser end
- ].
+ | time result p |
+ context := self createContext.
+
+ p := compile ifTrue: [
+ aParser end compile
+ ] ifFalse: [
+ aParser end
+ ].
-
- time := Time millisecondsToRun: [ result := p parse: anInput withContext: context ].
+
+ time := Time millisecondsToRun: [ result := p parse: anInput withContext: context ].
- self assert: result isPetitFailure not.
- self reportFor: aParser context: context input: anInput time: time name: aString.
+ self assert: result isPetitFailure not.
+ self reportFor: aParser context: context input: anInput time: time name: aString.
!
reportFor: aParser context: aContext input: anInput time: time name: name
- Transcript crShow: (self getMetaInfo: name).
- Transcript crShow: ' Compile: ', compile asString.
-
- Transcript crShow: ' Total time: ', time asString, ' ms'.
-
- Transcript crShow: ' Time per character: ',
- (((time / anInput size) asFloat * 1000) asString truncateTo: 6),
- ' microseconds'.
-
+ Transcript crShow: (self getMetaInfo: name).
+ Transcript crShow: ' Compile: ', compile asString.
+
+ Transcript crShow: ' Total time: ', time asString, ' ms'.
+
+ Transcript crShow: ' Time per character: ',
+ (((time / anInput size) asFloat * 1000) asString truncateTo: 6),
+ ' microseconds'.
+
" Transcript crShow: ' Backtrack per character: ',
- ((aContext backtrackCount / anInput size) asFloat asString truncateTo: 6),
- '.'.
-
- Transcript crShow: ' Remembers per character: ',
- ((aContext rememberCount / input size) asFloat asString truncateTo: 6),
- '.'.
+ ((aContext backtrackCount / anInput size) asFloat asString truncateTo: 6),
+ '.'.
+
+ Transcript crShow: ' Remembers per character: ',
+ ((aContext rememberCount / input size) asFloat asString truncateTo: 6),
+ '.'.
"
!
reportInput: input time: time name: name
- | size |
- size := input inject: 0 into: [:r :e | r + e size ].
- Transcript crShow: 'Size: ', size asString.
- Transcript crShow: name, ' time: ', time asString.
- Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
+ | size |
+ size := input inject: 0 into: [:r :e | r + e size ].
+ Transcript crShow: 'Size: ', size asString.
+ Transcript crShow: name, ' time: ', time asString.
+ Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
! !
!PPCBenchmark methodsFor:'benchmarks'!
benchmarkJavaSyntax
- | time |
-
- self assert: '../java-src' asFileReference exists description: '../java-src directory with java sources expected'.
+ | time |
+
+ self assert: '../java-src' asFileReference exists description: '../java-src directory with java sources expected'.
- parser := PPJavaSyntax new.
- context := PPCContext new.
- context initializeFor: parser.
- input := sources javaSourcesBig.
+ parser := PPJavaSyntax new.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources javaSourcesBig.
- time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
-
- self reportInput: input time: time name: 'Java Syntax'.
+ time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
+
+ self reportInput: input time: time name: 'Java Syntax'.
!
benchmarkJavaSyntaxCompiled
- | time |
-
- self assert: '../java-src' asFileReference exists description: '../java-src directory with java sources expected'.
+ | time |
+
+ self assert: '../java-src' asFileReference exists description: '../java-src directory with java sources expected'.
- parser := PPJavaSyntax new compile.
- context := PPCContext new.
- context initializeFor: parser.
- input := sources javaSourcesBig.
+ parser := PPJavaSyntax new compile.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources javaSourcesBig.
- time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
-
- self reportInput: input time: time name: 'Java Syntax Compiled'.
+ time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
+
+ self reportInput: input time: time name: 'Java Syntax Compiled'.
!
benchmarkOpalCompiler
- | parser time input |
- parser := OpalCompiler new.
- input := sources smalltalkSourcesBig.
- time := [ input do: [ :source | parser parse: source ]] timeToRun asMilliseconds.
-
- self reportInput: input time: time name: 'Opal'
+ | parser time input |
+ parser := OpalCompiler new.
+ input := sources smalltalkSourcesBig.
+ time := [ input do: [ :source | parser parse: source ]] timeToRun asMilliseconds.
+
+ self reportInput: input time: time name: 'Opal'
!
benchmarkSmalltalkGrammar
- | time |
+ | time |
+
+ self setupSmalltalkGrammar.
- parser := PPSmalltalkGrammar new.
- context := PPContext new.
- context initializeFor: parser.
- input := sources smalltalkSourcesBig.
-
- time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
-
- self reportInput: input time: time name: 'Smalltalk Grammar'.
+ time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
+
+ self reportInput: input time: time name: 'Smalltalk Grammar'.
!
benchmarkSmalltalkGrammarCompiled
- | time |
- parser := PPSmalltalkGrammar new compile.
- context := PPCContext new.
- context initializeFor: parser.
- input := sources smalltalkSourcesBig.
+ | time |
+
+ self setupSmalltalkGrammarCompiled.
- time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
-
- self reportInput: input time: time name: 'Compiled Grammar'.
+ 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'.
+ 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'.
+"
+!
+
+benchmarkSmalltalkGrammarTokenized
+ | time |
+
+ self setupSmalltalkGrammarTokenized.
+
+ 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.
+ Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
"
!
benchmarkSmalltalkParser
- | time |
- parser := PPSmalltalkParser new.
- context := PPContext new.
- context initializeFor: parser.
- input := sources smalltalkSourcesBig.
+ | time |
+ parser := PPSmalltalkParser new.
+ context := PPContext new.
+ context initializeFor: parser.
+ input := sources smalltalkSourcesBig.
- time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
-
- self reportInput: input time: time name: 'Smalltalk Parser'.
+ time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
+
+ self reportInput: input time: time name: 'Smalltalk Parser'.
!
benchmarkSmalltalkParserCompiled
- | time |
- parser := PPSmalltalkParser new compile.
- context := PPCContext new.
- context initializeFor: parser.
- input := sources smalltalkSourcesBig.
+ | time |
+
+ configuration := PPCConfiguration default.
+ parser := PPSmalltalkParser new compileWithConfiguration: configuration.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources smalltalkSourcesBig.
- time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
-
- self reportInput: input time: time name: 'Smalltalk Parser Compiled'.
+ time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
+
+ self reportInput: input time: time name: 'Smalltalk Parser Compiled'.
! !
!PPCBenchmark methodsFor:'benchmarks - micro'!
benchmarkAnyStar
"
- self measure: self anyStar on: sources petitParserPackage.
+ self measure: self anyStar on: sources petitParserPackage.
"
- self measure: self anyStar on: (sources changesSized: 1000*1000) name: #anyStar.
+ self measure: self anyStar on: (sources changesSized: 1000*1000) name: #anyStar.
!
benchmarkAnyStarBlock
"
- self measure: self anyStar on: sources petitParserPackage.
+ self measure: self anyStar on: sources petitParserPackage.
"
- self measure: self anyStarBlock on: (sources changesSized: 1000*1000) name: #anyStarBlock.
+ self measure: self anyStarBlock on: (sources changesSized: 1000*1000) name: #anyStarBlock.
!
benchmarkToken
"
- self measure: self anyStar on: sources petitParserPackage.
+ self measure: self anyStar on: sources petitParserPackage.
"
- parser := (self tokenParser / #any asParser) star.
- self measure: parser on: (sources changesSized: 1000*1000) name: #token.
+ parser := (self tokenParser / #any asParser) star.
+ self measure: parser on: (sources changesSized: 1000*1000) name: #token.
! !
!PPCBenchmark methodsFor:'benchmarks-CalipeL'!
benchmarkJavaSyntaxC
- <setup: #setupJavaSyntaxC>
- <benchmark: 'Petit Java Parser - Standard'>
-
- input do: [ :source | parser parse: source withContext: context ]
+ <setup: #setupJavaSyntax>
+ <benchmark: 'Petit Java Parser - Standard'>
+
+ input do: [ :source | parser parse: source withContext: context ]
!
benchmarkJavaSyntaxCompiledC
- <setup: #setupJavaSyntaxCompiledC>
- <teardown: #teardownJavaSyntaxCompiledC>
- <benchmark: 'Petit Java Parser - Compiled'>
-
- input do: [ :source | parser parse: source withContext: context ]
-
+ <setup: #setupJavaSyntaxCompiled>
+ <teardown: #teardownJavaSyntaxCompiled>
+ <benchmark: 'Petit Java Parser - Compiled'>
+
+ input do: [ :source | parser parse: source withContext: context ]
+
!
benchmarkRBParserC
- <setup: #setupRBParserC>
- <benchmark: 'RB Smalltalk Parser'>
-
- input do: [ :source | RBParser parseMethod: source ]
+ <setup: #setupRBParser>
+ <benchmark: 'RB Smalltalk Parser'>
+
+ input do: [ :source | RBParser parseMethod: source ]
!
benchmarkSmalltalkGrammarC
- <setup: #setupSmalltalkGrammarC>
- <benchmark: 'Petit Smalltalk Grammar - Standard'>
-
- input do: [ :source | parser parse: source withContext: context ]
+ <setup: #setupSmalltalkGrammar>
+ <benchmark: 'Petit Smalltalk Grammar - Standard'>
+
+ input do: [ :source | parser parse: source withContext: context ]
!
benchmarkSmalltalkGrammarCompiledC
- <setup: #setupSmalltalkGrammarCompiledC>
- <teardown: #teardownSmalltalkGrammarCompiledC>
- <benchmark: 'Petit Smalltalk Grammar - Compiled'>
-
-
- input do: [ :source | parser parse: source withContext: context ]
+ <setup: #setupSmalltalkGrammarCompiled>
+ <teardown: #teardownSmalltalkGrammarCompiled>
+ <benchmark: 'Petit Smalltalk Grammar - Compiled'>
+
+
+ input do: [ :source | parser parse: source withContext: context ]
+!
+
+benchmarkSmalltalkGrammarTokenizedC
+ <setup: #setupSmalltalkGrammarTokenized>
+ <teardown: #teardownSmalltalkGrammarTokenized>
+ <benchmark: 'Petit Smalltalk Grammar - Tokenized'>
+
+
+ input do: [ :source | parser parse: source withContext: context ]
!
benchmarkSmalltalkParserC
- <setup: #setupSmalltalkParserC>
- <benchmark: 'Petit Smalltalk Parser - Standard'>
-
- input do: [ :source | parser parse: source withContext: context ]
+ <setup: #setupSmalltalkParser>
+ <benchmark: 'Petit Smalltalk Parser - Standard'>
+
+ input do: [ :source | parser parse: source withContext: context ]
!
benchmarkSmalltalkParserCompiledC
- <setup: #setupSmalltalkParserCompiledC>
- <teardown: #teardownSmalltalkParserCompiledC>
- <benchmark: 'Petit Smalltalk Parser - Compiled'>
-
- input do: [ :source | parser parse: source withContext: context ]
-
+ <setup: #setupSmalltalkParserCompiled>
+ <teardown: #teardownSmalltalkParserCompiled>
+ <benchmark: 'Petit Smalltalk Parser - Compiled'>
+
+ input do: [ :source | parser parse: source withContext: context ]
+
! !
-!PPCBenchmark methodsFor:'benchmarks-CalipeL- setup & teardown'!
-
-setupJavaSyntaxC
-
- parser := PPJavaSyntax new.
- context := PPCContext new.
- context initializeFor: parser.
- input := sources javaSourcesBig.
-!
-
-setupJavaSyntaxCompiledC
- parser := PPJavaSyntax new compile.
- context := PPCContext new.
- context initializeFor: parser.
- input := sources javaSourcesBig.
+!PPCBenchmark methodsFor:'intitialization'!
-"
- 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'.
-"
-!
-
-setupRBParserC
-
- input := sources smalltalkSourcesBig.
-!
-
-setupSmalltalkGrammarC
-
- parser := PPSmalltalkGrammar new.
- context := PPCContext new.
- context initializeFor: parser.
- input := sources smalltalkSourcesBig.
+createContext
+ ^ contextClass new
!
-setupSmalltalkGrammarCompiledC
- parser := PPSmalltalkGrammar new compile.
- context := PPCContext new.
- context initializeFor: parser.
- input := sources smalltalkSourcesBig.
-
-"
- 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'.
-"
-!
-
-setupSmalltalkParserC
-
- parser := PPSmalltalkParser new.
- context := PPCContext new.
- context initializeFor: parser.
- input := sources smalltalkSourcesBig.
-!
-
-setupSmalltalkParserCompiledC
- parser := PPSmalltalkParser new compile.
- context := PPCContext new.
- context initializeFor: parser.
- input := sources smalltalkSourcesBig.
-
-"
- 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'.
-"
-!
-
-teardownJavaSyntaxCompiledC
- parser class removeFromSystem.
-"
- size := input inject: 0 into: [:r :e | r + e size ].
- Transcript crShow: 'Compiled Grammar time: ', time asString.
- Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
-"
-!
-
-teardownSmalltalkGrammarCompiledC
- parser class removeFromSystem.
-"
- size := input inject: 0 into: [:r :e | r + e size ].
- Transcript crShow: 'Compiled Grammar time: ', time asString.
- Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
-"
-!
-
-teardownSmalltalkParserCompiledC
- parser class removeFromSystem.
-"
- size := input inject: 0 into: [:r :e | r + e size ].
- Transcript crShow: 'Compiled Grammar time: ', time asString.
- Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
-"
+initialize
+ super initialize.
+ sources := PPCResources current.
+ contextClass := PPCContext.
+ compile := false.
! !
!PPCBenchmark methodsFor:'meta'!
getMetaInfo: key
- | info |
- info := self metaInfo select: [ :each | each key = key ].
- info isEmpty ifTrue: [ ^ 'unknown benchmark' ].
- ^ info anyOne value
+ | info |
+ info := self metaInfo select: [ :each | each key = key ].
+ info isEmpty ifTrue: [ ^ 'unknown benchmark' ].
+ ^ info anyOne value
!
metaInfo
- ^ {
- #anyStar -> '.* Parser'.
- #token -> 'Token Parser'.
- #tokenCompiled -> 'Token Parser Compiled'.
- #anyStarBlock -> 'context next in loop'.
- }
+ ^ {
+ #anyStar -> '.* Parser'.
+ #token -> 'Token Parser'.
+ #tokenCompiled -> 'Token Parser Compiled'.
+ #anyStarBlock -> 'context next in loop'.
+ }
! !
!PPCBenchmark methodsFor:'parsers'!
anyStar
- ^ #any asParser star
+ ^ #any asParser star
!
anyStarBlock
- ^ [ :ctx | [ctx atEnd] whileFalse: [ ctx next ] ] asParser
+ ^ [ :ctx | [ctx atEnd] whileFalse: [ ctx next ] ] asParser
!
tokenParser
- ^ #letter asParser, (#letter asParser / #digit asParser) star trim
+ ^ #letter asParser, (#letter asParser / #digit asParser) star trim
+! !
+
+!PPCBenchmark methodsFor:'setup & teardown'!
+
+setupJavaSyntax
+
+ parser := PPJavaSyntax new.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources javaSourcesBig.
+!
+
+setupJavaSyntaxCompiled
+ parser := PPJavaSyntax new compile.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources javaSourcesBig.
+
+"
+ 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'.
+"
+!
+
+setupRBParser
+
+ input := sources smalltalkSourcesBig.
+!
+
+setupSmalltalkGrammar
+
+ parser := PPSmalltalkGrammar new.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources smalltalkSourcesBig.
+!
+
+setupSmalltalkGrammarCompiled
+
+ configuration := PPCConfiguration universal.
+ configuration arguments name: #PPCompiledSmalltalkGrammar.
+ parser := PPSmalltalkGrammar new compileWithConfiguration: configuration.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources smalltalkSourcesBig.
+!
+
+setupSmalltalkGrammarTokenized
+
+ configuration := PPCConfiguration LL1.
+ configuration arguments name: #PPTokenizedSmalltalkGrammar.
+ parser := PPSmalltalkGrammar new compileWithConfiguration: configuration.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources smalltalkSourcesBig.
+!
+
+setupSmalltalkParser
+
+ parser := PPSmalltalkParser new.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources smalltalkSourcesBig.
+!
+
+setupSmalltalkParserCompiled
+
+ configuration := PPCConfiguration universal.
+ parser := PPSmalltalkParser new compileWithConfiguration: configuration.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources smalltalkSourcesBig.
+!
+
+setupSmalltalkParserTokenized
+
+ configuration := PPCConfiguration LL1.
+ parser := PPSmalltalkParser new compileWithConfiguration: configuration.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources smalltalkSourcesBig.
+!
+
+teardownJavaSyntaxCompiled
+ parser class removeFromSystem.
+"
+ size := input inject: 0 into: [:r :e | r + e size ].
+ Transcript crShow: 'Compiled Grammar time: ', time asString.
+ Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
+"
+!
+
+teardownSmalltalkGrammarCompiled
+ parser class removeFromSystem.
+"
+ size := input inject: 0 into: [:r :e | r + e size ].
+ Transcript crShow: 'Compiled Grammar time: ', time asString.
+ Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
+"
+!
+
+teardownSmalltalkParserCompiled
+ parser class removeFromSystem.
+"
+ size := input inject: 0 into: [:r :e | r + e size ].
+ Transcript crShow: 'Compiled Grammar time: ', time asString.
+ Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
+"
! !
!PPCBenchmark class methodsFor:'documentation'!
--- a/compiler/benchmarks/PPCBenchmarkResources.st Thu Apr 30 23:43:14 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,97 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/benchmarks' }"
-
-"{ NameSpace: Smalltalk }"
-
-Object subclass:#PPCBenchmarkResources
- instanceVariableNames:''
- classVariableNames:'javaCache'
- poolDictionaries:''
- category:'PetitCompiler-Benchmarks-Core'
-!
-
-
-!PPCBenchmarkResources methodsFor:'as yet unclassified'!
-
-changesSized: size
- | string changes |
- changes := PharoFilesOpener default changesFileOrNil contents.
- string := changes copyFrom: 1 to: size.
- ^ string
-
-!
-
-javaInDirectory: directory
- | files |
- files := self readDirectory: directory.
- files := self files: files withExtension: 'java'.
-
- ^ files collect: [ :f | (FileStream fileNamed: f) contents ]
-!
-
-javaLangMath
- ^ (FileStream fileNamed: '../java-src/java/lang/Math.java') contents
-!
-
-javaSourcesBig
- ^ self javaInDirectory: '../java-src/java/util'.
- "^ self workingJavaInDirectory: '../java-src/java/util'"
-!
-
-smalltalkInDirectory: directory
- | files |
- files := self readDirectory: directory.
- files := self files: files withExtension: 'st'.
-
- ^ files collect: [ :f | (FileStream fileNamed: f) contents ]
-!
-
-smalltalkObjectMethods
- ^ Object allMethods collect: [ :m | m sourceCode ].
-!
-
-smalltalkSourcesBig
- ^ self smalltalkInDirectory: '../smalltalk-src/'
-!
-
-smalltalkSourcesBig_old
- ^ ((Smalltalk allClasses copyFrom: 1 to: 30) collect: [ :c |
- c allMethods collect: [ :m | m sourceCode ]
- ]) gather: [:each | each ].
-!
-
-workingJavaInDirectory: directory
- | sources parser |
- "return only such a files, that can be parsed by PPJavaSyntax"
-
- javaCache ifNil: [ javaCache := Dictionary new ].
-
- ^ javaCache at: directory ifAbsentPut: [
- sources := self javaInDirectory: directory.
- parser := PPJavaSyntax new.
-
- sources select: [ :source | ([parser parse: source ] on: Error do: [ PPFailure new ]) isPetitFailure not ]
- ]
-! !
-
-!PPCBenchmarkResources methodsFor:'private utilities'!
-
-files: files withExtension: extension
- ^ files select: [ :f | f extension = extension ]
-!
-
-readDirectory: directory
- | file |
- file := directory asFileReference.
- file exists ifTrue: [
- ^ file allFiles
- ].
- ^ #()
-! !
-
-!PPCBenchmarkResources class methodsFor:'documentation'!
-
-version_HG
-
- ^ '$Changeset: <not expanded> $'
-! !
-
--- a/compiler/benchmarks/abbrev.stc Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/benchmarks/abbrev.stc Sun May 10 06:28:36 2015 +0100
@@ -2,5 +2,4 @@
# this file is needed for stc to be able to compile modules independently.
# it provides information about a classes filename, category and especially namespace.
PPCBenchmark PPCBenchmark stx:goodies/petitparser/compiler/benchmarks 'PetitCompiler-Benchmarks-Core' 0
-PPCBenchmarkResources PPCBenchmarkResources stx:goodies/petitparser/compiler/benchmarks 'PetitCompiler-Benchmarks-Core' 0
stx_goodies_petitparser_compiler_benchmarks stx_goodies_petitparser_compiler_benchmarks stx:goodies/petitparser/compiler/benchmarks '* Projects & Packages *' 3
--- a/compiler/benchmarks/bc.mak Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/benchmarks/bc.mak Sun May 10 06:28:36 2015 +0100
@@ -69,7 +69,6 @@
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
$(OUTDIR)PPCBenchmark.$(O) PPCBenchmark.$(H): PPCBenchmark.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCBenchmarkResources.$(O) PPCBenchmarkResources.$(H): PPCBenchmarkResources.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)stx_goodies_petitparser_compiler_benchmarks.$(O) stx_goodies_petitparser_compiler_benchmarks.$(H): stx_goodies_petitparser_compiler_benchmarks.st $(INCLUDE_TOP)\stx\libbasic\LibraryDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProjectDefinition.$(H) $(STCHDR)
# ENDMAKEDEPEND --- do not remove this line
--- a/compiler/benchmarks/libInit.cc Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/benchmarks/libInit.cc Sun May 10 06:28:36 2015 +0100
@@ -28,7 +28,6 @@
OBJ snd; struct __vmData__ *__pRT__; {
__BEGIN_PACKAGE2__("libstx_goodies_petitparser_compiler_benchmarks", _libstx_goodies_petitparser_compiler_benchmarks_Init, "stx:goodies/petitparser/compiler/benchmarks");
_PPCBenchmark_Init(pass,__pRT__,snd);
-_PPCBenchmarkResources_Init(pass,__pRT__,snd);
_stx_137goodies_137petitparser_137compiler_137benchmarks_Init(pass,__pRT__,snd);
--- a/compiler/benchmarks/stx_goodies_petitparser_compiler_benchmarks.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/benchmarks/stx_goodies_petitparser_compiler_benchmarks.st Sun May 10 06:28:36 2015 +0100
@@ -71,10 +71,10 @@
by searching all classes (and their packages) which are referenced by my classes."
^ #(
- #'stx:goodies/petitparser' "PPContext - referenced by PPCBenchmark>>benchmarkSmalltalkGrammar"
- #'stx:goodies/petitparser/compiler' "PPCContext - referenced by PPCBenchmark>>benchmarkJavaSyntax"
+ #'stx:goodies/petitparser' "PPContext - referenced by PPCBenchmark>>benchmarkSmalltalkParser"
+ #'stx:goodies/petitparser/compiler' "PPCConfiguration - referenced by PPCBenchmark>>benchmarkSmalltalkParserCompiled"
#'stx:goodies/petitparser/parsers/java' "PPJavaSyntax - referenced by PPCBenchmark>>benchmarkJavaSyntax"
- #'stx:goodies/petitparser/parsers/smalltalk' "PPSmalltalkGrammar - referenced by PPCBenchmark>>benchmarkSmalltalkGrammar"
+ #'stx:goodies/petitparser/parsers/smalltalk' "PPSmalltalkGrammar - referenced by PPCBenchmark>>setupSmalltalkGrammar"
#'stx:goodies/refactoryBrowser/parser' "RBParser - referenced by PPCBenchmark>>benchmarkRBParserC"
)
!
@@ -100,7 +100,6 @@
^ #(
"<className> or (<className> attributes...) in load order"
PPCBenchmark
- PPCBenchmarkResources
#'stx_goodies_petitparser_compiler_benchmarks'
)
!
--- a/compiler/extensions.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/extensions.st Sun May 10 06:28:36 2015 +0100
@@ -3,237 +3,255 @@
!Character methodsFor:'*petitcompiler'!
ppcPrintable
- ^ self asInteger > 31 and: [ self asInteger < 127 ]
+ ^ self asInteger > 31 and: [ self asInteger < 127 ]
! !
!Object methodsFor:'*petitcompiler'!
isInlinedMethod
- ^ false
+ ^ false
! !
!PPActionParser methodsFor:'*petitcompiler'!
asCompilerNode
- ^ PPCActionNode new
- name: self name;
- block: block;
- child: parser;
- properties: properties;
- yourself
+ ^ PPCActionNode new
+ name: self name;
+ block: block;
+ child: parser;
+ properties: properties;
+ parser: self;
+ yourself
! !
!PPActionParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
- block isSymbol ifTrue: [
- ^ aPetitCompiler compileSymbolBlock: block for: self
- ].
- ^ aPetitCompiler compileBlock: block for: self
+ block isSymbol ifTrue: [
+ ^ aPetitCompiler compileSymbolBlock: block for: self
+ ].
+ ^ aPetitCompiler compileBlock: block for: self
! !
!PPAndParser methodsFor:'*petitcompiler'!
asCompilerNode
- ^ PPCAndNode new
- name: self name;
- child: parser;
- yourself
+ ^ PPCAndNode new
+ name: self name;
+ child: parser;
+ yourself
! !
!PPCharSetPredicate methodsFor:'*petitcompiler'!
= anObject
- self == anObject ifTrue: [ ^ true ].
- self class == anObject class ifFalse: [ ^ false ].
- ^ classification = anObject classification
+ self == anObject ifTrue: [ ^ true ].
+ self class == anObject class ifFalse: [ ^ false ].
+ ^ classification = anObject classification
! !
!PPCharSetPredicate methodsFor:'*petitcompiler'!
block
- ^ block
+ ^ block
! !
!PPCharSetPredicate methodsFor:'*petitcompiler'!
classification
- ^ classification
+ ^ classification
! !
!PPCharSetPredicate methodsFor:'*petitcompiler'!
equals: anotherPredicate
- self == anotherPredicate ifTrue: [ ^ true ].
- self class == anotherPredicate class ifFalse: [ ^ false ].
-
- ^ classification = anotherPredicate classification.
+ self == anotherPredicate ifTrue: [ ^ true ].
+ self class == anotherPredicate class ifFalse: [ ^ false ].
+
+ ^ classification = anotherPredicate classification.
! !
!PPCharSetPredicate methodsFor:'*petitcompiler'!
hash
- ^ classification hash
+ ^ classification hash
! !
!PPChoiceParser methodsFor:'*petitcompiler'!
asCompilerNode
- ^ PPCChoiceNode new
- name: self name;
- children: parsers;
- yourself
+ ^ PPCChoiceNode new
+ name: self name;
+ children: parsers;
+ parser: self;
+ yourself
! !
!PPChoiceParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
- ^ aPetitCompiler compileChoice: self
+ ^ aPetitCompiler compileChoice: self
! !
!PPContext methodsFor:'*petitcompiler'!
asCompiledParserContext
- ^ PPCContext new
- stream: stream;
- yourself
-
+ ^ PPCContext new
+ stream: stream;
+ yourself
+
! !
!PPContext methodsFor:'*petitcompiler'!
atWs
- ^ false
+ ^ false
! !
!PPContext methodsFor:'*petitcompiler'!
comment
- ^ self globalAt: #comment ifAbsent: [ nil ].
+ ^ self globalAt: #comment ifAbsent: [ nil ].
! !
!PPContext methodsFor:'*petitcompiler'!
comment: value
- ^ self globalAt: #comment put: value
+ ^ self globalAt: #comment put: value
! !
!PPContext methodsFor:'*petitcompiler'!
compiledParser
- ^ self globalAt: #compiledParser
+ ^ self globalAt: #compiledParser
! !
!PPContext methodsFor:'*petitcompiler'!
compiledParser: aPPParser
- ^ self globalAt: #compiledParser put: aPPParser
+ ^ self globalAt: #compiledParser put: aPPParser
! !
!PPContext methodsFor:'*petitcompiler'!
lwRemember
- ^ self position
+ ^ self position
! !
!PPContext methodsFor:'*petitcompiler'!
lwRestore: position
- ^ self position: position
+ ^ self position: position
! !
!PPContext methodsFor:'*petitcompiler'!
methodInvoked: whatever
- "nothing to do"
+ "nothing to do"
! !
!PPContext methodsFor:'*petitcompiler'!
peek: anInteger
- ^ stream peek: anInteger
+ ^ stream peek: anInteger
! !
!PPContext methodsFor:'*petitcompiler'!
setWs
- "nothing to do"
+ "nothing to do"
+! !
+
+!PPContext methodsFor:'*petitcompiler'!
+
+skipSeparators
+ ^ stream skipSeparators
! !
!PPContext methodsFor:'*petitcompiler'!
whitespace
- ^ self globalAt: #whitespace ifAbsent: [ nil ].
+ ^ self globalAt: #whitespace ifAbsent: [ nil ].
! !
!PPContext methodsFor:'*petitcompiler'!
whitespace: value
- ^ self globalAt: #whitespace put: value
+ ^ self globalAt: #whitespace put: value
! !
!PPDelegateParser methodsFor:'*petitcompiler'!
asCompilerNode
- self class == PPDelegateParser ifTrue: [
- ^ PPCForwardNode new
- name: self name;
- child: parser;
- yourself
- ].
- ^ super asCompilerNode
+ self class == PPDelegateParser ifTrue: [
+ ^ PPCForwardNode new
+ name: self name;
+ child: parser;
+ yourself
+ ].
+ ^ super asCompilerNode
! !
!PPDelegateParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
- (self class == PPDelegateParser) ifTrue: [
- (self name notNil and: [ parser name isNil ]) ifTrue: [
- parser name: self name.
- ^ parser compileWith: aPetitCompiler.
- ].
+ (self class == PPDelegateParser) ifTrue: [
+ (self name notNil and: [ parser name isNil ]) ifTrue: [
+ parser name: self name.
+ ^ parser compileWith: aPetitCompiler.
+ ].
- (self name notNil and: [ parser name notNil ]) ifTrue: [
- ^ aPetitCompiler compileDelegate: self.
- ]
- ].
- ^ super compileWith: aPetitCompiler.
+ (self name notNil and: [ parser name notNil ]) ifTrue: [
+ ^ aPetitCompiler compileDelegate: self.
+ ]
+ ].
+ ^ super compileWith: aPetitCompiler.
+! !
+
+!PPEndOfInputParser methodsFor:'*petitcompiler'!
+
+asCompilerNode
+
+ ^ PPCEndOfInputNode new
+ name: self name;
+ child: parser;
+ yourself
! !
!PPEpsilonParser methodsFor:'*petitcompiler'!
asCompilerNode
- ^ PPCNilNode new
+ ^ PPCNilNode new
! !
!PPEpsilonParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
- ^ aPetitCompiler compileNil
+ ^ aPetitCompiler compileNil
! !
!PPFailure methodsFor:'*petitcompiler'!
context: aPPContext
- context := aPPContext
+ context := aPPContext
! !
!PPFailure methodsFor:'*petitcompiler'!
message: text
- message := text
+ message := text
! !
!PPFailure methodsFor:'*petitcompiler'!
position: anInteger
- position := anInteger
+ position := anInteger
! !
!PPJavaWhitespaceParser methodsFor:'*petitcompiler'!
= anotherParser
- anotherParser == self ifTrue: [ ^ true ].
+ anotherParser == self ifTrue: [ ^ true ].
anotherParser class = self class ifFalse: [ ^ false ].
^ anotherParser name = self name
! !
@@ -241,67 +259,67 @@
!PPJavaWhitespaceParser methodsFor:'*petitcompiler'!
hash
- ^ self name hash
+ ^ self name hash
! !
!PPLiteralObjectParser methodsFor:'*petitcompiler'!
asCompilerNode
- ^ PPCCharacterNode new
- character: literal;
- name: self name;
- yourself
+ ^ PPCCharacterNode new
+ character: literal;
+ name: self name;
+ yourself
! !
!PPLiteralObjectParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
- ^ aPetitCompiler compileCharacter: literal.
+ ^ aPetitCompiler compileCharacter: literal.
! !
!PPLiteralParser methodsFor:'*petitcompiler'!
id
- ^ literal printString
+ ^ literal printString
! !
!PPLiteralSequenceParser methodsFor:'*petitcompiler'!
asCompilerNode
- ^ PPCLiteralNode new
- literal: literal;
- name: self name;
- yourself
+ ^ PPCLiteralNode new
+ literal: literal;
+ name: self name;
+ yourself
! !
!PPLiteralSequenceParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
- ^ aPetitCompiler compileLiteral: literal.
+ ^ aPetitCompiler compileLiteral: literal.
! !
!PPNotParser methodsFor:'*petitcompiler'!
asCompilerNode
- ^ PPCNotNode new
- child: parser;
- name: self name;
- yourself
+ ^ PPCNotNode new
+ child: parser;
+ name: self name;
+ yourself
! !
!PPNotParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
- ^ aPetitCompiler compileNot: self
+ ^ aPetitCompiler compileNot: self
! !
!PPOptionalParser methodsFor:'*petitcompiler'!
asCompilerNode
- ^ PPCOptionalNode new
- name: self name;
- child: parser;
- yourself
+ ^ PPCOptionalNode new
+ name: self name;
+ child: parser;
+ yourself
" ^ super asCompilerNode "
! !
@@ -309,264 +327,281 @@
!PPOptionalParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
- ^ aPetitCompiler compileOptional: self
+ ^ aPetitCompiler compileOptional: self
+! !
+
+!PPParser methodsFor:'*petitcompiler'!
+
+allNodesDo: aBlock seen: aSet
+ "Iterate over all the parse nodes of the receiver, do not visit and follow the ones contained in aSet."
+
+ (aSet includes: self) ifTrue: [ ^ self ].
+ aSet add: self.
+ aBlock value: self.
+
+ self children do: [ :each |
+ each allNodesDo: aBlock seen: aSet
+ ]
! !
!PPParser methodsFor:'*petitcompiler'!
asCompilerNode
- ^ PPCUnknownNode new
- parser: self;
- name: self name;
- yourself
+ ^ PPCUnknownNode new
+ parser: self;
+ name: self name;
+ yourself
! !
!PPParser methodsFor:'*petitcompiler'!
asCompilerTree
- ^ self transform: [ :p | p asCompilerNode ]
+ ^ self transform: [ :p | p asCompilerNode ]
! !
!PPParser methodsFor:'*petitcompiler'!
bridge
- ^ self
+ ^ self
! !
!PPParser methodsFor:'*petitcompiler'!
compile
- ^ self compile: PPCArguments default
+ ^ self compile: PPCArguments default
! !
!PPParser methodsFor:'*petitcompiler'!
compile: arguments
- self assert: (arguments isKindOf: PPCArguments).
-
- ^ PPCConfiguration default
- arguments: arguments;
- compile: self
+ self assert: (arguments isKindOf: PPCArguments).
+
+ ^ PPCConfiguration default
+ arguments: arguments;
+ compile: self
! !
!PPParser methodsFor:'*petitcompiler'!
compile: arguments andParse: input
- ^ (self compile: arguments) parse: input
+ ^ (self compile: arguments) parse: input
! !
!PPParser methodsFor:'*petitcompiler'!
compileAs: name
- | arguments |
- arguments := PPCArguments default.
- arguments name: name.
-
- ^ self compile: arguments
+ | arguments |
+ arguments := PPCArguments default.
+ arguments name: name.
+
+ ^ self compile: arguments
! !
!PPParser methodsFor:'*petitcompiler'!
compileWithConfiguration: configuration
- ^ configuration compile: self
+ ^ configuration compile: self
! !
!PPParser methodsFor:'*petitcompiler'!
firstSetSuchThat: block
- ^ self firstSetSuchThat: block into: (OrderedCollection new) openSet: IdentitySet new.
+ self halt: 'deprecated?'.
+ ^ self firstSetSuchThat: block into: (OrderedCollection new) openSet: IdentitySet new.
! !
!PPParser methodsFor:'*petitcompiler'!
firstSetSuchThat: block into: aCollection openSet: aSet
- (aSet includes: self) ifTrue: [ ^ aCollection ].
- aSet add: self.
-
- (block value: self) ifTrue: [aCollection add: self. ^ aCollection ].
- self children do: [ :child |
- child firstSetSuchThat: block into: aCollection openSet: aSet
- ].
- ^ aCollection
+ (aSet includes: self) ifTrue: [ ^ aCollection ].
+ aSet add: self.
+
+ (block value: self) ifTrue: [aCollection add: self. ^ aCollection ].
+ self children do: [ :child |
+ child firstSetSuchThat: block into: aCollection openSet: aSet
+ ].
+ ^ aCollection
! !
!PPParser methodsFor:'*petitcompiler'!
id
- self name ifNotNil: [ ^ self name ].
- ^ self hash asString
+ self name ifNotNil: [ ^ self name ].
+ ^ self hash asString
! !
!PPParser methodsFor:'*petitcompiler'!
isCompiled
- ^ false
+ ^ false
! !
!PPParser methodsFor:'*petitcompiler'!
isContextFree
- ^ self propertyAt: #isContextFree ifAbsentPut:
- [ self allParsers allSatisfy: [ :p | p isContextFreePrim ] ].
-
+ ^ self propertyAt: #isContextFree ifAbsentPut:
+ [ self allParsers allSatisfy: [ :p | p isContextFreePrim ] ].
+
! !
!PPParser methodsFor:'*petitcompiler'!
isContextFreePrim
- ^ true
+ ^ true
! !
!PPParser methodsFor:'*petitcompiler'!
isToken
- ^ false
+ ^ false
! !
!PPParser methodsFor:'*petitcompiler'!
isTokenParser
- ^ false
+ ^ false
! !
!PPParser methodsFor:'*petitcompiler'!
javaToken
- | ws |
- ws := PPJavaWhitespaceParser new.
- ^ ((ws, ((PPTokenParser on: self) tokenClass: PPJavaToken; yourself), ws) ==> #second)
- propertyAt: #'trimmingToken' put: true;
- yourself
+ | ws |
+ ws := PPJavaWhitespaceParser new.
+ ^ ((ws, ((PPTokenParser on: self) tokenClass: PPJavaToken; yourself), ws) ==> #second)
+ propertyAt: #'trimmingToken' put: true;
+ yourself
! !
!PPParser methodsFor:'*petitcompiler'!
optimize
- ^ self copy
+ ^ self copy
! !
!PPParser methodsFor:'*petitcompiler'!
optimized
- ^ self copy
+ ^ self copy
! !
!PPParser methodsFor:'*petitcompiler'!
trimmingToken
- | ws |
- ws := #space asParser star.
- ^ ((ws, (PPTokenParser on: self), ws) ==> #second)
- propertyAt: #trimmingToken put: true;
- yourself
+ | ws |
+ ws := #space asParser star.
+ ^ ((ws, (PPTokenParser on: self), ws) ==> #second)
+ propertyAt: #trimmingToken put: true;
+ yourself
! !
!PPPluggableParser methodsFor:'*petitcompiler'!
acceptsEpsilon
- ^ true
+ ^ true
! !
!PPPluggableParser methodsFor:'*petitcompiler'!
asCompilerNode
- ^ PPCPluggableNode new
- block: block;
- name: self name;
- yourself
+ ^ PPCPluggableNode new
+ block: block;
+ name: self name;
+ yourself
! !
!PPPossessiveRepeatingParser methodsFor:'*petitcompiler'!
asCompilerNode
- ((self min = 0) and: [ self max = SmallInteger maxVal ]) ifTrue: [
- ^ PPCStarNode new
- name: self name;
- child: parser;
- yourself
- ].
+ ((self min = 0) and: [ self max = SmallInteger maxVal ]) ifTrue: [
+ ^ PPCStarNode new
+ name: self name;
+ child: parser;
+ parser: self;
+ yourself
+ ].
- ((self min = 1) and: [ self max = SmallInteger maxVal ]) ifTrue: [
- ^ PPCPlusNode new
- name: self name;
- child: parser;
- yourself
- ].
- ^ super asCompilerNode
+ ((self min = 1) and: [ self max = SmallInteger maxVal ]) ifTrue: [
+ ^ PPCPlusNode new
+ name: self name;
+ child: parser;
+ parser: self;
+ yourself
+ ].
+ ^ super asCompilerNode
! !
!PPPossessiveRepeatingParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
- ((self min = 1) and: [ self max = SmallInteger maxVal ]) ifTrue: [
- ^ aPetitCompiler compilePlus: self.
- ].
- ((self min = 0) and: [ self max = SmallInteger maxVal ]) ifTrue: [
- ^ aPetitCompiler compileStar: self.
- ].
+ ((self min = 1) and: [ self max = SmallInteger maxVal ]) ifTrue: [
+ ^ aPetitCompiler compilePlus: self.
+ ].
+ ((self min = 0) and: [ self max = SmallInteger maxVal ]) ifTrue: [
+ ^ aPetitCompiler compileStar: self.
+ ].
- ^ super compileWith: aPetitCompiler.
+ ^ super compileWith: aPetitCompiler.
! !
!PPPredicateObjectParser methodsFor:'*petitcompiler'!
asCompilerNode
- ^ PPCPredicateNode new
- name: self name;
- predicate: predicate;
- yourself
+ ^ PPCPredicateNode new
+ name: self name;
+ predicate: predicate;
+ yourself
! !
!PPPredicateObjectParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
- (predicateMessage = 'input expected') ifTrue: [
- ^ aPetitCompiler compileAny.
- ].
- ^ aPetitCompiler compilePredicate: predicate.
+ (predicateMessage = 'input expected') ifTrue: [
+ ^ aPetitCompiler compileAny.
+ ].
+ ^ aPetitCompiler compilePredicate: predicate.
! !
!PPPredicateObjectParser methodsFor:'*petitcompiler'!
firstCharSet
- ^ predicate
+ ^ predicate
! !
!PPPredicateObjectParser methodsFor:'*petitcompiler'!
firstCharSetCached
- ^ predicate
+ ^ predicate
! !
!PPSequenceParser methodsFor:'*petitcompiler'!
asCompilerNode
- ^ PPCSequenceNode new
- children: parsers;
- name: self name;
- properties: properties;
- yourself
+ ^ PPCSequenceNode new
+ children: parsers;
+ name: self name;
+ properties: properties;
+ yourself
! !
!PPSequenceParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
- ^ aPetitCompiler compileSequence: self.
+ ^ aPetitCompiler compileSequence: self.
! !
!PPSequenceParser methodsFor:'*petitcompiler'!
firstSetSuchThat: block into: aCollection openSet: aSet
- (aSet includes: self) ifTrue: [ ^ aCollection ].
- aSet add: self.
-
- (block value: self) ifTrue: [ aCollection add: self. ^ aCollection ].
-
- self children do: [ :child |
- child firstSetSuchThat: block into: aCollection openSet: aSet.
- child acceptsEpsilon ifFalse: [ ^ aCollection ]
- ].
- ^ aCollection
+ (aSet includes: self) ifTrue: [ ^ aCollection ].
+ aSet add: self.
+
+ (block value: self) ifTrue: [ aCollection add: self. ^ aCollection ].
+
+ self children do: [ :child |
+ child firstSetSuchThat: block into: aCollection openSet: aSet.
+ child acceptsEpsilon ifFalse: [ ^ aCollection ]
+ ].
+ ^ aCollection
! !
!PPSmalltalkGrammar methodsFor:'*petitcompiler'!
@@ -578,182 +613,189 @@
!PPSmalltalkGrammar methodsFor:'*petitcompiler'!
whitespace
- ^ #space asParser plus
+ ^ #space asParser plus
! !
!PPSmalltalkTokenParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
- ^ aPetitCompiler compileSmalltalkToken: self.
+ ^ aPetitCompiler compileSmalltalkToken: self.
! !
!PPSmalltalkTokenParser methodsFor:'*petitcompiler'!
parseOnX: aPPContext
- | memento comments token |
+ | memento comments token |
- memento := aPPContext remember.
- comments := self
- parseComments: #()
- on: aPPContext.
- token := super parseOn: aPPContext.
- token isPetitFailure ifTrue: [
- aPPContext restore: memento.
- ^ token ].
- comments := self
- parseComments: comments
- on: aPPContext.
- ^ token comments: comments
+ memento := aPPContext remember.
+ comments := self
+ parseComments: #()
+ on: aPPContext.
+ token := super parseOn: aPPContext.
+ token isPetitFailure ifTrue: [
+ aPPContext restore: memento.
+ ^ token ].
+ comments := self
+ parseComments: comments
+ on: aPPContext.
+ ^ token comments: comments
! !
!PPSmalltalkTokenParser methodsFor:'*petitcompiler'!
whitespace
- ^ PPSmalltalkWhitespaceParser new
+ ^ PPSmalltalkWhitespaceParser new
! !
!PPSmalltalkWhitespaceParser methodsFor:'*petitcompiler'!
= anotherParser
- anotherParser == self ifTrue: [ ^ true ].
- anotherParser class = self class ifFalse: [ ^ false ].
+ anotherParser == self ifTrue: [ ^ true ].
+ anotherParser class = self class ifFalse: [ ^ false ].
^ anotherParser name = self name
! !
!PPSmalltalkWhitespaceParser methodsFor:'*petitcompiler'!
acceptsEpsilon
- ^ true
+ ^ true
! !
!PPSmalltalkWhitespaceParser methodsFor:'*petitcompiler'!
acceptsEpsilonOpenSet: set
- ^ true
+ ^ true
! !
!PPSmalltalkWhitespaceParser methodsFor:'*petitcompiler'!
firstCharSet
- ^ PPCharSetPredicate on: [:e | false ]
+ ^ PPCharSetPredicate on: [:e | false ]
+! !
+
+!PPSmalltalkWhitespaceParser methodsFor:'*petitcompiler'!
+
+hash
+ ^ self name hash
! !
!PPStream methodsFor:'*petitcompiler'!
peek: anInteger
- | endPosition |
- endPosition := position + anInteger min: readLimit.
- ^ collection copyFrom: position+1 to: endPosition.
+ | endPosition |
+ endPosition := position + anInteger min: readLimit.
+ ^ collection copyFrom: position+1 to: endPosition.
! !
!PPToken methodsFor:'*petitcompiler'!
= anObject
- ^ self class = anObject class and: [ self inputValue = anObject inputValue ]
+ ^ self class = anObject class and: [ self inputValue = anObject inputValue ]
! !
!PPToken methodsFor:'*petitcompiler'!
hash
- ^ self inputValue hash
+ ^ self inputValue hash
! !
!PPToken methodsFor:'*petitcompiler'!
isToken
- ^ true
+ ^ true
! !
!PPTokenParser methodsFor:'*petitcompiler'!
asCompilerNode
- ^ PPCTokenNode new
- name: self name;
- tokenClass: self tokenClass;
- child: parser;
- yourself
+ ^ PPCTokenNode new
+ name: self name;
+ tokenClass: self tokenClass;
+ child: parser;
+ yourself
! !
!PPTokenParser methodsFor:'*petitcompiler'!
displayName
- ^ 'TOKEN[', parser displayName, ']'
+ ^ 'TOKEN[', parser displayName, ']'
! !
!PPTokenParser methodsFor:'*petitcompiler'!
isFirstSetTerminal
- ^ false
+ ^ false
! !
!PPTokenParser methodsFor:'*petitcompiler'!
isTokenParser
- ^ true
+ ^ true
! !
!PPTokenParser methodsFor:'*petitcompiler'!
optimize
- ^ self transform: [ :each | each optimized ]
+ ^ self transform: [ :each | each optimized ]
! !
!PPTokenParser methodsFor:'*petitcompiler'!
parser
- ^ parser
+ ^ parser
! !
!PPTokenParser methodsFor:'*petitcompiler'!
startsWith: aCharacter
- ^ self first anySatisfy: [ :first | first startsWith: aCharacter ]
+ ^ self first anySatisfy: [ :first | first startsWith: aCharacter ]
! !
!PPTokenParser methodsFor:'*petitcompiler'!
whitespace
- ^ self class whitespace
+ ^ self class whitespace
! !
!PPTrimmingParser methodsFor:'*petitcompiler'!
asCompilerNode
- ^ PPCTrimNode new
- child: parser;
- name: self name;
- yourself
+ ^ PPCTrimNode new
+ child: parser;
+ name: self name;
+ parser: self;
+ yourself
! !
!UndefinedObject methodsFor:'*petitcompiler'!
asInteger
- ^ 256
+ ^ 256
! !
!UndefinedObject methodsFor:'*petitcompiler'!
isAlphaNumeric
- ^ false
+ ^ false
! !
!UndefinedObject methodsFor:'*petitcompiler'!
isDigit
- ^ false
+ ^ false
! !
!UndefinedObject methodsFor:'*petitcompiler'!
isLetter
- ^ false
+ ^ false
! !
!UndefinedObject methodsFor:'*petitcompiler'!
isSeparator
- ^ false
+ ^ false
! !
!stx_goodies_petitparser_compiler class methodsFor:'documentation'!
--- a/compiler/libInit.cc Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/libInit.cc Sun May 10 06:28:36 2015 +0100
@@ -31,6 +31,8 @@
_PPCBridge_Init(pass,__pRT__,snd);
_PPCCompiledMethod_Init(pass,__pRT__,snd);
_PPCCompiler_Init(pass,__pRT__,snd);
+_PPCCompilerTokenRememberStrategy_Init(pass,__pRT__,snd);
+_PPCCompilerTokenizingRememberStrategy_Init(pass,__pRT__,snd);
_PPCConfiguration_Init(pass,__pRT__,snd);
_PPCContext_Init(pass,__pRT__,snd);
_PPCContextMemento_Init(pass,__pRT__,snd);
@@ -38,6 +40,7 @@
_PPCMethod_Init(pass,__pRT__,snd);
_PPCNode_Init(pass,__pRT__,snd);
_PPCNodeVisitor_Init(pass,__pRT__,snd);
+_PPCPluggableConfiguration_Init(pass,__pRT__,snd);
_PPCompiledParser_Init(pass,__pRT__,snd);
_stx_137goodies_137petitparser_137compiler_Init(pass,__pRT__,snd);
_PPCAbstractCharacterNode_Init(pass,__pRT__,snd);
@@ -47,23 +50,27 @@
_PPCCodeGenerator_Init(pass,__pRT__,snd);
_PPCDelegateNode_Init(pass,__pRT__,snd);
_PPCEndOfFileNode_Init(pass,__pRT__,snd);
-_PPCFirstPrototype_Init(pass,__pRT__,snd);
_PPCInlinedMethod_Init(pass,__pRT__,snd);
_PPCInliningVisitor_Init(pass,__pRT__,snd);
+_PPCLL1Configuration_Init(pass,__pRT__,snd);
_PPCListNode_Init(pass,__pRT__,snd);
_PPCNilNode_Init(pass,__pRT__,snd);
-_PPCPluggableConfiguration_Init(pass,__pRT__,snd);
_PPCPluggableNode_Init(pass,__pRT__,snd);
_PPCProfilingContext_Init(pass,__pRT__,snd);
_PPCRewritingVisitor_Init(pass,__pRT__,snd);
+_PPCTokenizingCompiler_Init(pass,__pRT__,snd);
+_PPCUniversalConfiguration_Init(pass,__pRT__,snd);
_PPCUnknownNode_Init(pass,__pRT__,snd);
+_PPTokenizingCompiledParser_Init(pass,__pRT__,snd);
_PPCAbstractActionNode_Init(pass,__pRT__,snd);
_PPCAndNode_Init(pass,__pRT__,snd);
_PPCCharSetPredicateNode_Init(pass,__pRT__,snd);
_PPCCharacterNode_Init(pass,__pRT__,snd);
_PPCChoiceNode_Init(pass,__pRT__,snd);
_PPCCopyVisitor_Init(pass,__pRT__,snd);
+_PPCEndOfInputNode_Init(pass,__pRT__,snd);
_PPCForwardNode_Init(pass,__pRT__,snd);
+_PPCLL1Visitor_Init(pass,__pRT__,snd);
_PPCLiteralNode_Init(pass,__pRT__,snd);
_PPCMergingVisitor_Init(pass,__pRT__,snd);
_PPCMessagePredicateNode_Init(pass,__pRT__,snd);
@@ -72,27 +79,34 @@
_PPCNotLiteralNode_Init(pass,__pRT__,snd);
_PPCNotMessagePredicateNode_Init(pass,__pRT__,snd);
_PPCNotNode_Init(pass,__pRT__,snd);
-_PPCOptimizingVisitor_Init(pass,__pRT__,snd);
+_PPCOptimizeChoices_Init(pass,__pRT__,snd);
_PPCOptionalNode_Init(pass,__pRT__,snd);
_PPCPlusNode_Init(pass,__pRT__,snd);
_PPCPredicateNode_Init(pass,__pRT__,snd);
+_PPCRecognizerComponentDetector_Init(pass,__pRT__,snd);
+_PPCRecognizerComponentVisitor_Init(pass,__pRT__,snd);
_PPCSentinelNode_Init(pass,__pRT__,snd);
_PPCSequenceNode_Init(pass,__pRT__,snd);
+_PPCSpecializingVisitor_Init(pass,__pRT__,snd);
_PPCStarNode_Init(pass,__pRT__,snd);
_PPCTokenConsumeNode_Init(pass,__pRT__,snd);
_PPCTokenDetector_Init(pass,__pRT__,snd);
_PPCTokenNode_Init(pass,__pRT__,snd);
_PPCTokenVisitor_Init(pass,__pRT__,snd);
+_PPCTokenWhitespaceNode_Init(pass,__pRT__,snd);
_PPCTokenizingCodeGenerator_Init(pass,__pRT__,snd);
-_PPCTrimNode_Init(pass,__pRT__,snd);
+_PPCTokenizingParserNode_Init(pass,__pRT__,snd);
+_PPCTokenizingVisitor_Init(pass,__pRT__,snd);
_PPCTrimmingTokenNode_Init(pass,__pRT__,snd);
_PPCActionNode_Init(pass,__pRT__,snd);
-_PPCLLChoiceNode_Init(pass,__pRT__,snd);
+_PPCDeterministicChoiceNode_Init(pass,__pRT__,snd);
+_PPCRecognizingSequenceNode_Init(pass,__pRT__,snd);
_PPCStarAnyNode_Init(pass,__pRT__,snd);
_PPCStarCharSetPredicateNode_Init(pass,__pRT__,snd);
_PPCStarMessagePredicateNode_Init(pass,__pRT__,snd);
_PPCSymbolActionNode_Init(pass,__pRT__,snd);
-_PPCTokenSequenceNode_Init(pass,__pRT__,snd);
+_PPCTokenChoiceNode_Init(pass,__pRT__,snd);
+_PPCTrimNode_Init(pass,__pRT__,snd);
_PPCTokenStarMessagePredicateNode_Init(pass,__pRT__,snd);
_PPCTokenStarSeparatorNode_Init(pass,__pRT__,snd);
--- a/compiler/stx_goodies_petitparser_compiler.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/stx_goodies_petitparser_compiler.st Sun May 10 06:28:36 2015 +0100
@@ -16,16 +16,15 @@
"The last merged version is: "
^ '
- Name: PetitCompiler-JanKurs.71
+ Name: PetitCompiler-JanKurs.111
Author: JanKurs
- Time: 18-11-2014, 09:48:35.425 AM
- UUID: 06352c33-3c76-4382-8536-0cc48e225117
+ Time: 08-05-2015, 05:56:05.327 PM
+ UUID: 8805e696-9933-49b8-a5c8-a963b931b996
Repository: http://smalltalkhub.com/mc/JanKurs/PetitParser/main
-
'
"Created: / 03-10-2014 / 02:27:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 21-11-2014 / 12:40:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 10-05-2015 / 06:20:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
monticelloName
@@ -112,6 +111,8 @@
PPCBridge
PPCCompiledMethod
PPCCompiler
+ PPCCompilerTokenRememberStrategy
+ PPCCompilerTokenizingRememberStrategy
PPCConfiguration
PPCContext
PPCContextMemento
@@ -119,6 +120,7 @@
PPCMethod
PPCNode
PPCNodeVisitor
+ PPCPluggableConfiguration
PPCompiledParser
#'stx_goodies_petitparser_compiler'
PPCAbstractCharacterNode
@@ -128,23 +130,27 @@
PPCCodeGenerator
PPCDelegateNode
PPCEndOfFileNode
- PPCFirstPrototype
PPCInlinedMethod
PPCInliningVisitor
+ PPCLL1Configuration
PPCListNode
PPCNilNode
- PPCPluggableConfiguration
PPCPluggableNode
PPCProfilingContext
PPCRewritingVisitor
+ PPCTokenizingCompiler
+ PPCUniversalConfiguration
PPCUnknownNode
+ PPTokenizingCompiledParser
PPCAbstractActionNode
PPCAndNode
PPCCharSetPredicateNode
PPCCharacterNode
PPCChoiceNode
PPCCopyVisitor
+ PPCEndOfInputNode
PPCForwardNode
+ PPCLL1Visitor
PPCLiteralNode
PPCMergingVisitor
PPCMessagePredicateNode
@@ -153,27 +159,34 @@
PPCNotLiteralNode
PPCNotMessagePredicateNode
PPCNotNode
- PPCOptimizingVisitor
+ PPCOptimizeChoices
PPCOptionalNode
PPCPlusNode
PPCPredicateNode
+ PPCRecognizerComponentDetector
+ PPCRecognizerComponentVisitor
PPCSentinelNode
PPCSequenceNode
+ PPCSpecializingVisitor
PPCStarNode
PPCTokenConsumeNode
PPCTokenDetector
PPCTokenNode
PPCTokenVisitor
+ PPCTokenWhitespaceNode
PPCTokenizingCodeGenerator
- PPCTrimNode
+ PPCTokenizingParserNode
+ PPCTokenizingVisitor
PPCTrimmingTokenNode
PPCActionNode
- PPCLLChoiceNode
+ PPCDeterministicChoiceNode
+ PPCRecognizingSequenceNode
PPCStarAnyNode
PPCStarCharSetPredicateNode
PPCStarMessagePredicateNode
PPCSymbolActionNode
- PPCTokenSequenceNode
+ PPCTokenChoiceNode
+ PPCTrimNode
PPCTokenStarMessagePredicateNode
PPCTokenStarSeparatorNode
)
@@ -285,6 +298,10 @@
PPParser compileAs:
PPParser compileWithConfiguration:
PPParser javaToken
+ PPContext skipSeparators
+ PPEndOfInputParser asCompilerNode
+ PPParser allNodesDo:seen:
+ PPSmalltalkWhitespaceParser hash
)
! !
--- a/compiler/tests/Make.proto Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/Make.proto Sun May 10 06:28:36 2015 +0100
@@ -34,7 +34,7 @@
# add the path(es) here:,
# ********** OPTIONAL: MODIFY the next lines ***
# LOCALINCLUDES=-Ifoo -Ibar
-LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/compiler -I$(INCLUDE_TOP)/stx/goodies/petitparser/compiler/benchmarks -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
+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/tests -I$(INCLUDE_TOP)/stx/goodies/sunit -I$(INCLUDE_TOP)/stx/libbasic
# if you need any additional defines for embedded C code,
@@ -109,7 +109,6 @@
cd ../../../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
cd ../../../sunit && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
cd ../../tests && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../parsers/java && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
@@ -136,21 +135,24 @@
$(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)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)PPCLL1OptimizingTest.$(O) PPCLL1OptimizingTest.$(H): PPCLL1OptimizingTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLL1Test.$(O) PPCLL1Test.$(H): PPCLL1Test.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)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)PPCMergingVisitorTest.$(O) PPCMergingVisitorTest.$(H): PPCMergingVisitorTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCMockCompiler.$(O) PPCMockCompiler.$(H): PPCMockCompiler.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(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)PPCOptimizingTest.$(O) PPCOptimizingTest.$(H): PPCOptimizingTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCOptimizingVisitorTest.$(O) PPCOptimizingVisitorTest.$(H): PPCOptimizingVisitorTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCProtype1Test.$(O) PPCProtype1Test.$(H): PPCProtype1Test.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)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)PPCPrototype1OptimizingTest.$(O) PPCPrototype1OptimizingTest.$(H): PPCPrototype1OptimizingTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCPrototype1Test.$(O) PPCPrototype1Test.$(H): PPCPrototype1Test.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)PPCSpecializingVisitorTest.$(O) PPCSpecializingVisitorTest.$(H): PPCSpecializingVisitorTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenDetectorTest.$(O) PPCTokenDetectorTest.$(H): PPCTokenDetectorTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCTokenVisitorTest.$(O) PPCTokenVisitorTest.$(H): PPCTokenVisitorTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenizingCodeGeneratorTest.$(O) PPCTokenizingCodeGeneratorTest.$(H): PPCTokenizingCodeGeneratorTest.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)PPCVerificationTest.$(O) PPCVerificationTest.$(H): PPCVerificationTest.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)PPCTokenizingVisitorTest.$(O) PPCTokenizingVisitorTest.$(H): PPCTokenizingVisitorTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCompiledExpressionGrammarResource.$(O) PPCompiledExpressionGrammarResource.$(H): PPCompiledExpressionGrammarResource.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestResource.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCompiledExpressionGrammarTest.$(O) PPCompiledExpressionGrammarTest.$(H): PPCompiledExpressionGrammarTest.st $(INCLUDE_TOP)/stx/goodies/petitparser/tests/PPAbstractParserTest.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/tests/PPCompositeParserTest.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCompiledJavaResource.$(O) PPCompiledJavaResource.$(H): PPCompiledJavaResource.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestResource.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCompiledSmalltalkGrammarResource.$(O) PPCompiledSmalltalkGrammarResource.$(H): PPCompiledSmalltalkGrammarResource.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestResource.$(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)PPExpressionGrammarTest.$(O) PPExpressionGrammarTest.$(H): PPExpressionGrammarTest.st $(INCLUDE_TOP)/stx/goodies/petitparser/tests/PPAbstractParserTest.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/tests/PPCompositeParserTest.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)stx_goodies_petitparser_compiler_tests.$(O) stx_goodies_petitparser_compiler_tests.$(H): stx_goodies_petitparser_compiler_tests.st $(INCLUDE_TOP)/stx/libbasic/LibraryDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProjectDefinition.$(H) $(STCHDR)
--- a/compiler/tests/Make.spec Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/Make.spec Sun May 10 06:28:36 2015 +0100
@@ -58,21 +58,24 @@
PPCCopyVisitorTest \
PPCGuardTest \
PPCInliningVisitorTest \
+ PPCLL1OptimizingTest \
+ PPCLL1Test \
+ PPCLL1VisitorTest \
PPCMergingVisitorTest \
PPCMockCompiler \
PPCNodeFirstFollowNextTests \
PPCNodeTest \
- PPCOptimizingTest \
- PPCOptimizingVisitorTest \
- PPCProtype1Test \
+ PPCOptimizeChoicesTest \
+ PPCPrototype1OptimizingTest \
+ PPCPrototype1Test \
+ PPCRecognizerComponentDetectorTest \
+ PPCRecognizerComponentVisitorTest \
+ PPCSpecializingVisitorTest \
PPCTokenDetectorTest \
- PPCTokenVisitorTest \
PPCTokenizingCodeGeneratorTest \
- PPCVerificationTest \
+ PPCTokenizingVisitorTest \
PPCompiledExpressionGrammarResource \
PPCompiledExpressionGrammarTest \
- PPCompiledJavaResource \
- PPCompiledSmalltalkGrammarResource \
PPExpressionGrammar \
PPExpressionGrammarTest \
stx_goodies_petitparser_compiler_tests \
@@ -88,21 +91,24 @@
$(OUTDIR_SLASH)PPCCopyVisitorTest.$(O) \
$(OUTDIR_SLASH)PPCGuardTest.$(O) \
$(OUTDIR_SLASH)PPCInliningVisitorTest.$(O) \
+ $(OUTDIR_SLASH)PPCLL1OptimizingTest.$(O) \
+ $(OUTDIR_SLASH)PPCLL1Test.$(O) \
+ $(OUTDIR_SLASH)PPCLL1VisitorTest.$(O) \
$(OUTDIR_SLASH)PPCMergingVisitorTest.$(O) \
$(OUTDIR_SLASH)PPCMockCompiler.$(O) \
$(OUTDIR_SLASH)PPCNodeFirstFollowNextTests.$(O) \
$(OUTDIR_SLASH)PPCNodeTest.$(O) \
- $(OUTDIR_SLASH)PPCOptimizingTest.$(O) \
- $(OUTDIR_SLASH)PPCOptimizingVisitorTest.$(O) \
- $(OUTDIR_SLASH)PPCProtype1Test.$(O) \
+ $(OUTDIR_SLASH)PPCOptimizeChoicesTest.$(O) \
+ $(OUTDIR_SLASH)PPCPrototype1OptimizingTest.$(O) \
+ $(OUTDIR_SLASH)PPCPrototype1Test.$(O) \
+ $(OUTDIR_SLASH)PPCRecognizerComponentDetectorTest.$(O) \
+ $(OUTDIR_SLASH)PPCRecognizerComponentVisitorTest.$(O) \
+ $(OUTDIR_SLASH)PPCSpecializingVisitorTest.$(O) \
$(OUTDIR_SLASH)PPCTokenDetectorTest.$(O) \
- $(OUTDIR_SLASH)PPCTokenVisitorTest.$(O) \
$(OUTDIR_SLASH)PPCTokenizingCodeGeneratorTest.$(O) \
- $(OUTDIR_SLASH)PPCVerificationTest.$(O) \
+ $(OUTDIR_SLASH)PPCTokenizingVisitorTest.$(O) \
$(OUTDIR_SLASH)PPCompiledExpressionGrammarResource.$(O) \
$(OUTDIR_SLASH)PPCompiledExpressionGrammarTest.$(O) \
- $(OUTDIR_SLASH)PPCompiledJavaResource.$(O) \
- $(OUTDIR_SLASH)PPCompiledSmalltalkGrammarResource.$(O) \
$(OUTDIR_SLASH)PPExpressionGrammar.$(O) \
$(OUTDIR_SLASH)PPExpressionGrammarTest.$(O) \
$(OUTDIR_SLASH)stx_goodies_petitparser_compiler_tests.$(O) \
--- a/compiler/tests/PPCCodeGeneratorTest.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPCCodeGeneratorTest.st Sun May 10 06:28:36 2015 +0100
@@ -3,7 +3,8 @@
"{ NameSpace: Smalltalk }"
PPAbstractParserTest subclass:#PPCCodeGeneratorTest
- instanceVariableNames:'visitor node result compiler parser context arguments'
+ instanceVariableNames:'visitor node result compiler parser context configuration
+ arguments'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Tests-Visitors'
@@ -12,311 +13,354 @@
!PPCCodeGeneratorTest methodsFor:'as yet unclassified'!
context
- ^ context := PPCProfilingContext new
+ ^ context := PPCProfilingContext new
!
setUp
- arguments := PPCArguments default
- profile: true;
- yourself.
-
- compiler := PPCCompiler new.
- compiler arguments: arguments.
+ arguments := PPCArguments default
+ profile: true;
+ codeGenerator: PPCCodeGenerator.
+
+ configuration := PPCPluggableConfiguration on: [ :_self |
+ _self cacheFirstFollow.
+ _self generate.
+ ].
+ configuration arguments: arguments.
+
+
+ compiler := PPCCompiler new.
+ compiler arguments: arguments.
- visitor := PPCCodeGenerator new.
- visitor compiler: compiler.
- visitor arguments: arguments.
+ visitor := PPCCodeGenerator new.
+ visitor compiler: compiler.
+ visitor arguments: arguments.
!
tearDown
- | class |
+ | class |
- class := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]).
- class notNil ifTrue:[
- class removeFromSystem
- ].
+ class := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]).
+ class notNil ifTrue:[
+ class removeFromSystem
+ ].
! !
!PPCCodeGeneratorTest methodsFor:'generating'!
compileTree: root
-
- | configuration |
-
-
- configuration := PPCPluggableConfiguration on: [ :_self |
- result := (visitor visit: _self ir).
-
- compiler compileParser.
- compiler compiledParser startSymbol: result methodName.
- parser := compiler compiledParser new.
- _self ir: parser
- ].
- parser := configuration compile: root arguments: arguments.
-
+ parser := configuration compile: root.
+
! !
!PPCCodeGeneratorTest methodsFor:'testing'!
assert: whatever parse: input
- result := super assert: whatever parse: input.
+ result := super assert: whatever parse: input.
!
testActionNode
- node := PPCActionNode new
- block: [ :res | res collect: [:each | each asUppercase ]];
- child: #letter asParser plus asCompilerTree;
- yourself.
-
- self compileTree: node.
-
- self assert: parser parse: 'foo' to: { $F . $O . $O}.
- self assert: parser parse: 'bar' to: { $B . $A . $R}.
- self assert: parser fail: ''.
+ node := PPCActionNode new
+ block: [ :res | res collect: [:each | each asUppercase ]];
+ child: #letter asParser plus asCompilerTree;
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser parse: 'foo' to: { $F . $O . $O}.
+ self assert: parser parse: 'bar' to: { $B . $A . $R}.
+ self assert: parser fail: ''.
!
testAnyNode
- node := PPCForwardNode new
- child: PPCAnyNode new;
- yourself.
- self compileTree: node.
+ node := PPCForwardNode new
+ child: PPCAnyNode new;
+ yourself.
+ self compileTree: node.
- self assert: parser class methodDictionary size = 2.
+ self assert: parser class methodDictionary size = 2.
- self assert: parser parse: 'a' to: $a.
- self assert: parser parse: '_' to: $_.
- self assert: parser parse: Character cr asString to: Character cr.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: '_' to: $_.
+ self assert: parser parse: Character cr asString to: Character cr.
"Modified: / 23-04-2015 / 12:43:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testAnyNode2
- node := PPCForwardNode new
- child: (PPCAnyNode new markForInline; yourself);
- yourself.
+ node := PPCForwardNode new
+ child: (PPCAnyNode new markForInline; yourself);
+ yourself.
- self compileTree: node.
+ self compileTree: node.
- self assert: parser class methodDictionary size = 1.
+ self assert: parser class methodDictionary size = 1.
- self assert: parser parse: 'a' to: $a.
- self assert: parser parse: '_' to: $_.
- self assert: parser parse: Character cr asString to: Character cr.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: '_' to: $_.
+ self assert: parser parse: Character cr asString to: Character cr.
"Modified: / 23-04-2015 / 12:43:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testCharSetPredicateNode
- | charNode |
- charNode := PPCCharSetPredicateNode new
- predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
- yourself.
- node := PPCForwardNode new
- child: charNode;
- yourself.
-
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 2.
-
- self assert: parser parse: 'a' to: $a.
- self assert: parser fail: 'b'.
+ | charNode |
+ charNode := PPCCharSetPredicateNode new
+ predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
+ yourself.
+ node := PPCForwardNode new
+ child: charNode;
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 2.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: 'b'.
!
testCharSetPredicateNode2
- | charNode |
- charNode := PPCCharSetPredicateNode new
- predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
- markForInline;
- yourself.
- node := PPCForwardNode new
- child: charNode;
- yourself.
-
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 1.
+ | charNode |
+ charNode := PPCCharSetPredicateNode new
+ predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
+ markForInline;
+ yourself.
+ node := PPCForwardNode new
+ child: charNode;
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
- self assert: parser parse: 'a' to: $a.
- self assert: context invocationCount = 1.
+ self assert: parser parse: 'a' to: $a.
+ self assert: context invocationCount = 1.
- self assert: parser fail: 'b'.
+ self assert: parser fail: 'b'.
!
testCharacterNode
- | charNode |
- charNode := PPCCharacterNode new
- character: $a; yourself.
- node := PPCForwardNode new
- child: charNode; yourself.
- self compileTree: node.
-
- self assert: result class == PPCMethod.
-
- self assert: parser class methodDictionary size = 2.
- self assert: parser parse: 'a' to: $a.
- self assert: parser fail: 'b'.
+ | charNode |
+ charNode := PPCCharacterNode new
+ character: $a; yourself.
+ node := PPCForwardNode new
+ child: charNode; yourself.
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 2.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: 'b'.
!
testCharacterNode2
- node := (PPCCharacterNode new character: $#; yourself).
- self compileTree: node.
+ node := (PPCCharacterNode new character: $#; yourself).
+ self compileTree: node.
- self assert: parser parse: '#'
+ self assert: parser parse: '#'
!
testCharacterNode3
- node := PPCCharacterNode new character: Character lf; yourself.
- self compileTree: node.
+ node := PPCCharacterNode new character: Character lf; yourself.
+ self compileTree: node.
- self assert: parser parse: String lf.
+ self assert: parser parse: String lf.
!
testCharacterNode4
- | charNode |
- charNode := PPCCharacterNode new
- character: $a;
- markForInline;
- yourself.
- node := PPCForwardNode new
- child: charNode; yourself.
-
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 1.
- self assert: parser parse: 'a' to: $a.
- self assert: parser fail: 'b'.
+ | charNode |
+ charNode := PPCCharacterNode new
+ character: $a;
+ markForInline;
+ yourself.
+ node := PPCForwardNode new
+ child: charNode; yourself.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: 'b'.
+!
+
+testCharacterNode5
+ | charNode |
+ charNode := PPCCharacterNode new
+ character: $';
+ markForInline;
+ yourself.
+ node := PPCForwardNode new
+ child: charNode; yourself.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+ self assert: parser parse: '''' to: $'.
+ self assert: parser fail: 'a'.
+!
+
+testCharacterNode6
+ | charNode |
+ charNode := PPCCharacterNode new
+ character: $";
+ markForInline;
+ yourself.
+ node := PPCForwardNode new
+ child: charNode; yourself.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+ self assert: parser parse: '"' to: $".
+ self assert: parser fail: 'a'.
!
testChoiceNode
- node := PPCChoiceNode new
- children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode };
- yourself.
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 3.
-
- self assert: parser parse: '1' to: $1.
- self assert: parser parse: 'a' to: $a.
- self assert: parser fail: '_'.
+ node := PPCChoiceNode new
+ children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode };
+ yourself.
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 3.
+
+ self assert: parser parse: '1' to: $1.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: '_'.
!
testChoiceNode2
- | digitNode letterNode |
- digitNode := PPCMessagePredicateNode new
- message: #isDigit;
- markForInline;
- yourself.
+ | digitNode letterNode |
+ digitNode := PPCMessagePredicateNode new
+ message: #isDigit;
+ markForInline;
+ yourself.
- letterNode := PPCMessagePredicateNode new
- message: #isLetter;
- markForInline;
- yourself.
+ letterNode := PPCMessagePredicateNode new
+ message: #isLetter;
+ markForInline;
+ yourself.
- node := PPCChoiceNode new
- children: { digitNode . letterNode };
- yourself.
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 1.
-
- self assert: parser parse: '1' to: $1.
- self assert: parser parse: 'a' to: $a.
- self assert: parser fail: '_'.
+ node := PPCChoiceNode new
+ children: { digitNode . letterNode };
+ yourself.
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+
+ self assert: parser parse: '1' to: $1.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: '_'.
+!
+
+testEndOfInputNode
+ | letterNode |
+ letterNode := PPCMessagePredicateNode new
+ message: #isLetter;
+ yourself.
+ node := PPCEndOfInputNode new
+ child: letterNode;
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 2.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: 'bc' end: 1.
+ self assert: parser fail: ''.
!
testForwardNode
- | letterNode forwardNode |
- letterNode := PPCMessagePredicateNode new
- message: #isLetter;
- yourself.
- forwardNode := PPCForwardNode new
- child: letterNode;
- yourself.
- node := PPCForwardNode new
- child: forwardNode;
- yourself.
-
- self compileTree: node.
+ | letterNode forwardNode |
+ letterNode := PPCMessagePredicateNode new
+ message: #isLetter;
+ yourself.
+ forwardNode := PPCForwardNode new
+ child: letterNode;
+ yourself.
+ node := PPCForwardNode new
+ child: forwardNode;
+ yourself.
+
+ self compileTree: node.
- self assert: parser class methodDictionary size = 3.
-
- self assert: parser parse: 'a' to: $a.
- self assert: parser parse: 'bc' to: $b end: 1.
- self assert: parser fail: ''.
+ self assert: parser class methodDictionary size = 3.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: 'bc' to: $b end: 1.
+ self assert: parser fail: ''.
!
testForwardNode2
- | letterNode forwardNode |
- letterNode := PPCMessagePredicateNode new
- message: #isLetter;
- markForInline;
- yourself.
+ | letterNode forwardNode |
+ letterNode := PPCMessagePredicateNode new
+ message: #isLetter;
+ markForInline;
+ yourself.
- forwardNode := PPCForwardNode new
- child: letterNode;
- yourself.
- node := PPCForwardNode new
- child: forwardNode;
- yourself.
+ forwardNode := PPCForwardNode new
+ child: letterNode;
+ yourself.
+ node := PPCForwardNode new
+ child: forwardNode;
+ yourself.
-
- self compileTree: node.
+
+ self compileTree: node.
- self assert: parser class methodDictionary size = 2.
-
- self assert: parser parse: 'a' to: $a.
- self assert: parser parse: 'bc' to: $b end: 1.
- self assert: parser fail: ''.
+ self assert: parser class methodDictionary size = 2.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: 'bc' to: $b end: 1.
+ self assert: parser fail: ''.
!
testForwardNode3
- | letterNode forwardNode |
- letterNode := PPCMessagePredicateNode new
- message: #isLetter;
- yourself.
- forwardNode := PPCForwardNode new
- child: letterNode;
- markForInline;
- yourself.
- node := PPCForwardNode new
- child: forwardNode;
- yourself.
+ | letterNode forwardNode |
+ letterNode := PPCMessagePredicateNode new
+ message: #isLetter;
+ yourself.
+ forwardNode := PPCForwardNode new
+ child: letterNode;
+ markForInline;
+ yourself.
+ node := PPCForwardNode new
+ child: forwardNode;
+ yourself.
-
- self compileTree: node.
+
+ self compileTree: node.
- self assert: parser class methodDictionary size = 2.
-
- self assert: parser parse: 'a' to: $a.
- self assert: parser parse: 'bc' to: $b end: 1.
- self assert: parser fail: ''.
+ self assert: parser class methodDictionary size = 2.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: 'bc' to: $b end: 1.
+ self assert: parser fail: ''.
!
testForwardNode4
- | letterNode forwardNode |
- letterNode := PPCMessagePredicateNode new
- message: #isLetter;
- markForInline;
- yourself.
+ | letterNode forwardNode |
+ letterNode := PPCMessagePredicateNode new
+ message: #isLetter;
+ markForInline;
+ yourself.
- forwardNode := PPCForwardNode new
- child: letterNode;
- markForInline;
- yourself.
- node := PPCForwardNode new
- child: forwardNode;
- yourself.
+ forwardNode := PPCForwardNode new
+ child: letterNode;
+ markForInline;
+ yourself.
+ node := PPCForwardNode new
+ child: forwardNode;
+ yourself.
-
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 1.
-
- self assert: parser parse: 'a' to: $a.
- self assert: parser parse: 'bc' to: $b end: 1.
- self assert: parser fail: ''.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: 'bc' to: $b end: 1.
+ self assert: parser fail: ''.
!
testInlinePluggableNode
@@ -339,553 +383,555 @@
!
testLiteralNode
- node := PPCLiteralNode new
- literal: 'foo';
- yourself.
- self compileTree: node.
-
- self assert: result class == PPCMethod.
- self assert: result methodName = 'lit_0'.
-
- self assert: parser class methodDictionary size = 1.
- self assert: parser parse: 'foo' to: 'foo'.
- self assert: parser parse: 'foobar' to: 'foo' end: 3.
- self assert: parser fail: 'boo'.
+ node := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+ self assert: (parser class methodDictionary includesKey: #lit_0).
+ self assert: parser parse: 'foo' to: 'foo'.
+ self assert: parser parse: 'foobar' to: 'foo' end: 3.
+ self assert: parser fail: 'boo'.
!
testLiteralNode2
- node := PPCLiteralNode new
- literal: '''''';
- yourself.
- self compileTree: node.
-
- self assert: parser parse: '''''' to: ''''''.
+ node := PPCLiteralNode new
+ literal: '''''';
+ yourself.
+ self compileTree: node.
+
+ self assert: parser parse: '''''' to: ''''''.
!
testLiteralNode3
- | literalNode |
- literalNode := PPCLiteralNode new
- literal: 'foo';
- markForInline;
- yourself.
- node := PPCForwardNode new
- child: literalNode;
- yourself.
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 1.
- self assert: parser parse: 'foo' to: 'foo'.
- self assert: parser parse: 'foobar' to: 'foo' end: 3.
- self assert: parser fail: 'boo'.
+ | literalNode |
+ literalNode := PPCLiteralNode new
+ literal: 'foo';
+ markForInline;
+ yourself.
+ node := PPCForwardNode new
+ child: literalNode;
+ yourself.
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+ self assert: parser parse: 'foo' to: 'foo'.
+ self assert: parser parse: 'foobar' to: 'foo' end: 3.
+ self assert: parser fail: 'boo'.
!
testMessagePredicate
- | messageNode |
- messageNode := PPCMessagePredicateNode new
- message: #isDigit;
- yourself.
- node := PPCForwardNode new
- child: messageNode;
- yourself.
-
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 2.
- self assert: parser parse: '1' to: $1 end: 1.
- self assert: context invocationCount = 2.
-
- self assert: parser fail: 'a'.
- self assert: parser fail: ''.
+ | messageNode |
+ messageNode := PPCMessagePredicateNode new
+ message: #isDigit;
+ yourself.
+ node := PPCForwardNode new
+ child: messageNode;
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 2.
+ self assert: parser parse: '1' to: $1 end: 1.
+ self assert: context invocationCount = 2.
+
+ self assert: parser fail: 'a'.
+ self assert: parser fail: ''.
!
testMessagePredicate2
- | messageNode |
- messageNode := PPCMessagePredicateNode new
- message: #isDigit;
- markForInline;
- yourself.
- node := PPCForwardNode new
- child: messageNode;
- yourself.
-
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 1.
- self assert: parser parse: '1' to: $1 end: 1.
- self assert: context invocationCount = 1.
-
- self assert: parser fail: 'a'.
- self assert: parser fail: ''.
+ | messageNode |
+ messageNode := PPCMessagePredicateNode new
+ message: #isDigit;
+ markForInline;
+ yourself.
+ node := PPCForwardNode new
+ child: messageNode;
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+ self assert: parser parse: '1' to: $1 end: 1.
+ self assert: context invocationCount = 1.
+
+ self assert: parser fail: 'a'.
+ self assert: parser fail: ''.
!
testNilNode
- | nilNode |
- nilNode := PPCNilNode new.
- node := PPCForwardNode new child: nilNode; yourself.
- self compileTree: node.
-
- self assert: result class = PPCMethod.
-
- self assert: parser class methodDictionary size = 2.
- self assert: parser parse: 'a' to: nil end: 0.
- self assert: parser parse: '' to: nil end: 0.
+ | nilNode |
+ nilNode := PPCNilNode new.
+ node := PPCForwardNode new child: nilNode; yourself.
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 2.
+ self assert: parser parse: 'a' to: nil end: 0.
+ self assert: parser parse: '' to: nil end: 0.
!
testNilNode2
- | nilNode |
- nilNode := PPCNilNode new markForInline; yourself.
- node := PPCForwardNode new child: nilNode; yourself.
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 1.
- self assert: parser parse: 'a' to: nil end: 0.
- self assert: parser parse: '' to: nil end: 0.
+ | nilNode |
+ nilNode := PPCNilNode new markForInline; yourself.
+ node := PPCForwardNode new child: nilNode; yourself.
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+ self assert: parser parse: 'a' to: nil end: 0.
+ self assert: parser parse: '' to: nil end: 0.
!
testNotCharSetPredicateNode
- | charNode |
- charNode := PPCNotCharSetPredicateNode new
- predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
- yourself.
- node := PPCForwardNode new
- child: charNode; yourself.
-
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 2.
- self assert: parser parse: 'b' to: nil end: 0.
- self assert: context invocationCount = 2.
-
- self assert: parser fail: 'a'.
- self assert: parser parse: '' to: nil end: 0.
+ | charNode |
+ charNode := PPCNotCharSetPredicateNode new
+ predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
+ yourself.
+ node := PPCForwardNode new
+ child: charNode; yourself.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 2.
+ self assert: parser parse: 'b' to: nil end: 0.
+ self assert: context invocationCount = 2.
+
+ self assert: parser fail: 'a'.
+ self assert: parser parse: '' to: nil end: 0.
!
testNotCharSetPredicateNode2
- | charNode |
- charNode := PPCNotCharSetPredicateNode new
- predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
- markForInline;
- yourself.
- node := PPCForwardNode new
- child: charNode; yourself.
+ | charNode |
+ charNode := PPCNotCharSetPredicateNode new
+ predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
+ markForInline;
+ yourself.
+ node := PPCForwardNode new
+ child: charNode; yourself.
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 1.
- self assert: parser parse: 'b' to: nil end: 0.
- self assert: context invocationCount = 1.
-
- self assert: parser fail: 'a'.
- self assert: parser parse: '' to: nil end: 0.
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+ self assert: parser parse: 'b' to: nil end: 0.
+ self assert: context invocationCount = 1.
+
+ self assert: parser fail: 'a'.
+ self assert: parser parse: '' to: nil end: 0.
!
testNotLiteralNode
- | literalNode |
- literalNode := PPCNotLiteralNode new
- literal: 'foo';
- yourself.
- node := PPCForwardNode new
- child: literalNode; yourself.
+ | literalNode |
+ literalNode := PPCNotLiteralNode new
+ literal: 'foo';
+ yourself.
+ node := PPCForwardNode new
+ child: literalNode; yourself.
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 2.
- self assert: parser parse: 'bar' to: nil end: 0.
- self assert: context invocationCount = 2.
-
- self assert: parser fail: 'foo'.
- self assert: parser parse: '' to: nil end: 0.
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 2.
+ self assert: parser parse: 'bar' to: nil end: 0.
+ self assert: context invocationCount = 2.
+
+ self assert: parser fail: 'foo'.
+ self assert: parser parse: '' to: nil end: 0.
!
testNotLiteralNode2
- | literalNode |
- literalNode := PPCNotLiteralNode new
- literal: 'foo';
- markForInline;
- yourself.
- node := PPCForwardNode new
- child: literalNode; yourself.
+ | literalNode |
+ literalNode := PPCNotLiteralNode new
+ literal: 'foo';
+ markForInline;
+ yourself.
+ node := PPCForwardNode new
+ child: literalNode; yourself.
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 1.
- self assert: parser parse: 'bar' to: nil end: 0.
- self assert: context invocationCount = 1.
-
- self assert: parser fail: 'foo'.
- self assert: parser parse: '' to: nil end: 0.
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+ self assert: parser parse: 'bar' to: nil end: 0.
+ self assert: context invocationCount = 1.
+
+ self assert: parser fail: 'foo'.
+ self assert: parser parse: '' to: nil end: 0.
!
testNotMessagePredicateNode
- | messageNode |
- messageNode := PPCNotMessagePredicateNode new
- message: #isDigit;
- yourself.
- node := PPCForwardNode new
- child: messageNode;
- yourself.
-
-
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 2.
- self assert: parser parse: 'a' to: nil end: 0.
- self assert: context invocationCount = 2.
-
- self assert: parser fail: '1'.
- self assert: parser parse: '' to: nil end: 0.
+ | messageNode |
+ messageNode := PPCNotMessagePredicateNode new
+ message: #isDigit;
+ yourself.
+ node := PPCForwardNode new
+ child: messageNode;
+ yourself.
+
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 2.
+ self assert: parser parse: 'a' to: nil end: 0.
+ self assert: context invocationCount = 2.
+
+ self assert: parser fail: '1'.
+ self assert: parser parse: '' to: nil end: 0.
!
testNotMessagePredicateNode2
- | messageNode |
- messageNode := PPCNotMessagePredicateNode new
- message: #isDigit;
- markForInline;
- yourself.
- node := PPCForwardNode new
- child: messageNode;
- yourself.
-
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 1.
- self assert: parser parse: 'a' to: nil end: 0.
- self assert: context invocationCount = 1.
-
- self assert: parser fail: '1'.
- self assert: parser parse: '' to: nil end: 0.
+ | messageNode |
+ messageNode := PPCNotMessagePredicateNode new
+ message: #isDigit;
+ markForInline;
+ yourself.
+ node := PPCForwardNode new
+ child: messageNode;
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+ self assert: parser parse: 'a' to: nil end: 0.
+ self assert: context invocationCount = 1.
+
+ self assert: parser fail: '1'.
+ self assert: parser parse: '' to: nil end: 0.
!
testNotNode
- node := PPCNotNode new
- child: #digit asParser asCompilerNode;
- yourself.
-
- self compileTree: node.
-
- self assert: parser parse: 'a' to: nil end: 0.
- self assert: parser fail: '1'.
- self assert: parser parse: '' to: nil end: 0.
+ node := PPCNotNode new
+ child: #digit asParser asCompilerNode;
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser parse: 'a' to: nil end: 0.
+ self assert: parser fail: '1'.
+ self assert: parser parse: '' to: nil end: 0.
!
testOptionalNode
- node := PPCOptionalNode new
- child: ($a asParser asCompilerNode);
- yourself.
- self compileTree: node.
-
- self assert: parser parse: 'b' to: nil end: 0.
- self assert: parser parse: 'a' to: $a.
- self assert: parser parse: '' to: nil end: 0.
+ node := PPCOptionalNode new
+ child: ($a asParser asCompilerNode);
+ yourself.
+ self compileTree: node.
+
+ self assert: parser parse: 'b' to: nil end: 0.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: '' to: nil end: 0.
!
testPluggableNode
- node := PPCPluggableNode new
- block: [:ctx | ctx next ];
- yourself.
- self compileTree: node.
-
- self assert: parser parse: 'foo' to: $f end: 1.
- self assert: parser parse: 'bar' to: $b end: 1.
- self assert: parser parse: '' to: nil.
+ node := PPCPluggableNode new
+ block: [:ctx | ctx next ];
+ yourself.
+ self compileTree: node.
+
+ self assert: parser parse: 'foo' to: $f end: 1.
+ self assert: parser parse: 'bar' to: $b end: 1.
+ self assert: parser parse: '' to: nil.
!
testPlusNode
- node := PPCPlusNode new
- child: ($a asParser asCompilerNode);
- yourself.
-
- self compileTree: node.
- self assert: result class = PPCMethod.
-
- self assert: parser parse: 'aaa' to: #($a $a $a) end: 3.
- self assert: parser parse: 'ab' to: #( $a ) end: 1.
- self assert: parser fail: 'b'.
+ node := PPCPlusNode new
+ child: ($a asParser asCompilerNode);
+ yourself.
+
+ self compileTree: node.
+
+
+ self assert: parser class methodDictionary size = 2.
+ self assert: parser parse: 'aaa' to: #($a $a $a) end: 3.
+ self assert: parser parse: 'ab' to: #( $a ) end: 1.
+ self assert: parser fail: 'b'.
!
testPlusNode2
- node := PPCPlusNode new
- child: (#letter asParser asCompilerNode markForInline);
- yourself.
-
- self compileTree: node.
- self assert: result class = PPCMethod.
-
- self assert: parser parse: 'abc' to: #($a $b $c) end: 3.
- self assert: parser parse: 'ab1' to: #( $a $b ) end: 2.
- self assert: parser fail: '1'.
+ node := PPCPlusNode new
+ child: (#letter asParser asCompilerNode markForInline);
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+ self assert: parser parse: 'abc' to: #($a $b $c) end: 3.
+ self assert: parser parse: 'ab1' to: #( $a $b ) end: 2.
+ self assert: parser fail: '1'.
!
testPredicateNode
- | predicateNode |
- predicateNode := PPCPredicateNode new
- predicate: (PPCharSetPredicate on: [ :e | e isDigit ]);
- yourself.
- node := PPCForwardNode new
- child: predicateNode;
- yourself.
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 2.
- self assert: parser parse: '1' to: $1 end: 1.
- self assert: context invocationCount = 2.
-
- self assert: parser fail: 'a'.
- self assert: parser fail: ''.
+ | predicateNode |
+ predicateNode := PPCPredicateNode new
+ predicate: (PPCharSetPredicate on: [ :e | e isDigit ]);
+ yourself.
+ node := PPCForwardNode new
+ child: predicateNode;
+ yourself.
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 2.
+ self assert: parser parse: '1' to: $1 end: 1.
+ self assert: context invocationCount = 2.
+
+ self assert: parser fail: 'a'.
+ self assert: parser fail: ''.
!
testPredicateNode2
- | predicateNode |
- predicateNode := PPCPredicateNode new
- predicate: (PPCharSetPredicate on: [ :e | e isDigit ]);
- markForInline;
- yourself.
- node := PPCForwardNode new
- child: predicateNode;
- yourself.
+ | predicateNode |
+ predicateNode := PPCPredicateNode new
+ predicate: (PPCharSetPredicate on: [ :e | e isDigit ]);
+ markForInline;
+ yourself.
+ node := PPCForwardNode new
+ child: predicateNode;
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+ self assert: parser parse: '1' to: $1 end: 1.
+ self assert: context invocationCount = 1.
+
+ self assert: parser fail: 'a'.
+ self assert: parser fail: ''.
+!
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 1.
- self assert: parser parse: '1' to: $1 end: 1.
- self assert: context invocationCount = 1.
-
- self assert: parser fail: 'a'.
- self assert: parser fail: ''.
+testRecognizingSequenceNode
+ | letterNode |
+ letterNode := PPCMessagePredicateNode new
+ message: #isLetter;
+ yourself.
+
+ node := PPCRecognizingSequenceNode new
+ children: { letterNode };
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 2.
+ self assert: parser parse: 'a'.
+ self assert: parser fail: '1'.
+!
+
+testRecognizingSequenceNode2
+ | letterNode |
+ letterNode := PPCMessagePredicateNode new
+ message: #isLetter;
+ markForInline;
+ yourself.
+
+ node := PPCRecognizingSequenceNode new
+ children: { letterNode };
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+ self assert: parser parse: 'a'.
+ self assert: parser fail: '1'.
!
testSequenceNode
- node := PPCSequenceNode new
- children: { $a asParser asCompilerNode .
- $b asParser asCompilerNode .
- $c asParser asCompilerNode };
- yourself.
- self compileTree: node.
-
- self assert: parser parse: 'abc' to: #($a $b $c) end: 3.
- self assert: parser parse: 'abcd' to: #( $a $b $c ) end: 3.
- self assert: parser fail: 'ab'.
+ node := PPCSequenceNode new
+ children: { $a asParser asCompilerNode .
+ $b asParser asCompilerNode .
+ $c asParser asCompilerNode };
+ yourself.
+ self compileTree: node.
+
+ self assert: parser parse: 'abc' to: #($a $b $c) end: 3.
+ self assert: parser parse: 'abcd' to: #( $a $b $c ) end: 3.
+ self assert: parser fail: 'ab'.
!
testStarAnyNode
- node := PPCStarAnyNode new
- child: PPCNilNode new;
- yourself.
- self compileTree: node.
-
- self assert: parser parse: 'abc' to: #($a $b $c).
- self assert: parser parse: 'a' to: #($a).
- self assert: parser parse: '' to: #().
+ arguments cacheFirstFollow: false.
+ node := PPCStarAnyNode new
+ child: PPCNilNode new;
+ yourself.
+ self compileTree: node.
+
+ self assert: parser parse: 'abc' to: #($a $b $c).
+ self assert: parser parse: 'a' to: #($a).
+ self assert: parser parse: '' to: #().
!
testStarCharSetPredicateNode
- node := PPCStarCharSetPredicateNode new
- predicate: (PPCharSetPredicate on: [:e | e = $a ]);
- child: PPCSentinelNode new;
- yourself.
-
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 1.
- self assert: parser parse: 'aaa1' to: #( $a $a $a) end: 3.
- self assert: context invocationCount = 1.
- self assert: parser parse: 'bba' to: #() end: 0.
- self assert: context invocationCount = 1.
-
+ arguments cacheFirstFollow: false.
+ node := PPCStarCharSetPredicateNode new
+ predicate: (PPCharSetPredicate on: [:e | e = $a ]);
+ child: PPCSentinelNode new;
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+ self assert: parser parse: 'aaa1' to: #( $a $a $a) end: 3.
+ self assert: context invocationCount = 1.
+ self assert: parser parse: 'bba' to: #() end: 0.
+ self assert: context invocationCount = 1.
+
!
testStarMessagePredicateNode
- node := PPCStarMessagePredicateNode new
- message: #isLetter;
- child: PPCSentinelNode new;
- yourself.
-
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 1.
- self assert: parser parse: 'abc1' to: #( $a $b $c) end: 3.
- self assert: context invocationCount = 1.
-
- self assert: parser parse: '123a' to: #() end: 0.
- self assert: context invocationCount = 1.
-
+ arguments cacheFirstFollow: false.
+ node := PPCStarMessagePredicateNode new
+ message: #isLetter;
+ child: PPCSentinelNode new;
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+ self assert: parser parse: 'abc1' to: #( $a $b $c) end: 3.
+ self assert: context invocationCount = 1.
+
+ self assert: parser parse: '123a' to: #() end: 0.
+ self assert: context invocationCount = 1.
+
!
testStarNode
- node := PPCStarNode new
- child: ($a asParser asCompilerNode);
- yourself.
-
- self compileTree: node.
-
- self assert: parser parse: 'aaa' to: #($a $a $a) end: 3.
- self assert: parser parse: 'ab' to: #( $a ) end: 1.
- self assert: parser parse: 'b' to: #( ) end: 0.
+ node := PPCStarNode new
+ child: ($a asParser asCompilerNode);
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser parse: 'aaa' to: #($a $a $a) end: 3.
+ self assert: parser parse: 'ab' to: #( $a ) end: 1.
+ self assert: parser parse: 'b' to: #( ) end: 0.
!
testSymbolActionNode
- node := PPCSymbolActionNode new
- block: #second;
- child: #letter asParser plus asCompilerTree;
- yourself.
-
- self compileTree: node.
-
- self assert: parser parse: 'foo' to: $o.
- self assert: parser parse: 'bar' to: $a.
- self assert: parser fail: ''.
+ node := PPCSymbolActionNode new
+ block: #second;
+ child: #letter asParser plus asCompilerTree;
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser parse: 'foo' to: $o.
+ self assert: parser parse: 'bar' to: $a.
+ self assert: parser fail: ''.
!
testTokenNode
- node := PPCTokenNode new
- child: #letter asParser plus asCompilerTree;
- tokenClass: PPToken;
- yourself.
-
- self compileTree: node.
-
- self assert: parser parse: 'abc'.
- self assert: result class = PPToken.
- self assert: result inputValue = 'abc'.
-
- self assert: parser fail: '1a'.
-!
+ node := PPCTokenNode new
+ child: #letter asParser plus asCompilerTree;
+ tokenClass: PPToken;
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser parse: 'abc'.
+ self assert: result class = PPToken.
+ self assert: result inputValue = 'abc'.
-testTokenSequenceNode
- | letterNode |
- letterNode := PPCMessagePredicateNode new
- message: #isLetter;
- yourself.
-
- node := PPCTokenSequenceNode new
- children: { letterNode };
- yourself.
-
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 2.
- self assert: parser parse: 'a'.
- self assert: parser fail: '1'.
-!
-
-testTokenSequenceNode2
- | letterNode |
- letterNode := PPCMessagePredicateNode new
- message: #isLetter;
- markForInline;
- yourself.
-
- node := PPCTokenSequenceNode new
- children: { letterNode };
- yourself.
-
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 1.
- self assert: parser parse: 'a'.
- self assert: parser fail: '1'.
+ self assert: parser fail: '1a'.
!
testTokenStarMessagePredicateNode
-
- node := PPCTokenStarMessagePredicateNode new
- message: #isLetter;
- child: PPCSentinelNode new;
- yourself.
-
- arguments guards: false.
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 1.
-
- self assert: parser parse: 'foo' to: parser.
- self assert: context invocationCount = 1.
- self assert: context lwRememberCount = 0.
- self assert: context lwRestoreCount = 0.
- self assert: context rememberCount = 0.
-
- self assert: parser parse: 'foo123' to: parser end: 3.
+
+ node := PPCTokenStarMessagePredicateNode new
+ message: #isLetter;
+ child: PPCSentinelNode new;
+ yourself.
+ arguments cacheFirstFollow: false.
+ arguments guards: false.
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+
+ self assert: parser parse: 'foo' to: parser.
+ self assert: context invocationCount = 1.
+ self assert: context lwRememberCount = 0.
+ self assert: context lwRestoreCount = 0.
+ self assert: context rememberCount = 0.
+
+ self assert: parser parse: 'foo123' to: parser end: 3.
!
testTokenStarSeparatorNode
-
- | starNode |
- starNode := PPCTokenStarSeparatorNode new
- message: #isSeparator;
- child: PPCSentinelNode new;
- yourself.
- node := PPCForwardNode new
- child: starNode;
- yourself.
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 2.
-
- self assert: parser parse: ' a' to: parser end: 3.
- self assert: context invocationCount = 2.
-
+
+ | starNode |
+ starNode := PPCTokenStarSeparatorNode new
+ message: #isSeparator;
+ child: PPCSentinelNode new;
+ yourself.
+ node := PPCForwardNode new
+ child: starNode;
+ yourself.
+ arguments cacheFirstFollow: false.
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 2.
+
+ self assert: parser parse: ' a' to: parser end: 3.
+ self assert: context invocationCount = 2.
+
!
testTokenStarSeparatorNode2
-
- | starNode |
- starNode := PPCTokenStarSeparatorNode new
- message: #isSeparator;
- child: PPCSentinelNode new;
- markForInline;
- yourself.
- node := PPCForwardNode new
- child: starNode;
- yourself.
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 1.
-
- self assert: parser parse: ' a' to: context end: 3.
- self assert: context invocationCount = 1.
-
+
+ | starNode |
+ starNode := PPCTokenStarSeparatorNode new
+ message: #isSeparator;
+ child: PPCSentinelNode new;
+ markForInline;
+ yourself.
+ node := PPCForwardNode new
+ child: starNode;
+ yourself.
+ arguments cacheFirstFollow: false.
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 1.
+
+ self assert: parser parse: ' a' to: context end: 3.
+ self assert: context invocationCount = 1.
+
!
testTrimNode
- node := PPCTrimNode new
- child: #letter asParser asCompilerNode;
- yourself.
-
- self compileTree: node.
-
- self assert: parser parse: ' a '.
- self assert: parser fail: ' 1 '.
+ node := PPCTrimNode new
+ child: #letter asParser asCompilerNode;
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser parse: ' a '.
+ self assert: parser fail: ' 1 '.
!
testTrimmingTokenNode
- node := PPCTrimmingTokenNode new
- child: #letter asParser plus asCompilerTree;
- tokenClass: PPToken;
- whitespace: #space asParser star asCompilerTree;
- yourself.
-
- self compileTree: node.
-
- self assert: parser parse: 'abc'.
- self assert: result class = PPToken.
- self assert: result inputValue = 'abc'.
+ node := PPCTrimmingTokenNode new
+ child: #letter asParser plus asCompilerTree;
+ tokenClass: PPToken;
+ whitespace: #space asParser star asCompilerTree;
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser parse: 'abc'.
+ self assert: result class = PPToken.
+ self assert: result inputValue = 'abc'.
- self assert: parser parse: ' abc '.
- self assert: result class = PPToken.
- self assert: result inputValue = 'abc'.
+ self assert: parser parse: ' abc '.
+ self assert: result class = PPToken.
+ self assert: result inputValue = 'abc'.
- self assert: parser fail: '1a'.
+ self assert: parser fail: '1a'.
!
testUnknownNode
- node := PPCUnknownNode new
- parser: [:ctx | ctx next ] asParser;
- yourself.
- self compileTree: node.
-
- self assert: parser parse: 'foo' to: $f end: 1.
- self assert: parser parse: 'bar' to: $b end: 1.
- self assert: parser parse: '' to: nil.
+ node := PPCUnknownNode new
+ parser: [:ctx | ctx next ] asParser;
+ yourself.
+ self compileTree: node.
+
+ self assert: parser parse: 'foo' to: $f end: 1.
+ self assert: parser parse: 'bar' to: $b end: 1.
+ self assert: parser parse: '' to: nil.
! !
--- a/compiler/tests/PPCCompilerTest.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPCCompilerTest.st Sun May 10 06:28:36 2015 +0100
@@ -14,217 +14,184 @@
!PPCCompilerTest methodsFor:'as yet unclassified'!
assert: p parse: whatever
- ^ result := super assert: p parse: whatever.
+ ^ result := super assert: p parse: whatever.
!
context
- ^ context := PPCProfilingContext new
+ ^ context := PPCProfilingContext new
!
setUp
- arguments := PPCArguments default
- profile: true;
- yourself.
-
- configuration := PPCFirstPrototype new
- arguments: arguments;
- yourself.
+ arguments := PPCArguments default
+ profile: true;
+ yourself.
+
+ configuration := PPCUniversalConfiguration new
+ arguments: arguments;
+ yourself.
!
tearDown
- | parserClass |
-
- parserClass := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]).
- parserClass notNil ifTrue:[
- parserClass removeFromSystem
- ].
-! !
-
-!PPCCompilerTest methodsFor:'tests - first set'!
-
-testFirstSetSuchThat
- | a b fs at |
- a := $a asParser.
- at := a trim.
- b := $b asParser.
- parser := b optional, at.
- fs := parser firstSetSuchThat: [ :e | (e isKindOf: PPTrimmingParser) or: [ e isTerminal ] ].
- self assert: (fs anySatisfy: [ :e | e = at ]).
- self assert: (fs anySatisfy: [ :e | e = b ]).
- self assert: (fs noneSatisfy: [ :e | e = a ]).
-!
+ | parserClass |
-testFirstSetSuchThat2
- | a b fs at bt |
- a := $a asParser optional.
- at := a trim.
- b := $b asParser.
- bt := b trim.
- parser := at, bt.
- fs := parser firstSetSuchThat: [ :e | (e isKindOf: PPTrimmingParser) or: [ e isTerminal ] ].
- self assert: (fs anySatisfy: [ :e | e = at ]).
- self assert: (fs anySatisfy: [ :e | e = bt ]).
- self assert: fs size = 2.
-!
-
-testFirstSetSuchThat3
- | a b c fs at bt ct |
- a := $a asParser optional.
- at := a trim.
- b := $b asParser.
- bt := b trim.
- c := $c asParser.
- ct := c trim.
-
- parser := (at, bt optional) wrapped, at, ct.
- fs := parser firstSetSuchThat: [ :e | (e isKindOf: PPTrimmingParser) or: [ e isTerminal ] ].
- self assert: (fs anySatisfy: [ :e | e = at ]).
- self assert: (fs anySatisfy: [ :e | e = bt ]).
- self assert: (fs anySatisfy: [ :e | e = ct ]).
- self assert: fs size = 3.
+ parserClass := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]).
+ parserClass notNil ifTrue:[
+ parserClass removeFromSystem
+ ].
! !
!PPCCompilerTest methodsFor:'tests - guard'!
testChoiceGuard
- parser := ('foo' asParser trimmingToken / 'bar' asParser trimmingToken / $d asParser trimmingToken plus)
- compileWithConfiguration: configuration.
-
- self assert: parser parse: 'foo'.
- self assert: result inputValue = 'foo'.
- self assert: (context invocations anySatisfy: [ :e | e beginsWith: 'token' ]).
+ parser := ('foo' asParser trimmingToken / 'bar' asParser trimmingToken / $d asParser trimmingToken plus)
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+ self assert: (context invocations anySatisfy: [ :e | e beginsWith: 'token' ]).
- self assert: parser parse: 'bar'.
- self assert: result inputValue = 'bar'.
+ self assert: parser parse: 'bar'.
+ self assert: result inputValue = 'bar'.
- self assert: parser parse: ' foo'.
- self assert: result inputValue = 'foo'.
+ self assert: parser parse: ' foo'.
+ self assert: result inputValue = 'foo'.
- self assert: parser parse: ' d'.
- self assert: result first inputValue = 'd'.
+ self assert: parser parse: ' d'.
+ self assert: result first inputValue = 'd'.
- self assert: parser fail: ''.
- self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'predicate' ]).
- self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]).
+ self assert: parser fail: ''.
+ self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'predicate' ]).
+ self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]).
- self assert: parser fail: 'zorg'.
- self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]).
+ self assert: parser fail: 'zorg'.
+ self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]).
!
testEmptyChoiceGuard
- parser := ('foo' asParser trimmingToken / 'bar' asParser trimmingToken / $d asParser trimmingToken star)
- compileWithConfiguration: configuration.
-
- self assert: parser parse: 'foo'.
- self assert: result inputValue = 'foo'.
+ parser := ('foo' asParser trimmingToken / 'bar' asParser trimmingToken / $d asParser trimmingToken star)
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
- self assert: parser parse: 'bar'.
- self assert: result inputValue = 'bar'.
+ self assert: parser parse: 'bar'.
+ self assert: result inputValue = 'bar'.
- self assert: parser parse: ' foo'.
- self assert: result inputValue = 'foo'.
+ self assert: parser parse: ' foo'.
+ self assert: result inputValue = 'foo'.
- self assert: parser parse: ' d'.
- self assert: result first inputValue = 'd'.
+ self assert: parser parse: ' d'.
+ self assert: result first inputValue = 'd'.
- self assert: parser parse: ''.
+ self assert: parser parse: ''.
- self assert: parser parse: 'zorg' end: 0.
+ self assert: parser parse: 'zorg' end: 0.
!
testGuardSmalltlakToken
- parser := (#letter asParser, #word asParser star) smalltalkToken compileWithConfiguration: configuration.
-
- self assert: parser parse: 'bar'.
- self assert: (context invocations anySatisfy: [ :e | e beginsWith: 'seq' ]).
-
- self assert: parser fail: '123'.
- self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'seq' ]).
+ parser := (#letter asParser, #word asParser star) smalltalkToken compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'bar'.
+ self assert: (context invocations anySatisfy: [ :e | e beginsWith: 'seq' ]).
+
+ self assert: parser fail: '123'.
+ self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'seq' ]).
!
testSequenceGuard
- parser := ((#any asParser, #any asParser) wrapped, (#any asParser, #any asParser)) compileWithConfiguration: configuration.
-
- self assert: parser parse: 'fooo' to: #(#($f $o) #($o $o)).
- self assert: parser parse: 'fo oo' to: #(#($f $o) #($ $o)) end: 4.
- self assert: parser fail: 'fo'.
-
+ parser := ((#any asParser, #any asParser) wrapped, (#any asParser, #any asParser)) compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'fooo' to: #(#($f $o) #($o $o)).
+ self assert: parser parse: 'fo oo' to: #(#($f $o) #($ $o)) end: 4.
+ self assert: parser fail: 'fo'.
+
!
testTrimmerGuard
- parser := $a asParser trim, $b asParser compileWithConfiguration: configuration.
-
- self assert: parser parse: 'ab'.
- self assert: parser parse: ' ab'.
+ parser := $a asParser trim, $b asParser compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'ab'.
+ 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'.
+ 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.
+ 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.
+ 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).
+ 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.
+ 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'!
--- a/compiler/tests/PPCContextMementoTest.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPCContextMementoTest.st Sun May 10 06:28:36 2015 +0100
@@ -13,7 +13,7 @@
!PPCContextMementoTest methodsFor:'as yet unclassified'!
memento
- ^ PPCContextMemento new
+ ^ PPCContextMemento new
! !
!PPCContextMementoTest class methodsFor:'documentation'!
--- a/compiler/tests/PPCContextTest.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPCContextTest.st Sun May 10 06:28:36 2015 +0100
@@ -13,7 +13,7 @@
!PPCContextTest methodsFor:'as yet unclassified'!
context
- ^ PPCContext new
+ ^ PPCContext new
! !
!PPCContextTest class methodsFor:'documentation'!
--- a/compiler/tests/PPCCopyVisitorTest.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPCCopyVisitorTest.st Sun May 10 06:28:36 2015 +0100
@@ -9,67 +9,92 @@
category:'PetitCompiler-Tests-Visitors'
!
+
!PPCCopyVisitorTest methodsFor:'as yet unclassified'!
assert: object equal: anotherObject
- self assert: object = anotherObject
+ self assert: object = anotherObject
!
assert: object identical: anotherObject
- self assert: (object == anotherObject)
+ self assert: (object == anotherObject)
!
assert: object notIdentical: anotherObject
- self assert: (object == anotherObject) not
+ self assert: (object == anotherObject) not
!
setUp
- visitor := PPCCopyVisitor new
+ visitor := PPCCopyVisitor new
!
testCopy1
- node := PPCNilNode new.
- result := visitor visit: node.
-
- self assert: node equal: result.
- self assert: node notIdentical: result
+ node := PPCNilNode new.
+ result := visitor visit: node.
+
+ self assert: node equal: result.
+ self assert: node notIdentical: result
!
testCopy2
- | nilNode |
- nilNode := PPCNilNode new.
- node := PPCForwardNode new
- child: nilNode;
- yourself.
-
- result := visitor visit: node.
-
- self assert: result notIdentical: node.
- self assert: result equal: node.
- self assert: result child notIdentical: node child.
- self assert: result child equal: node child.
+ | nilNode |
+ nilNode := PPCNilNode new.
+ node := PPCForwardNode new
+ child: nilNode;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result notIdentical: node.
+ self assert: result equal: node.
+ self assert: result child notIdentical: node child.
+ self assert: result child equal: node child.
- self assert: node child identical: nilNode.
+ self assert: node child identical: nilNode.
!
testCopyCycle
- | forwardNode |
- forwardNode := PPCForwardNode new
- child: nil;
- yourself.
- node := PPCForwardNode new
- child: forwardNode;
- yourself.
- forwardNode child: node.
-
- result := visitor visit: node.
-
- self assert: (result == node) not.
- self assert: (result = node).
- self assert: (result child == node child) not.
- self assert: (result child = node child).
-
- self assert: node child == forwardNode.
- self assert: forwardNode child == node.
+ | forwardNode |
+ forwardNode := PPCForwardNode new
+ child: nil;
+ yourself.
+ node := PPCForwardNode new
+ child: forwardNode;
+ yourself.
+ forwardNode child: node.
+
+ result := visitor visit: node.
+
+ self assert: (result == node) not.
+ self assert: (result = node).
+ self assert: (result child == node child) not.
+ self assert: (result child = node child).
+
+ self assert: node child == forwardNode.
+ self assert: forwardNode child == node.
+!
+
+testCopyProperties
+ node := PPCNilNode new.
+ node propertyAt: #foo put: #bar.
+ self assert: (node propertyAt: #foo) = #bar.
+
+
+ result := visitor visit: node.
+ self assert: node equal: result.
+ self assert: (node propertyAt: #foo) = #bar.
+ self assert: (result propertyAt: #foo) = #bar.
+
+ result propertyAt: #bar put: #foo.
+ self assert: (node propertyAt: #bar) isNil.
+ self assert: (result propertyAt: #bar) = #foo.
+
! !
+!PPCCopyVisitorTest class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/compiler/tests/PPCGuardTest.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPCGuardTest.st Sun May 10 06:28:36 2015 +0100
@@ -13,149 +13,178 @@
!PPCGuardTest methodsFor:'as yet unclassified'!
setUp
- super setUp.
- compiler := PPCMockCompiler new.
+ super setUp.
+ compiler := PPCMockCompiler new.
!
testCompiling
- guard := PPCGuard new initializeFor: ($a asParser / $b asParser) asCompilerTree.
- guard id: #foo.
- guard compileGuard: compiler.
-
- self assert: compiler lines size = 1.
- self assert: compiler lines first = '(foo at: context peek asInteger)'.
+ guard := PPCGuard new initializeFor: ($a asParser / $b asParser) asCompilerTree.
+ guard id: #foo.
+ guard compileGuard: compiler.
+
+ self assert: compiler lines size = 1.
+ self assert: compiler lines first = '(foo at: context peek asInteger)'.
!
testCompiling2
- guard := PPCGuard new initializeFor: (#letter asParser / #digit asParser) asCompilerTree.
- guard id: #foo.
- guard compileGuard: compiler.
-
- self assert: compiler lines size = 1.
- self assert: compiler lines first = '(context peek isAlphaNumeric)'.
+ guard := PPCGuard new initializeFor: (#letter asParser / #digit asParser) asCompilerTree.
+ guard id: #foo.
+ guard compileGuard: compiler.
+
+ self assert: compiler lines size = 1.
+ self assert: compiler lines first = '(context peek isAlphaNumeric)'.
!
testCompiling3
- guard := PPCGuard new initializeFor: ($a asParser, (#letter asParser / #digit asParser)) asCompilerTree.
- guard id: #foo.
- guard compileGuard: compiler.
-
- self assert: compiler lines size = 1.
- self assert: compiler lines first = ('(context peek = ', $a storeString ,')').
+ guard := PPCGuard new initializeFor: ($a asParser, (#letter asParser / #digit asParser)) asCompilerTree.
+ guard id: #foo.
+ guard compileGuard: compiler.
+
+ self assert: compiler lines size = 1.
+ self assert: compiler lines first = ('(context peek = ', $a storeString ,')').
!
testCompiling4
- guard := PPCGuard new initializeFor: ('foo' asParser / 'foobar' asParser) asCompilerTree.
- guard id: #foo.
- guard compileGuard: compiler.
-
- self assert: compiler lines size = 1.
- self assert: compiler lines first = ('(context peek = ', $f storeString ,')').
+ guard := PPCGuard new initializeFor: ('foo' asParser / 'foobar' asParser) asCompilerTree.
+ guard id: #foo.
+ guard compileGuard: compiler.
+
+ self assert: compiler lines size = 1.
+ self assert: compiler lines first = ('(context peek = ', $f storeString ,')').
!
testIdentifierToken
- | id parser |
- id := (#letter asParser plus)
- name: 'identifier';
- yourself.
-
- parser := id smalltalkToken.
- parser name: 'kw'.
+ | id ws letterNode node |
+ letterNode := PPCMessagePredicateNode new
+ message: #isLetter;
+ yourself.
+
+ id := PPCPlusNode new
+ child: letterNode;
+ name: 'identifier';
+ yourself.
+ ws := PPCSentinelNode new.
+
+ node := PPCTrimmingTokenNode new
+ child: id;
+ whitespace: ws;
+ name: 'kw';
+ yourself.
- guard := PPCGuard new initializeFor: parser asCompilerTree optimizeTree.
- self assert: (guard classification at: $a asInteger).
- self assert: (guard classification at: $z asInteger).
+ guard := PPCGuard new initializeFor: node.
+ self assert: (guard classification at: $a asInteger).
+ self assert: (guard classification at: $z asInteger).
!
testMakesSense
- guard := PPCGuard new initializeFor: #letter asParser.
- self assert: guard makesSense.
-
- guard := PPCGuard new initializeFor: nil asParser asCompilerTree.
- self assert: guard makesSense not.
-
- guard := PPCGuard new initializeFor: (#letter asParser / nil asParser) asCompilerTree.
- self assert: guard makesSense not.
-
- guard := PPCGuard new initializeFor: (#letter asParser / #digit asParser) asCompilerTree.
- self assert: guard makesSense.
+ guard := PPCGuard new initializeFor: #letter asParser asCompilerTree.
+ self assert: guard makesSense.
+
+ guard := PPCGuard new initializeFor: nil asParser asCompilerTree.
+ self assert: guard makesSense not.
+
+ guard := PPCGuard new initializeFor: (#letter asParser / nil asParser) asCompilerTree.
+ self assert: guard makesSense not.
+
+ guard := PPCGuard new initializeFor: (#letter asParser / #digit asParser) asCompilerTree.
+ self assert: guard makesSense.
- guard := PPCGuard new initializeFor: (#letter asParser / #digit asParser star) asCompilerTree.
- self assert: guard makesSense not.
+ guard := PPCGuard new initializeFor: (#letter asParser / #digit asParser optional) asCompilerTree.
+ self assert: guard makesSense not.
!
testMessage
- guard := PPCGuard new initializeFor: #letter asParser asCompilerTree.
- self assert: (guard message = #isLetter).
- self assert: (guard message = #isAlphaNumeric) not.
-
- guard := PPCGuard new initializeFor: #word asParser asCompilerTree.
- self assert: (guard message = #isAlphaNumeric).
-
- guard := PPCGuard new initializeFor: #digit asParser asCompilerTree.
- self assert: (guard message = #isDigit).
-
- guard := PPCGuard new initializeFor: 'a' asParser asCompilerTree.
- self assert: (guard message = #isDigit) not.
- self assert: (guard message = #isLetter) not.
- self assert: (guard message = #isAlphaNumeric) not.
-
+ guard := PPCGuard new initializeFor: #letter asParser asCompilerTree.
+ self assert: (guard message = #isLetter).
+ self assert: (guard message = #isAlphaNumeric) not.
+
+ guard := PPCGuard new initializeFor: #word asParser asCompilerTree.
+ self assert: (guard message = #isAlphaNumeric).
+
+ guard := PPCGuard new initializeFor: #digit asParser asCompilerTree.
+ self assert: (guard message = #isDigit).
+
+ guard := PPCGuard new initializeFor: 'a' asParser asCompilerTree.
+ self assert: (guard message = #isDigit) not.
+ self assert: (guard message = #isLetter) not.
+ self assert: (guard message = #isAlphaNumeric) not.
+
!
testMessage2
- guard := PPCGuard new initializeFor: (#letter asParser / #digit asParser) asCompilerTree.
- self assert: guard message = #isAlphaNumeric
-
+ guard := PPCGuard new initializeFor: (#letter asParser / #digit asParser) asCompilerTree.
+ self assert: guard message = #isAlphaNumeric
+
!
testNot
- guard := PPCGuard new initializeFor: ('foo' asParser not, 'fee' asParser) asCompilerTree.
- self assert: (guard classification at: $f asInteger).
+ guard := PPCGuard new initializeFor: ('foo' asParser not, 'fee' asParser) asCompilerTree.
+ self assert: (guard classification at: $f asInteger).
!
testNot2
- guard := PPCGuard new initializeFor: ('foo' asParser not, 'fee' asParser) asCompilerTree optimizeTree.
- self assert: (guard classification at: $f asInteger).
+ | fee notFoo node |
+ fee := PPCLiteralNode new
+ literal: 'fee';
+ yourself.
+ notFoo := PPCNotLiteralNode new
+ literal: 'foo';
+ yourself.
+ node := PPCSequenceNode new
+ children: { notFoo . fee };
+ yourself.
+
+ guard := PPCGuard new initializeFor: node.
+ self assert: (guard classification at: $f asInteger).
!
testNot3
- guard := PPCGuard new initializeFor: (#letter asParser negate star, #letter asParser) asCompilerTree optimizeTree.
- self assert: (guard classification allSatisfy: [ :e | e]).
+ | letter letterNegateStar node |
+ letter := PPCMessagePredicateNode new
+ message: #isLetter; yourself.
+ letterNegateStar := PPCStarNode new
+ child: #letter asParser negate asCompilerNode;
+ yourself.
+ node := PPCSequenceNode new
+ children: { letterNegateStar . letter };
+ yourself.
+ guard := PPCGuard new initializeFor: node.
+ self assert: (guard classification allSatisfy: [ :e | e]).
!
testTestMessage
- guard := PPCGuard new initializeFor: #letter asParser asCompilerTree.
- self assert: (guard testMessage: #isLetter).
- self assert: (guard testMessage: #isAlphaNumeric) not.
-
- guard := PPCGuard new initializeFor: #word asParser asCompilerTree.
- self assert: (guard testMessage: #isAlphaNumeric).
-
- guard := PPCGuard new initializeFor: #digit asParser asCompilerTree.
- self assert: (guard testMessage: #isDigit).
-
- guard := PPCGuard new initializeFor: 'a' asParser asCompilerTree.
- self assert: (guard testMessage: #isDigit) not.
- self assert: (guard testMessage: #isLetter) not.
- self assert: (guard testMessage: #isAlphaNumeric) not.
-
+ guard := PPCGuard new initializeFor: #letter asParser asCompilerTree.
+ self assert: (guard testMessage: #isLetter).
+ self assert: (guard testMessage: #isAlphaNumeric) not.
+
+ guard := PPCGuard new initializeFor: #word asParser asCompilerTree.
+ self assert: (guard testMessage: #isAlphaNumeric).
+
+ guard := PPCGuard new initializeFor: #digit asParser asCompilerTree.
+ self assert: (guard testMessage: #isDigit).
+
+ guard := PPCGuard new initializeFor: 'a' asParser asCompilerTree.
+ self assert: (guard testMessage: #isDigit) not.
+ self assert: (guard testMessage: #isLetter) not.
+ self assert: (guard testMessage: #isAlphaNumeric) not.
+
!
testTestSingleCharacter
- guard := PPCGuard new initializeFor: $a asParser asCompilerTree.
- self assert: guard testSingleCharacter.
-
- guard := PPCGuard new initializeFor: 'foo' asParser asCompilerTree.
- self assert: guard testSingleCharacter.
-
- guard := PPCGuard new initializeFor: ('foo' asParser / 'bar' asParser) asCompilerTree.
- self assert: guard testSingleCharacter not.
+ guard := PPCGuard new initializeFor: $a asParser asCompilerTree.
+ self assert: guard testSingleCharacter.
+
+ guard := PPCGuard new initializeFor: 'foo' asParser asCompilerTree.
+ self assert: guard testSingleCharacter.
+
+ guard := PPCGuard new initializeFor: ('foo' asParser / 'bar' asParser) asCompilerTree.
+ self assert: guard testSingleCharacter not.
- guard := PPCGuard new initializeFor: ($a asParser, (#letter asParser / #digit asParser)) asCompilerTree.
- self assert: guard testSingleCharacter.
-
- guard := PPCGuard new initializeFor: ('foo' asParser / 'fee' asParser) asCompilerTree.
- self assert: guard testSingleCharacter.
+ guard := PPCGuard new initializeFor: ($a asParser, (#letter asParser / #digit asParser)) asCompilerTree.
+ self assert: guard testSingleCharacter.
+
+ guard := PPCGuard new initializeFor: ('foo' asParser / 'fee' asParser) asCompilerTree.
+ self assert: guard testSingleCharacter.
! !
!PPCGuardTest class methodsFor:'documentation'!
--- a/compiler/tests/PPCInliningVisitorTest.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPCInliningVisitorTest.st Sun May 10 06:28:36 2015 +0100
@@ -12,163 +12,163 @@
!PPCInliningVisitorTest methodsFor:'as yet unclassified'!
assert: object type: class
- self assert: object class == class
+ self assert: object class == class
!
setUp
- visitor := PPCInliningVisitor new.
+ visitor := PPCInliningVisitor new.
!
testCharacterNode
- node := PPCCharacterNode new
- character: $a;
- yourself.
- result := visitor visit: node.
-
- self assert: result type: PPCCharacterNode.
- self assert: result isMarkedForInline not.
- self assert: result character = $a.
+ node := PPCCharacterNode new
+ character: $a;
+ yourself.
+ result := visitor visit: node.
+
+ self assert: result type: PPCCharacterNode.
+ self assert: result isMarkedForInline not.
+ self assert: result character = $a.
!
testCharacterNode2
- | charNode |
- charNode := PPCCharacterNode new
- character: $a;
- yourself.
- node := PPCStarNode new
- child: charNode;
- yourself.
- result := visitor visit: node.
-
- self assert: result child type: PPCCharacterNode.
- self assert: result child isMarkedForInline.
- self assert: result child character = $a.
+ | charNode |
+ charNode := PPCCharacterNode new
+ character: $a;
+ yourself.
+ node := PPCStarNode new
+ child: charNode;
+ yourself.
+ result := visitor visit: node.
+
+ self assert: result child type: PPCCharacterNode.
+ self assert: result child isMarkedForInline.
+ self assert: result child character = $a.
!
testLiteralNode
- | literalNode |
- literalNode := PPCLiteralNode new
- literal: 'foo';
- yourself.
- node := PPCOptionalNode new
- child: literalNode;
- yourself.
+ | literalNode |
+ literalNode := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+ node := PPCOptionalNode new
+ child: literalNode;
+ yourself.
- result := visitor visit: node.
-
- self assert: result child type: PPCLiteralNode.
- self assert: result child isMarkedForInline.
- self assert: result child literal = 'foo'.
+ result := visitor visit: node.
+
+ self assert: result child type: PPCLiteralNode.
+ self assert: result child isMarkedForInline.
+ self assert: result child literal = 'foo'.
!
testNil
- node := PPCNilNode new.
- result := visitor visit: node.
+ node := PPCNilNode new.
+ result := visitor visit: node.
- self assert: result type: PPCNilNode.
- self assert: result isMarkedForInline not.
+ self assert: result type: PPCNilNode.
+ self assert: result isMarkedForInline not.
!
testNil2
- node := PPCStarNode new
- child: PPCNilNode new;
- yourself.
- result := visitor visit: node.
+ node := PPCStarNode new
+ child: PPCNilNode new;
+ yourself.
+ result := visitor visit: node.
- self assert: result type: PPCStarNode.
- self assert: result child type: PPCNilNode.
- self assert: result child isMarkedForInline.
+ self assert: result type: PPCStarNode.
+ self assert: result child type: PPCNilNode.
+ self assert: result child isMarkedForInline.
!
testNotLiteralNode
- | notLiteralNode |
+ | notLiteralNode |
- notLiteralNode := PPCNotLiteralNode new
- literal: 'foo';
- yourself.
+ notLiteralNode := PPCNotLiteralNode new
+ literal: 'foo';
+ yourself.
- node := PPCOptionalNode new
- child: notLiteralNode;
- yourself.
+ node := PPCOptionalNode new
+ child: notLiteralNode;
+ yourself.
- result := visitor visit: node.
-
- self assert: result child type: PPCNotLiteralNode.
- self assert: result child isMarkedForInline.
- self assert: result child literal = 'foo'.
+ result := visitor visit: node.
+
+ self assert: result child type: PPCNotLiteralNode.
+ self assert: result child isMarkedForInline.
+ self assert: result child literal = 'foo'.
!
testPluggable
- | pluggableNode |
- pluggableNode := PPCPluggableNode new
- block: [:ctx | nil] asParser.
- node := PPCSequenceNode new
- children: { pluggableNode };
- yourself.
+ | pluggableNode |
+ pluggableNode := PPCPluggableNode new
+ block: [:ctx | nil] asParser.
+ node := PPCSequenceNode new
+ children: { pluggableNode };
+ yourself.
- result := visitor visit: node.
-
- ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:
- [
- self skip: 'skipped test, inlining of pluggable nodes not supported!!'.
- ].
+ result := visitor visit: node.
+
+ ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:
+ [
+ self skip: 'skipped test, inlining of pluggable nodes not supported!!'.
+ ].
- self assert: result children first type: PPCPluggableNode.
- self assert: result children first isMarkedForInline.
+ self assert: result children first type: PPCPluggableNode.
+ self assert: result children first isMarkedForInline.
"Modified: / 23-04-2015 / 12:18:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testSequenceInline
- | charNode1 charNode2 |
- charNode1 := PPCCharacterNode new
- character: $a;
- yourself.
- charNode2 := PPCCharacterNode new
- character: $b;
- yourself.
+ | charNode1 charNode2 |
+ charNode1 := PPCCharacterNode new
+ character: $a;
+ yourself.
+ charNode2 := PPCCharacterNode new
+ character: $b;
+ yourself.
- node := PPCSequenceNode new
- children: { charNode1 . charNode2 };
- yourself.
- result := visitor visit: node.
-
- self assert: result type: PPCSequenceNode .
- self assert: result children first type: PPCCharacterNode.
- self assert: result children second type: PPCCharacterNode.
+ node := PPCSequenceNode new
+ children: { charNode1 . charNode2 };
+ yourself.
+ result := visitor visit: node.
+
+ self assert: result type: PPCSequenceNode .
+ self assert: result children first type: PPCCharacterNode.
+ self assert: result children second type: PPCCharacterNode.
!
testTokenStarMessagePredicateNode
- | tokenNode |
- tokenNode := (PPCTokenStarMessagePredicateNode new)
- child: PPCSentinelNode new;
- yourself.
- node := PPCForwardNode new
- child: tokenNode;
- yourself.
- result := visitor visit: node.
-
- self assert: result child type: PPCTokenStarMessagePredicateNode.
- self assert: result child isMarkedForInline.
+ | tokenNode |
+ tokenNode := (PPCTokenStarMessagePredicateNode new)
+ child: PPCSentinelNode new;
+ yourself.
+ node := PPCForwardNode new
+ child: tokenNode;
+ yourself.
+ result := visitor visit: node.
+
+ self assert: result child type: PPCTokenStarMessagePredicateNode.
+ self assert: result child isMarkedForInline.
!
testTokenStarSeparatorNode
- | tokenNode |
- tokenNode := (PPCTokenStarSeparatorNode new)
- name: #name;
- message: #message;
- child: PPCNilNode new;
- yourself.
+ | tokenNode |
+ tokenNode := (PPCTokenStarSeparatorNode new)
+ name: #name;
+ message: #message;
+ child: PPCNilNode new;
+ yourself.
- node := PPCForwardNode new
- child: tokenNode;
- yourself.
+ node := PPCForwardNode new
+ child: tokenNode;
+ yourself.
-
- result := visitor visit: node.
-
- self assert: result child type: PPCTokenStarSeparatorNode.
- self assert: result child isMarkedForInline.
- self assert: result child child type: PPCNilNode.
+
+ result := visitor visit: node.
+
+ self assert: result child type: PPCTokenStarSeparatorNode.
+ self assert: result child isMarkedForInline.
+ self assert: result child child type: PPCNilNode.
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCLL1OptimizingTest.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,78 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCLL1OptimizingTest
+ instanceVariableNames:'configuration parser result'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Core'
+!
+
+!PPCLL1OptimizingTest methodsFor:'as yet unclassified'!
+
+assert: object type: class
+ self assert: (object isKindOf: class)
+!
+
+configuration
+ configuration := PPCLL1Configuration new.
+ configuration arguments generate: false.
+ ^ configuration
+!
+
+optimize: aPPParser
+ ^ self configuration compile: aPPParser.
+!
+
+testCompileToken
+ parser := 'foo' asParser token.
+ result := self optimize: parser.
+
+ self assert: result type: PPCTokenizingParserNode.
+ self assert: result parser type: PPCTokenConsumeNode.
+ self assert: result parser child type: PPCTokenNode.
+ self assert: result parser child child literal = 'foo'.
+!
+
+testCompileTrim
+ parser := 'foo' asParser token trim.
+ result := self optimize: parser.
+
+ 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.
+!
+
+testCompileTrimmingToken
+ parser := 'foo' asParser trimmingToken.
+ result := self optimize: parser.
+
+ 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 tokenizer children size = 2.
+ self assert: (result tokenizer children anySatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ])
+!
+
+testCompileTrimmingToken2
+ | token |
+ token := 'foo' asParser trimmingToken.
+ parser := token wrapped
+ name: 'fooToken';
+ yourself.
+ result := self optimize: parser.
+
+ 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 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']).
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCLL1Test.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,251 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPAbstractParserTest subclass:#PPCLL1Test
+ instanceVariableNames:'parser result context node compiler id node2 id2 id1 node1 node3
+ arguments configuration'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Core'
+!
+
+!PPCLL1Test methodsFor:'as yet unclassified'!
+
+assert: p parse: whatever
+ ^ result := super assert: p parse: whatever.
+!
+
+cleanClass
+ | parserClass |
+ parserClass := (Smalltalk at: arguments name ifAbsent: [nil]).
+ parserClass notNil ifTrue:[
+ self flag: 'uncomment'.
+" parserClass removeFromSystem"
+ ].
+!
+
+context
+ ^ context := PPCProfilingContext new
+!
+
+parse: whatever
+ ^ result := super parse: whatever.
+!
+
+setUp
+ arguments := PPCArguments default
+ profile: true;
+ guards: false;
+ yourself.
+
+ configuration := PPCLL1Configuration new
+ arguments: arguments;
+ yourself.
+
+ self cleanClass.
+!
+
+tearDown
+ self cleanClass
+!
+
+testChoiceOrder
+ parser := (
+ 'a' asParser token, 'b' asParser token /
+ 'a' asParser token)
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'ab'.
+ self assert: result first inputValue = 'a'.
+ self assert: result second inputValue = 'b'.
+
+ self assert: parser parse: 'a'.
+ self assert: result inputValue = 'a'.
+
+ self assert: parser fail: '_'.
+
+!
+
+testChoiceOrder2
+ | p1 p2 |
+ p1 := 'a' asParser token, 'b' asParser token.
+ p2 := 'b' asParser token / 'a' asParser token.
+
+ parser := p1 / p2 compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'ab'.
+ self assert: result first inputValue = 'a'.
+ self assert: result second inputValue = 'b'.
+
+ self assert: parser parse: 'a'.
+ self assert: result inputValue = 'a'.
+
+ self assert: parser parse: 'b'.
+ self assert: result inputValue = 'b'.
+
+ self assert: parser fail: 'c'.
+
+!
+
+testChoiceOrder3
+ | p1 p2 a1 a2 |
+ a1 := 'a' asParser token name: 't1'; yourself.
+ a2 := 'a' asParser token name: 't2'; yourself.
+
+ p1 := a1, 'b' asParser token.
+ p2 := a2.
+
+ parser := p1 / p2 compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'ab'.
+ self assert: result first inputValue = 'a'.
+ self assert: result second inputValue = 'b'.
+
+ self assert: parser parse: 'a'.
+ self assert: result inputValue = 'a'.
+
+ self assert: parser fail: 'b'.
+
+!
+
+testChoiceOrder4
+ | p1 p2 a1 a2 |
+ a1 := 'a' asParser token name: 't1'; yourself.
+ a2 := 'a' asParser token name: 't2'; yourself.
+
+ p1 := a1, 'b' asParser token.
+ p2 := 'b' asParser token / a2.
+
+ parser := p1 / p2 compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'ab'.
+ self assert: result first inputValue = 'a'.
+ self assert: result second inputValue = 'b'.
+
+ self assert: parser parse: 'a'.
+ self assert: result inputValue = 'a'.
+
+ self assert: parser parse: 'b'.
+ self assert: result inputValue = 'b'.
+
+ self assert: parser fail: 'c'.
+
+!
+
+testCompileChoice
+ parser := ('foo' asParser / 'bar' asParser) compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo' to: 'foo'.
+ self assert: parser parse: 'bar' to: 'bar'.
+ self assert: parser fail: '_'.
+
+!
+
+testCompileChoice2
+ parser := ('foo' asParser token trim / 'bar' asParser token trim) compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+ self assert: parser parse: 'bar'.
+ self assert: result inputValue = 'bar'.
+ self assert: parser fail: '_'.
+
+!
+
+testCompileLiteral
+ parser := 'foo' asParser token compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+ self assert: parser fail: 'boo'.
+!
+
+testCompileSequence
+ parser := ('foo' asParser token), ('bar' asParser token)
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foobar'.
+ self assert: result first inputValue = 'foo'.
+ self assert: result second inputValue = 'bar'.
+!
+
+testCompileTokenComplex2
+ | a b argumentsWith |
+ "based on the PPSmalltlakGrammar>>blockArgumentsWith"
+ a := $| asParser smalltalkToken
+ yourself.
+ b := $] asParser smalltalkToken
+ yourself.
+ argumentsWith := (a / b and ==> [:t | ]) wrapped
+ name: 'argumentsWith';
+ yourself.
+
+ parser := argumentsWith compileWithConfiguration: configuration.
+ self assert: parser parse: '|'.
+
+ parser := argumentsWith compileWithConfiguration: configuration.
+ self assert: parser parse: ']'.
+!
+
+testCompileTokenComplex3
+ | choice1 choice2 a1 b1 a2 b2 tricky |
+ a1 := $| asParser token
+ yourself.
+ b1 := $] asParser token
+ yourself.
+ choice1 := (a1 / b1) wrapped
+ name: 'choice1';
+ yourself.
+
+ a2 := $| asParser token
+ yourself.
+ b2 := $] asParser token
+ yourself.
+ choice2 := (a2 / b2) wrapped
+ name: 'choice1';
+ yourself.
+
+ tricky := (a1 asParser, choice1) / (b2 asParser, choice2).
+
+ 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: ']]'.
+!
+
+testCompileTrim
+ parser := 'foo' asParser token trim end compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+
+ self assert: parser parse: 'foo '.
+ self assert: result inputValue = 'foo'.
+
+
+ self assert: parser parse: ' foo'.
+ self assert: result inputValue = 'foo'.
+
+ self assert: parser fail: 'boo'.
+!
+
+testTokenName
+ | token |
+ token := 'foo' asParser token name: 'fooToken'; yourself.
+ parser := token plus
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foofoo'.
+ self assert: result first inputValue = 'foo'.
+ self assert: result second inputValue = 'foo'.
+ self assert: (parser class methodDictionary includesKey: #fooToken).
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCLL1VisitorTest.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,141 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCLL1VisitorTest
+ instanceVariableNames:'node result visitor'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Visitors'
+!
+
+!PPCLL1VisitorTest methodsFor:'as yet unclassified'!
+
+setUp
+ visitor := PPCLL1Visitor new.
+! !
+
+!PPCLL1VisitorTest methodsFor:'testing'!
+
+assert: object type: class
+ self assert: object class == class
+!
+
+literalToken: literal
+ | literalNode |
+ literalNode := PPCLiteralNode new
+ literal: literal;
+ yourself.
+
+ ^ PPCTokenNode new
+ child: literalNode;
+ yourself
+!
+
+testChoiceIsDeterministic
+ | tokenNode1 tokenNode2 literalNode1 literalNode2 |
+ literalNode1 := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+ literalNode2 := PPCLiteralNode new
+ literal: 'bar';
+ yourself.
+ tokenNode1 := PPCTokenNode new
+ child: literalNode1;
+ yourself.
+ tokenNode2 := PPCTokenNode new
+ child: literalNode2;
+ yourself.
+
+ node := PPCChoiceNode new
+ children: { tokenNode1 . literalNode1 };
+ yourself.
+ self assert: (visitor isDeterministicChoice: node) not.
+
+ node := PPCChoiceNode new
+ children: { tokenNode1 . tokenNode2 };
+ yourself.
+ self assert: (visitor isDeterministicChoice: node).
+!
+
+testChoiceIsDeterministic2
+ | literalNode tokenNode |
+ literalNode := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+ tokenNode := PPCTrimmingTokenNode new
+ child: literalNode;
+ whitespace: PPCSentinelNode new;
+ yourself.
+
+ node := PPCChoiceNode new
+ children: { tokenNode . literalNode };
+ yourself.
+ self assert: (visitor isDeterministicChoice: node) not.
+
+ node := PPCChoiceNode new
+ children: { tokenNode . tokenNode };
+ yourself.
+ self assert: (visitor isDeterministicChoice: node) not.
+!
+
+testDeterministicChoice1
+ | token1 token2 |
+ token1 := self literalToken: 'foo'.
+ token2 := self literalToken: 'bar'.
+
+ node := PPCChoiceNode new
+ children: { token1 . token2 }.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCDeterministicChoiceNode.
+ self assert: result firstChild = token1.
+ self assert: result secondChild = token2.
+!
+
+testStartsWithToken
+ | literalNode tokenNode |
+ literalNode := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+ tokenNode := PPCTokenNode new
+ child: literalNode;
+ yourself.
+
+ self assert: (visitor startsWithToken: literalNode) not.
+ self assert: (visitor startsWithToken: tokenNode).
+
+!
+
+testStartsWithToken2
+ | literalNode tokenNode |
+ literalNode := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+ tokenNode := PPCTokenNode new
+ child: literalNode;
+ yourself.
+
+ self assert: (visitor startsWithToken: (PPCTrimNode new child: literalNode)) not.
+ self assert: (visitor startsWithToken: (PPCTrimNode new child: tokenNode)) not.
+
+!
+
+testStartsWithToken3
+ | literalNode tokenNode ws |
+ literalNode := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+ tokenNode := PPCTokenNode new
+ child: literalNode;
+ yourself.
+ ws := PPCStarNode new
+ child: PPCSentinelNode new;
+ yourself.
+
+ self assert: (visitor startsWithToken: (PPCTrimmingTokenNode new child: literalNode; whitespace: ws; yourself)).
+ self assert: (visitor startsWithToken: (PPCTrimmingTokenNode new child: tokenNode; whitespace: ws; yourself)).
+
+! !
+
--- a/compiler/tests/PPCMergingVisitorTest.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPCMergingVisitorTest.st Sun May 10 06:28:36 2015 +0100
@@ -13,57 +13,57 @@
!PPCMergingVisitorTest methodsFor:'as yet unclassified'!
javaWsNode
- ^ PPCUnknownNode new
- parser: PPJavaWhitespaceParser new;
- yourself
+ ^ PPCUnknownNode new
+ parser: PPJavaWhitespaceParser new;
+ yourself
!
nilNode
- ^ PPCNilNode new
+ ^ PPCNilNode new
!
setUp
- visitor := PPCMergingVisitor new
+ visitor := PPCMergingVisitor new
!
testJavaWS
- node1 := self javaWsNode.
- node2 := self javaWsNode.
-
- node := PPCSequenceNode new
- children: { node1 . node2 }.
-
- self assert: (node children first == node children second) not.
- node := visitor visit: node.
- self assert: (node children first == node children second).
+ node1 := self javaWsNode.
+ node2 := self javaWsNode.
+
+ node := PPCSequenceNode new
+ children: { node1 . node2 }.
+
+ self assert: (node children first == node children second) not.
+ node := visitor visit: node.
+ self assert: (node children first == node children second).
!
testNilNode
- node1 := self nilNode.
- node2 := self nilNode.
-
- node := PPCSequenceNode new
- children: { node1 . node2 }.
-
- self assert: (node children first == node children second) not.
- node := visitor visit: node.
- self assert: (node children first == node children second).
+ node1 := self nilNode.
+ node2 := self nilNode.
+
+ node := PPCSequenceNode new
+ children: { node1 . node2 }.
+
+ self assert: (node children first == node children second) not.
+ node := visitor visit: node.
+ self assert: (node children first == node children second).
!
testNilNode2
- node1 := self nilNode
- name: #foo;
- yourself.
- node2 := self nilNode
- name: #bar;
- yourself.
-
- node := PPCSequenceNode new
- children: { node1 . node2 }.
-
- self assert: (node children first == node children second) not.
- node := visitor visit: node.
- self assert: (node children first == node children second) not.
+ node1 := self nilNode
+ name: #foo;
+ yourself.
+ node2 := self nilNode
+ name: #bar;
+ yourself.
+
+ node := PPCSequenceNode new
+ children: { node1 . node2 }.
+
+ self assert: (node children first == node children second) not.
+ node := visitor visit: node.
+ self assert: (node children first == node children second) not.
! !
!PPCMergingVisitorTest class methodsFor:'documentation'!
--- a/compiler/tests/PPCMockCompiler.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPCMockCompiler.st Sun May 10 06:28:36 2015 +0100
@@ -21,30 +21,30 @@
!PPCMockCompiler methodsFor:'accessing'!
lines
-
- ^ lines
+
+ ^ lines
!
lines: anObject
-
- lines := anObject
+
+ lines := anObject
! !
!PPCMockCompiler methodsFor:'as yet unclassified'!
add: string
- lines add: string
+ lines add: string
!
addConstant: object as: id
- "TODO"
+ "TODO"
! !
!PPCMockCompiler methodsFor:'initialization'!
initialize
- super initialize.
- lines := OrderedCollection new.
+ super initialize.
+ lines := OrderedCollection new.
! !
!PPCMockCompiler class methodsFor:'documentation'!
--- a/compiler/tests/PPCNodeCompilingTest.st Thu Apr 30 23:43:14 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,109 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPAbstractParserTest subclass:#PPCNodeCompilingTest
- instanceVariableNames:'parser context tree result'
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Tests-Nodes'
-!
-
-
-!PPCNodeCompilingTest methodsFor:'context'!
-
-context
- ^ context := PPCProfilingContext new
-! !
-
-!PPCNodeCompilingTest methodsFor:'test support'!
-
-assert: whatever parse: input
- result := super assert: whatever parse: input.
-!
-
-compileTree: root
- ^ self compileTree: root arguments: PPCArguments default
-!
-
-compileTree: root arguments: arguments
- | configuration |
- arguments profile: true.
-
- configuration := PPCPluggableConfiguration on: [ :_self |
- _self specialize.
- _self specialize.
- _self tokenize.
- _self inline.
- _self merge.
- _self generate.
- ].
-
- ^ configuration compile: root arguments: arguments.
-!
-
-tearDown
- | class |
-
- class := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]).
- class notNil ifTrue:[
- class removeFromSystem
- ].
-! !
-
-!PPCNodeCompilingTest methodsFor:'tests - guard'!
-
-testSequenceTokenGuard
-
- tree := PPCSequenceNode new
- children: {
- 'foo' asParser trimmingToken asCompilerTree optimizeTree.
- 'bar' asParser trimmingToken asCompilerTree optimizeTree.
- }
- yourself.
- parser := self compileTree: tree.
-
- self assert: parser parse: 'foobar'.
- self assert: result first inputValue = 'foo'.
- self assert: result second inputValue = 'bar'.
-
- self assert: parser parse: ' foobar'.
- self assert: result first inputValue = 'foo'.
- self assert: result second inputValue = 'bar'.
-
- self assert: parser fail: ' foo'.
-!
-
-testTrimmingTokenGuard
-
- tree := PPCChoiceNode new
- children: {
- 'foo' asParser trimmingToken asCompilerTree optimizeTree.
- 'bar' asParser trimmingToken asCompilerTree optimizeTree
- }
- yourself.
- parser := self compileTree: tree.
-
- self assert: parser parse: 'foo'.
- self assert: result inputValue = 'foo'.
-
- self assert: parser parse: 'bar'.
- self assert: result inputValue = 'bar'.
-
- self assert: parser parse: ' foo'.
- self assert: result inputValue = 'foo'.
-
- self assert: parser parse: ' bar'.
- self assert: result inputValue = 'bar'.
-
- self assert: parser fail: 'zorg'.
- self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]).
-! !
-
-!PPCNodeCompilingTest class methodsFor:'documentation'!
-
-version_HG
-
- ^ '$Changeset: <not expanded> $'
-! !
-
--- a/compiler/tests/PPCNodeFirstFollowNextTests.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPCNodeFirstFollowNextTests.st Sun May 10 06:28:36 2015 +0100
@@ -3,559 +3,645 @@
"{ NameSpace: Smalltalk }"
TestCase subclass:#PPCNodeFirstFollowNextTests
- instanceVariableNames:'tree first node followSet'
+ instanceVariableNames:'tree first node followSet configuration'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Tests-Nodes'
!
-!PPCNodeFirstFollowNextTests methodsFor:'as yet unclassified'!
+!PPCNodeFirstFollowNextTests methodsFor:'setup'!
+
+setUp
+ configuration := PPCConfiguration default.
+ configuration arguments generate: false.
+ "The First/Follow is not allowed after this phase:"
+ configuration arguments specialize: false.
+! !
+
+!PPCNodeFirstFollowNextTests methodsFor:'support'!
assert: set anyMatchesType: whatever
- self assert: (set anySatisfy: [:e | e isKindOf: whatever ])
+ self assert: (set anySatisfy: [:e | e isKindOf: whatever ])
!
assert: set anySatisfy: whateverBlock
- self assert: (set anySatisfy: [:e | [whateverBlock value: e] on: Error do: [ false ] ])
+ self assert: (set anySatisfy: [:e | [whateverBlock value: e] on: Error do: [ false ] ])
!
assert: set noneMatchesType: whatever
- self assert: (set noneSatisfy: [:e | e isKindOf: whatever ])
+ self assert: (set noneSatisfy: [:e | e isKindOf: whatever ])
!
assert: set noneSatisfy: whateverBlock
- self assert: (set noneSatisfy: [:e | [whateverBlock value: e] on: Error do: [ false ] ])
+ self assert: (set noneSatisfy: [:e | [whateverBlock value: e] on: Error do: [ false ] ])
!
assert: set size: anInteger
- self assert: (set size = anInteger )
+ self assert: (set size = anInteger )
!
first: aNode
- ^ aNode firstSet
+ ^ aNode firstSet
!
first: aNode suchThat: aBlock
- ^ (aNode firstSetsSuchThat: aBlock) at: aNode
+ ^ (aNode firstSetsSuchThat: aBlock) at: aNode
!
followOf: name in: rootNode
- node := (rootNode allNodes select: [ :n | n name = name ] )anyOne.
- ^ rootNode followSets at: node
+ node := (rootNode allNodes select: [ :n | n name = name ] )anyOne.
+ ^ rootNode followSets at: node
!
followOf: name in: rootNode suchThat: aBlock
- node := (rootNode allNodes select: [ :n | n name = name ] )anyOne.
- ^ (rootNode followSetsSuchThat: aBlock) at: node
+ node := (rootNode allNodes select: [ :n | n name = name ] )anyOne.
+ ^ (rootNode followSetsSuchThat: aBlock) at: node
!
followOfNodeIn: rootNode
- ^ self followOf: 'node' in: rootNode
+ ^ self followOf: 'node' in: rootNode
!
+treeFrom: parser
+ ^ parser compileWithConfiguration: configuration
+! !
+
+!PPCNodeFirstFollowNextTests methodsFor:'testing - first'!
+
testFirst1
- tree := self treeFrom: nil asParser / 'a' asParser.
-
- self assert: (self first: tree) anyMatchesType: PPCNilNode.
- self assert: (self first: tree) anyMatchesType: PPCAbstractLiteralNode.
+ tree := self treeFrom: nil asParser / 'a' asParser.
+
+ self assert: (self first: tree) anyMatchesType: PPCNilNode.
+ self assert: (self first: tree) anyMatchesType: PPCAbstractLiteralNode.
!
testFirst2
- tree := self treeFrom: 'a' asParser optional, 'b' asParser.
-
- self assert: (self first: tree) anySatisfy: [ :e | e literal = 'a' ].
- self assert: (self first: tree) anySatisfy: [ :e | e literal = 'b' ].
+ tree := self treeFrom: 'a' asParser optional, 'b' asParser.
+
+ self assert: (self first: tree) anySatisfy: [ :e | e literal = 'a' ].
+ self assert: (self first: tree) anySatisfy: [ :e | e literal = 'b' ].
!
testFirst3
- tree := ('a' asParser optional, 'b' asParser asParser optional), 'c' asParser.
-
- self assert: (self first: tree) anySatisfy: [ :e | e literal = 'a' ].
- self assert: (self first: tree) anySatisfy: [ :e | e literal = 'b' ].
- self assert: (self first: tree) anySatisfy: [ :e | e literal = 'c' ].
+ tree := ('a' asParser optional, 'b' asParser asParser optional), 'c' asParser.
+
+ self assert: (self first: tree) anySatisfy: [ :e | e literal = 'a' ].
+ self assert: (self first: tree) anySatisfy: [ :e | e literal = 'b' ].
+ self assert: (self first: tree) anySatisfy: [ :e | e literal = 'c' ].
!
testFirstChoice1
- tree := self treeFrom: nil asParser / '' asParser.
-
- self assert: (self first: tree) anySatisfy: [:e | e literal = ''].
- self assert: (self first: tree) anyMatchesType: PPCNilNode.
+ tree := self treeFrom: nil asParser / '' asParser.
+
+ self assert: (self first: tree) anySatisfy: [:e | e literal = ''].
+ self assert: (self first: tree) anyMatchesType: PPCNilNode.
!
testFirstChoice2
- tree := self treeFrom: 'a' asParser / nil asParser / 'b' asParser.
-
- first := (self first: tree).
-
- self assert: first anySatisfy: [:e | e literal = 'a'].
- self assert: first anySatisfy: [:e | e literal = 'b'].
- self assert: first anyMatchesType: PPCNilNode.
+ tree := self treeFrom: 'a' asParser / nil asParser / 'b' asParser.
+
+ first := (self first: tree).
+
+ self assert: first anySatisfy: [:e | e literal = 'a'].
+ self assert: first anySatisfy: [:e | e literal = 'b'].
+ self assert: first anyMatchesType: PPCNilNode.
!
testFirstComplex1
- tree := self treeFrom: ('a' asParser / nil asParser), 'c' asParser.
-
- first := (self first: tree).
-
- self assert: first size: 2.
- self assert: first anySatisfy: [:e | e literal = 'a'].
- self assert: first anySatisfy: [:e | e literal = 'c'].
- self assert: first noneMatchesType: PPCNilNode.
+ tree := self treeFrom: ('a' asParser / nil asParser), 'c' asParser.
+
+ first := (self first: tree).
+
+ self assert: first size: 2.
+ self assert: first anySatisfy: [:e | e literal = 'a'].
+ self assert: first anySatisfy: [:e | e literal = 'c'].
+ self assert: first noneMatchesType: PPCNilNode.
!
testFirstComplex2
- tree := self treeFrom: ('a' asParser / nil asParser / 'b' asParser), 'c' asParser.
-
-
- first := (self first: tree).
-
- self assert: first size: 3.
- self assert: first anySatisfy: [:e | e literal = 'a'].
- self assert: first anySatisfy: [:e | e literal = 'b'].
- self assert: first anySatisfy: [:e | e literal = 'c'].
+ tree := self treeFrom: ('a' asParser / nil asParser / 'b' asParser), 'c' asParser.
+
+
+ first := (self first: tree).
+
+ self assert: first size: 3.
+ self assert: first anySatisfy: [:e | e literal = 'a'].
+ self assert: first anySatisfy: [:e | e literal = 'b'].
+ self assert: first anySatisfy: [:e | e literal = 'c'].
!
testFirstComplex3
- tree := self treeFrom: ('a' asParser / nil asParser / 'b' asParser), 'c' asParser not.
-
- first := (self first: tree).
-
- self assert: first anySatisfy: [:e | e literal = 'a'].
- self assert: first anySatisfy: [:e | e literal = 'b'].
- self assert: first anySatisfy: [:e | (e isKindOf: PPCNotLiteralNode) and: [e literal = 'c']].
+ tree := self treeFrom: ('a' asParser / nil asParser / 'b' asParser), 'c' asParser not.
+
+ first := (self first: tree).
+
+ self assert: first anySatisfy: [:e | e literal = 'a'].
+ self assert: first anySatisfy: [:e | e literal = 'b'].
+ self assert: first anySatisfy: [:e | (e isKindOf: PPCNotNode) and: [e child literal = 'c']].
!
testFirstComplex4
- tree := (('a' asParser / nil asParser / 'b' asParser), 'c' asParser not) wrapped asCompilerTree.
-
- first := (self first: tree).
-
- self assert: first anySatisfy: [:e | e literal = 'a'].
- self assert: first anySatisfy: [:e | e literal = 'b'].
- self assert: first anySatisfy: [:e | (e isKindOf: PPCNotNode) and: [ e child literal = 'c' ]].
- self assert: first noneMatchesType: PPCNilNode.
+ tree := self treeFrom: (('a' asParser / nil asParser / 'b' asParser), 'c' asParser not) wrapped.
+
+ first := (self first: tree).
+
+ self assert: first anySatisfy: [:e | e literal = 'a'].
+ self assert: first anySatisfy: [:e | e literal = 'b'].
+ self assert: first anySatisfy: [:e | (e isKindOf: PPCNotNode) and: [ e child literal = 'c' ]].
+ self assert: first noneMatchesType: PPCNilNode.
!
testFirstNegate1
- tree := ('a' asParser negate, 'b' asParser) asCompilerTree.
-
- first := self first: tree.
+ configuration arguments specialize: true.
+ tree := self treeFrom: ('a' asParser negate, 'b' asParser).
+
+ first := self first: tree.
- self assert: first size: 1.
- self assert: first anyMatchesType: PPCNotNode
+ self assert: first size: 1.
+ self assert: first anyMatchesType: PPCNotNode.
+ self assert: first anyOne child literal = 'a'.
!
testFirstNot
- tree := ('a' asParser not star, 'b' asParser) asCompilerTree.
-
- first := self first: tree.
-
- self assert: first size: 2.
- self assert: first anyMatchesType: PPCNotNode.
+ tree := self treeFrom: ('a' asParser not star, 'b' asParser).
+
+ first := self first: tree.
+
+ self assert: first size: 2.
+ self assert: first anyMatchesType: PPCNotNode.
+ self assert: first anyMatchesType: PPCLiteralNode.
!
testFirstNot2
- tree := ('a' asParser not star, 'b' asParser) asCompilerTree optimizeTree.
-
- first := self first: tree.
-
- self assert: first size: 2.
- self assert: first anyMatchesType: PPCNotLiteralNode.
- self assert: first anyMatchesType: PPCLiteralNode.
-!
-
-testFirstNot3
- tree := (#letter asParser not star, #letter asParser) asCompilerTree optimizeTree.
-
- first := self first: tree.
-
- self assert: first size: 2.
- self assert: first anyMatchesType: PPCNotMessagePredicateNode.
- self assert: first anyMatchesType: PPCMessagePredicateNode.
+ configuration arguments specialize: true.
+ tree := self treeFrom: (#letter asParser not star, #letter asParser).
+
+ first := self first: tree.
+
+ self assert: first size: 2.
+ self assert: first anyMatchesType: PPCNotNode.
+ self assert: first anyMatchesType: PPCPredicateNode.
!
testFirstNot4
- tree := (#letter asParser negate plus, #letter asParser) asCompilerTree optimizeTree.
-
- first := self first: tree.
-
- self assert: first size: 1.
- self assert: (first anyOne predicate value: $a) not.
- self assert: (first anyOne predicate value: $1).
+ tree := self treeFrom: (#letter asParser negate plus, #letter asParser).
+
+ first := self first: tree.
+
+ self assert: first size: 1.
+ self assert: (first anyOne predicate value: $a) not.
+ self assert: (first anyOne predicate value: $1).
!
testFirstNot5
- tree := (#letter asParser negate star, #letter asParser) asCompilerTree optimizeTree.
-
- first := self first: tree.
-
- self assert: first size: 2.
- self assert: first anySatisfy: [ :e | (e predicate value: $a) not ].
- self assert: first anySatisfy: [ :e | (e predicate value: $1) ].
+ tree := self treeFrom: (#letter asParser negate star, #letter asParser).
+
+ first := self first: tree.
+
+ self assert: first size: 2.
+ self assert: first anySatisfy: [ :e | (e predicate value: $a) not ].
+ self assert: first anySatisfy: [ :e | (e predicate value: $1) ].
- self assert: first anySatisfy: [ :e | (e predicate value: $a) ].
- self assert: first anySatisfy: [ :e | (e predicate value: $1) not ].
+ self assert: first anySatisfy: [ :e | (e predicate value: $a) ].
+ self assert: first anySatisfy: [ :e | (e predicate value: $1) not ].
!
testFirstOptional
- tree := 'a' asParser optional asCompilerTree.
-
- first := (self first: tree).
-
- self assert: first anyMatchesType: PPCNilNode.
- self assert: first anyMatchesType: PPCLiteralNode.
+ tree := 'a' asParser optional asCompilerTree.
+
+ first := (self first: tree).
+
+ self assert: first anyMatchesType: PPCNilNode.
+ self assert: first anyMatchesType: PPCLiteralNode.
!
testFirstOptional2
- tree := ('a' asParser optional, 'b' asParser) asCompilerTree.
-
- first := (self first: tree).
-
- self assert: first size: 2.
- self assert: first anySatisfy: [ :e | e literal = 'a' ].
- self assert: first anySatisfy: [ :e | e literal = 'b' ].
+ tree := ('a' asParser optional, 'b' asParser) asCompilerTree.
+
+ first := (self first: tree).
+
+ self assert: first size: 2.
+ self assert: first anySatisfy: [ :e | e literal = 'a' ].
+ self assert: first anySatisfy: [ :e | e literal = 'b' ].
!
testFirstRepeat1
- tree := ('a' asParser / nil asParser) plus asCompilerTree.
-
- first := self first: tree.
+ tree := ('a' asParser / nil asParser) plus asCompilerTree.
+
+ first := self first: tree.
- self assert: first anySatisfy: [:e | e literal = 'a' ].
- self assert: first anyMatchesType: PPCNilNode.
+ self assert: first anySatisfy: [:e | e literal = 'a' ].
+ self assert: first anyMatchesType: PPCNilNode.
!
testFirstRepeat2
- tree := ('a' asParser star, 'b' asParser) asCompilerTree.
-
- first := self first: tree.
+ tree := ('a' asParser star, 'b' asParser) asCompilerTree.
+
+ first := self first: tree.
- self assert: first anySatisfy: [:e | e literal = 'a' ].
- self assert: first anySatisfy: [:e | e literal = 'b' ].
+ self assert: first anySatisfy: [:e | e literal = 'a' ].
+ self assert: first anySatisfy: [:e | e literal = 'b' ].
!
testFirstRepeat3
- tree := ('a' asParser negate plus, 'b' asParser) asCompilerTree.
-
- first := self first: tree.
+ tree := ('a' asParser negate plus, 'b' asParser) asCompilerTree.
+
+ first := self first: tree.
- self assert: first size: 1.
- self assert: first anyMatchesType: PPCNotNode.
+ self assert: first size: 1.
+ self assert: first anyMatchesType: PPCNotNode.
!
testFirstRepeat4
- tree := ('a' asParser negate star, 'b' asParser) asCompilerTree.
-
- first := self first: tree.
+ tree := ('a' asParser negate star, 'b' asParser) asCompilerTree.
+
+ first := self first: tree.
- self assert: first size: 2.
- self assert: first anySatisfy: [:e | (e isKindOf: PPCNotNode) and: [e child literal = 'a']].
- self assert: first anySatisfy: [ :e | e literal = 'b' ]
+ self assert: first size: 2.
+ self assert: first anySatisfy: [:e | (e isKindOf: PPCNotNode) and: [e child literal = 'a']].
+ self assert: first anySatisfy: [ :e | e literal = 'b' ]
!
testFirstSequence1
- tree := self treeFrom: 'a' asParser, 'b' asParser .
-
- first := self first: tree.
-
- self assert: first size: 1.
- self assert: first anySatisfy: [ :e | e literal = 'a' ].
+ tree := self treeFrom: 'a' asParser, 'b' asParser .
+
+ first := self first: tree.
+
+ self assert: first size: 1.
+ self assert: first anySatisfy: [ :e | e literal = 'a' ].
!
testFirstSequence2
- tree := nil asParser, 'a' asParser, 'b' asParser .
-
- first := self first: tree.
-
- self assert: first size: 1.
- self assert: first anySatisfy: [ :e | e literal = 'a' ].
+ tree := nil asParser, 'a' asParser, 'b' asParser .
+
+ first := self first: tree.
+
+ self assert: first size: 1.
+ self assert: first anySatisfy: [ :e | e literal = 'a' ].
!
testFirstSequence3
- tree := self treeFrom: nil asParser, nil asParser.
-
- first := self first: tree.
-
- self assert: first size: 1.
- self assert: first anyMatchesType: PPCNilNode.
+ tree := self treeFrom: nil asParser, nil asParser.
+
+ first := self first: tree.
+
+ self assert: first size: 1.
+ self assert: first anyMatchesType: PPCNilNode.
!
testFirstSequence4
- tree := self treeFrom: ((nil asParser / 'a' asParser) plus), 'b' asParser.
-
- first := self first: tree.
-
- self assert: first size: 2.
- self assert: first anySatisfy: [ :e | e literal = 'a' ].
- self assert: first anySatisfy: [ :e | e literal = 'b' ].
- self assert: first noneMatchesType: PPCNilNode.
+ tree := self treeFrom: ((nil asParser / 'a' asParser) plus), 'b' asParser.
+
+ first := self first: tree.
+
+ self assert: first size: 2.
+ self assert: first anySatisfy: [ :e | e literal = 'a' ].
+ self assert: first anySatisfy: [ :e | e literal = 'b' ].
+ self assert: first noneMatchesType: PPCNilNode.
!
testFirstSequence5
- tree := ((nil asParser / 'a' asParser) star), 'b' asParser.
-
- first := self first: tree.
-
- self assert: first size: 2.
- self assert: first anySatisfy: [ :e | e literal = 'a' ].
- self assert: first anySatisfy: [ :e | e literal = 'b' ].
- self assert: first noneMatchesType: PPCNilNode.
+ tree := self treeFrom: ((nil asParser / 'a' asParser) star), 'b' asParser.
+
+ first := self first: tree.
+
+ self assert: first size: 2.
+ self assert: first anySatisfy: [ :e | e literal = 'a' ].
+ self assert: first anySatisfy: [ :e | e literal = 'b' ].
+ self assert: first noneMatchesType: PPCNilNode.
+!
+
+testFirstSequence6
+ configuration arguments specialize: true.
+ tree := self treeFrom: #space asParser star, 'a' asParser.
+
+ tree firstFollowCache: nil.
+ self should: [ self first: tree. ] raise: Exception.
+!
+
+testFirstSequence7
+ tree := self treeFrom: #space asParser star, 'a' asParser.
+
+ first := self first: tree.
+
+ self assert: first size: 2.
+ self assert: first anySatisfy: [ :e | e literal = 'a' ].
+ self assert: first anyMatchesType: PPCPredicateNode.
+!
+
+testFirstStarMessagePredicate
+ tree := self treeFrom: #space asParser star.
+
+ first := self first: tree.
+
+ self assert: first size: 2.
+ self assert: first anyMatchesType: PPCPredicateNode.
+ self assert: first anyMatchesType: PPCSentinelNode.
+!
+
+testFirstStarMessagePredicate2
+ configuration arguments specialize: true.
+ tree := self treeFrom: #space asParser star.
+
+ self should: [ self first: tree ] raise: Exception.
+
+
!
testFirstTerminal
- tree := self treeFrom: 'a' asParser not.
+ configuration arguments specialize: true.
+ tree := self treeFrom: 'a' asParser not.
- first := self first: tree.
-
- self assert: first size: 1.
- self assert: (self first: tree) anyMatchesType: PPCNotLiteralNode.
+ first := self first: tree.
+
+ self assert: first size: 1.
+ self assert: (self first: tree) anyMatchesType: PPCNotLiteralNode.
!
testFirstTerminal2
- tree := self treeFrom: 'a' asParser and.
-
- first := self first: tree.
-
- self assert: first size: 1.
- self assert: first anySatisfy: [: e | e literal = 'a' ]
+ tree := self treeFrom: 'a' asParser and.
+
+ first := self first: tree.
+
+ self assert: first size: 1.
+ self assert: first anySatisfy: [: e | e literal = 'a' ]
+!
+
+testFirstTrim
+ tree := self treeFrom: 'a' asParser trim.
+
+ first := self first: tree.
+
+ self assert: first size: 2.
+ self assert: first anyMatchesType: PPCLiteralNode.
+ self assert: first anyMatchesType: PPCMessagePredicateNode.
!
testFirstTrimmingToken
- tree := self treeFrom: 'a' asParser trimmingToken.
-
- first := self first: tree
- suchThat: [:e | (e isKindOf: PPCTrimmingTokenNode) or: [e isFirstSetTerminal]].
-
- self assert: first size: 1.
- self assert: first anyMatchesType: PPCTrimmingTokenNode
+ tree := self treeFrom: 'a' asParser token trim.
+
+ first := self first: tree.
+
+ self assert: first size: 1.
+ self assert: (self first: tree) anyMatchesType: PPCLiteralNode.
+! !
+
+!PPCNodeFirstFollowNextTests methodsFor:'testing - first production'!
+
+testFirstProduction1
+ tree := self treeFrom: ('a' asParser name: 'a'; yourself), 'b' asParser .
+
+ first := tree firstSetWithProductions.
+
+ self assert: first size: 1.
+ self assert: first anySatisfy: [ :e | e literal = 'a' ].
!
+testFirstProduction2
+ tree := self treeFrom: ('a' asParser name: nil; yourself), 'b' asParser .
+
+ first := tree firstSetWithProductions.
+
+ self assert: first isEmpty.
+!
+
+testFirstProduction3
+ | foo bar |
+ foo := 'foo' asParser name: 'foo'; yourself.
+ bar := 'bar' asParser.
+
+ tree := self treeFrom: (foo, bar) / foo.
+
+ first := tree firstSetWithProductions.
+
+ self assert: first size = 1.
+ self assert: first anyOne name = 'foo'.
+! !
+
+!PPCNodeFirstFollowNextTests methodsFor:'testing - follow'!
+
testFollowSet1
- node := 'a' asParser name: 'node'; yourself.
- tree := self treeFrom: (node star, 'b' asParser).
-
- followSet := self followOfNodeIn: tree.
-
- self assert: followSet size: 2.
- self assert: followSet anySatisfy: [:e | e literal = 'a'].
- self assert: followSet anySatisfy: [:e | e literal = 'b'].
+ node := 'a' asParser name: 'node'; yourself.
+ tree := self treeFrom: (node star, 'b' asParser).
+
+ followSet := self followOfNodeIn: tree.
+
+ self assert: followSet size: 2.
+ self assert: followSet anySatisfy: [:e | e literal = 'a'].
+ self assert: followSet anySatisfy: [:e | e literal = 'b'].
!
testFollowSet10
- | a b c |
-
- a := 'a' asParser name: 'a'; yourself.
- b := 'b' asParser optional name: 'b'; yourself.
- c := 'c' asParser name: 'c'; yourself.
-
-
-
- tree := self treeFrom: a plus, b, c.
+ | a b c |
+
+ a := 'a' asParser name: 'a'; yourself.
+ b := 'b' asParser optional name: 'b'; yourself.
+ c := 'c' asParser name: 'c'; yourself.
+
+
+
+ tree := self treeFrom: a plus, b, c.
- followSet := self followOf: 'a' in: tree.
+ followSet := self followOf: 'a' in: tree.
- self assert: followSet size: 3.
- self assert: followSet anySatisfy: [:e | e literal = 'a' ].
- self assert: followSet anySatisfy: [:e | e literal = 'b' ].
- self assert: followSet anySatisfy: [:e | e literal = 'c' ].
+ self assert: followSet size: 3.
+ self assert: followSet anySatisfy: [:e | e literal = 'a' ].
+ self assert: followSet anySatisfy: [:e | e literal = 'b' ].
+ self assert: followSet anySatisfy: [:e | e literal = 'c' ].
!
testFollowSet2
- | follow |
- node := 'a' asParser name: 'node'; yourself.
- follow := 'b' asParser, 'c' asParser.
-
- tree := self treeFrom: (node, follow).
+ | follow |
+ node := 'a' asParser name: 'node'; yourself.
+ follow := 'b' asParser, 'c' asParser.
+
+ tree := self treeFrom: (node, follow).
- followSet := self followOfNodeIn: tree.
+ followSet := self followOfNodeIn: tree.
- self assert: followSet size: 1.
- self assert: followSet anySatisfy: [:e | e literal = 'b'].
- self assert: followSet noneSatisfy: [:e | e literal = 'c'].
+ self assert: followSet size: 1.
+ self assert: followSet anySatisfy: [:e | e literal = 'b'].
+ self assert: followSet noneSatisfy: [:e | e literal = 'c'].
!
testFollowSet3
- | follow |
+ | follow |
- node := 'a' asParser name: 'node'; yourself.
- follow := ('b' asParser, 'c' asParser) / ('d' asParser).
-
-
- tree := self treeFrom: (node, follow).
+ node := 'a' asParser name: 'node'; yourself.
+ follow := ('b' asParser, 'c' asParser) / ('d' asParser).
+
+
+ tree := self treeFrom: (node, follow).
- followSet := self followOfNodeIn: tree.
+ followSet := self followOfNodeIn: tree.
- self assert: followSet size: 2.
- self assert: followSet anySatisfy: [:e | e literal = 'b' ].
- self assert: followSet anySatisfy: [:e | e literal = 'd' ].
+ self assert: followSet size: 2.
+ self assert: followSet anySatisfy: [:e | e literal = 'b' ].
+ self assert: followSet anySatisfy: [:e | e literal = 'd' ].
!
testFollowSet4
- | follow |
+ | follow |
- node := 'a' asParser name: 'node'; yourself.
- follow := ('b' asParser, 'c' asParser).
-
-
- tree := self treeFrom: (node star, follow).
+ node := 'a' asParser name: 'node'; yourself.
+ follow := ('b' asParser, 'c' asParser).
+
+
+ tree := self treeFrom: (node star, follow).
- followSet := self followOfNodeIn: tree.
+ followSet := self followOfNodeIn: tree.
- self assert: followSet anySatisfy: [:e | e literal = 'b' ].
- self assert: followSet anySatisfy: [:e | e literal = 'a' ].
+ self assert: followSet anySatisfy: [:e | e literal = 'b' ].
+ self assert: followSet anySatisfy: [:e | e literal = 'a' ].
!
testFollowSet5
- | follow1 follow2 |
+ | follow1 follow2 |
- node := 'a' asParser name: 'node'; yourself.
- follow1 := ('b' asParser, 'c' asParser) / nil asParser.
- follow2 := 'd' asParser.
-
-
- tree := self treeFrom: (node, follow1, follow2).
+ node := 'a' asParser name: 'node'; yourself.
+ follow1 := ('b' asParser, 'c' asParser) / nil asParser.
+ follow2 := 'd' asParser.
+
+
+ tree := self treeFrom: (node, follow1, follow2).
- followSet := self followOfNodeIn: tree.
+ followSet := self followOfNodeIn: tree.
- self assert: followSet anySatisfy: [:e | e literal = 'b' ].
- self assert: followSet anySatisfy: [:e | e literal = 'd' ].
+ self assert: followSet anySatisfy: [:e | e literal = 'b' ].
+ self assert: followSet anySatisfy: [:e | e literal = 'd' ].
!
testFollowSet6
- | follow follow1 follow2 |
+ | follow follow1 follow2 |
- node := 'a' asParser name: 'node'; yourself.
- follow1 := ('b' asParser, 'c' asParser) / nil asParser.
- follow2 := 'd' asParser.
-
- follow := (follow1, follow2).
-
- tree := self treeFrom: (node, follow).
+ node := 'a' asParser name: 'node'; yourself.
+ follow1 := ('b' asParser, 'c' asParser) / nil asParser.
+ follow2 := 'd' asParser.
+
+ follow := (follow1, follow2).
+
+ tree := self treeFrom: (node, follow).
- followSet := self followOfNodeIn: tree.
+ followSet := self followOfNodeIn: tree.
- self assert: followSet anySatisfy: [:e | e literal = 'b' ].
- self assert: followSet anySatisfy: [:e | e literal = 'd' ].
+ self assert: followSet anySatisfy: [:e | e literal = 'b' ].
+ self assert: followSet anySatisfy: [:e | e literal = 'd' ].
!
testFollowSet7
- | r1 r2 follow1 follow2 |
+ | r1 r2 follow1 follow2 |
- node := 'a' asParser name: 'node'; yourself.
- follow1 := ('b' asParser, 'c' asParser) / nil asParser.
- follow2 := 'd' asParser / nil asParser .
-
- r1 := (node, follow1).
- r2 := (r1, follow2).
-
- tree := self treeFrom: r2.
+ node := 'a' asParser name: 'node'; yourself.
+ follow1 := ('b' asParser, 'c' asParser) / nil asParser.
+ follow2 := 'd' asParser / nil asParser .
+
+ r1 := (node, follow1).
+ r2 := (r1, follow2).
+
+ tree := self treeFrom: r2.
- followSet := self followOfNodeIn: tree.
+ followSet := self followOfNodeIn: tree.
- self assert: followSet anySatisfy: [:e | e literal = 'b' ].
- self assert: followSet anySatisfy: [:e | e literal = 'd' ].
+ self assert: followSet anySatisfy: [:e | e literal = 'b' ].
+ self assert: followSet anySatisfy: [:e | e literal = 'd' ].
!
testFollowSet8
- node := 'a' asParser name: 'node'; yourself.
- tree := self treeFrom: node.
-
- followSet := self followOfNodeIn: tree.
+ node := 'a' asParser name: 'node'; yourself.
+ tree := self treeFrom: node.
+
+ followSet := self followOfNodeIn: tree.
- self assert: followSet anyMatchesType: PPCNilNode.
+ self assert: followSet anyMatchesType: PPCNilNode.
!
testFollowSet9
- | a b c |
-
- a := 'a' asParser name: 'a'; yourself.
- b := 'b' asParser optional name: 'b'; yourself.
- c := 'c' asParser name: 'c'; yourself.
-
-
- tree := self treeFrom: a, b, c.
- followSet := self followOf: 'c' in: tree.
- self assert: followSet anyMatchesType: PPCNilNode.
-
- followSet := self followOf: 'b' in: tree.
- self assert: followSet anySatisfy: [:e | e literal = 'c' ].
+ | a b c |
+
+ a := 'a' asParser name: 'a'; yourself.
+ b := 'b' asParser optional name: 'b'; yourself.
+ c := 'c' asParser name: 'c'; yourself.
+
+
+ tree := self treeFrom: a, b, c.
+ followSet := self followOf: 'c' in: tree.
+ self assert: followSet anyMatchesType: PPCNilNode.
+
+ followSet := self followOf: 'b' in: tree.
+ self assert: followSet anySatisfy: [:e | e literal = 'c' ].
- followSet := self followOf: 'a' in: tree.
- self assert: followSet anySatisfy: [:e | e literal = 'b' ].
- self assert: followSet anySatisfy: [:e | e literal = 'c' ].
+ followSet := self followOf: 'a' in: tree.
+ self assert: followSet anySatisfy: [:e | e literal = 'b' ].
+ self assert: followSet anySatisfy: [:e | e literal = 'c' ].
!
testFollowSetChoice1
- | follow |
+ | follow |
- node := 'a' asParser name: 'node'; yourself.
- follow := 'b' asParser / 'c' asParser .
-
- tree := self treeFrom: node, follow.
+ node := 'a' asParser name: 'node'; yourself.
+ follow := 'b' asParser / 'c' asParser .
+
+ tree := self treeFrom: node, follow.
- followSet := self followOfNodeIn: tree.
+ followSet := self followOfNodeIn: tree.
- self assert: followSet size: 2.
- self assert: followSet anySatisfy: [:e | e literal = 'b' ].
- self assert: followSet anySatisfy: [:e | e literal = 'c' ].
+ self assert: followSet size: 2.
+ self assert: followSet anySatisfy: [:e | e literal = 'b' ].
+ self assert: followSet anySatisfy: [:e | e literal = 'c' ].
!
testFollowSetOptional1
- | follow1 follow2 |
+ | follow1 follow2 |
- node := 'a' asParser name: 'node'; yourself.
- follow1 := 'b' asParser optional.
- follow2 := 'c' asParser.
-
- tree := self treeFrom: node, follow1, follow2.
+ node := 'a' asParser name: 'node'; yourself.
+ follow1 := 'b' asParser optional.
+ follow2 := 'c' asParser.
+
+ tree := self treeFrom: node, follow1, follow2.
- followSet := self followOfNodeIn: tree.
+ followSet := self followOfNodeIn: tree.
- self assert: followSet size: 2.
- self assert: followSet anySatisfy: [:e | e literal = 'b'].
- self assert: followSet anySatisfy: [:e | e literal = 'c'].
+ self assert: followSet size: 2.
+ self assert: followSet anySatisfy: [:e | e literal = 'b'].
+ self assert: followSet anySatisfy: [:e | e literal = 'c'].
!
testFollowSetRepeat1
- node := 'a' asParser name: 'node'; yourself.
- tree := self treeFrom: node plus.
-
- followSet := self followOfNodeIn: tree.
-
- self assert: followSet anySatisfy: [:e | e literal = 'a' ].
- self assert: followSet anyMatchesType: PPCNilNode
+ node := 'a' asParser name: 'node'; yourself.
+ tree := self treeFrom: node plus.
+
+ followSet := self followOfNodeIn: tree.
+
+ self assert: followSet anySatisfy: [:e | e literal = 'a' ].
+ self assert: followSet anyMatchesType: PPCNilNode
!
testFollowSetRepeat2
- node := 'a' asParser.
- tree := self treeFrom: (node plus name: 'node'; yourself).
-
- followSet := self followOfNodeIn: tree.
-
- self assert: followSet size: 1.
- self assert: followSet anyMatchesType: PPCNilNode
+ node := 'a' asParser.
+ tree := self treeFrom: (node plus name: 'node'; yourself).
+
+ followSet := self followOfNodeIn: tree.
+
+ self assert: followSet size: 1.
+ self assert: followSet anyMatchesType: PPCNilNode
!
testFollowTrimmingToken
- | token1 token2 |
-
- token1 := #letter asParser plus trimmingToken name: 'token1'; yourself.
- token2 := #letter asParser plus trimmingToken name: 'token2'; yourself.
-
-
- tree := self treeFrom: token1, token2.
- followSet := self followOf: 'token1'
- in: tree
- suchThat: [:e | e isFirstSetTerminal or: [e isKindOf: PPCTrimmingTokenNode ]].
+ | token1 token2 |
+ configuration arguments specialize: false.
+ token1 := #letter asParser plus trimmingToken name: 'token1'; yourself.
+ token2 := #letter asParser plus trimmingToken name: 'token2'; yourself.
+
+
+ tree := self treeFrom: token1, token2.
+ followSet := self followOf: 'token1'
+ in: tree
+ suchThat: [:e | e isFirstSetTerminal or: [e isKindOf: PPCTrimmingTokenNode ]].
- self assert: followSet size: 1.
- self assert: followSet anyMatchesType: PPCTrimmingTokenNode.
-!
-
-treeFrom: parser
- ^ parser asCompilerTree optimizeTree
+ self assert: followSet size: 1.
+ self assert: followSet anyMatchesType: PPCTrimmingTokenNode.
! !
--- a/compiler/tests/PPCNodeTest.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPCNodeTest.st Sun May 10 06:28:36 2015 +0100
@@ -3,7 +3,7 @@
"{ NameSpace: Smalltalk }"
TestCase subclass:#PPCNodeTest
- instanceVariableNames:'node'
+ instanceVariableNames:'node configuration'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Tests-Nodes'
@@ -12,252 +12,547 @@
!PPCNodeTest methodsFor:'as yet unclassified'!
+testAllNodesDo1
+ | node1 node2 parser allChildren |
+ node1 := #letter asParser asCompilerNode.
+ node2 := #letter asParser asCompilerNode.
+ parser := PPChoiceParser new
+ setParsers: { node1 . node2 };
+ yourself.
+
+ node := PPCUnknownNode new
+ parser: parser;
+ yourself.
+
+ self assert: node parser children first == node1.
+ self assert: node parser children second == node2.
+
+ allChildren := OrderedCollection new.
+ node allNodesDo: [ :e |
+ allChildren add: e.
+ ].
+ self assert: allChildren size = 3.
+
+!
+
testCopy
- | newNode |
- node := PPCDelegateNode new
- child: #foo;
- yourself.
- newNode := node copy.
- self assert: (node = newNode).
- self assert: (node hash = newNode hash).
-
- newNode child: #bar.
- self assert: (node = newNode) not.
+ | newNode |
+ node := PPCDelegateNode new
+ child: #foo;
+ yourself.
+ newNode := node copy.
+ self assert: (node = newNode).
+ self assert: (node hash = newNode hash).
+
+ newNode child: #bar.
+ self assert: (node = newNode) not.
!
testCopy2
- | newNode |
- node := PPCSequenceNode new
- children: { #foo . #bar }
- yourself.
- newNode := node copy.
+ | newNode |
+ node := PPCSequenceNode new
+ children: { #foo . #bar }
+ yourself.
+ newNode := node copy.
- self assert: (node = newNode).
- self assert: (node hash = newNode hash).
-
- node children at: 1 put: #zorg.
- self assert: (node = newNode) not.
+ self assert: (node = newNode).
+ self assert: (node hash = newNode hash).
+
+ node children at: 1 put: #zorg.
+ self assert: (node = newNode) not.
!
testCopy3
- | newNode |
- node := PPCMessagePredicateNode new
- predicate: #block;
- message: #message;
- yourself.
-
- newNode := node copy.
-
- self assert: (node == newNode) not.
- self assert: (node = newNode).
- self assert: node hash = newNode hash.
+ | newNode |
+ node := PPCMessagePredicateNode new
+ predicate: #block;
+ message: #message;
+ yourself.
+
+ newNode := node copy.
+
+ self assert: (node == newNode) not.
+ self assert: (node = newNode).
+ self assert: node hash = newNode hash.
!
testCopy4
- | node1 node2 |
- node1 := #letter asParser asCompilerNode.
- node2 := #letter asParser asCompilerNode.
-
- self assert: (node == node2) not.
- self assert: (node1 = node2).
- self assert: node1 hash = node2 hash.
+ | node1 node2 |
+ node1 := #letter asParser asCompilerNode.
+ node2 := #letter asParser asCompilerNode.
+
+ self assert: (node == node2) not.
+ self assert: (node1 = node2).
+ self assert: node1 hash = node2 hash.
+!
+
+testCopy5
+ | node1 newNode |
+ node1 := #letter asParser asCompilerNode.
+
+ node := PPCUnknownNode new
+ parser: node1;
+ yourself.
+
+ self assert: node parser == node1.
+ newNode := node copy.
+ self assert: (newNode parser == node1) not.
+ self assert: newNode parser = node1.
!
testEquals
- self assert: (PPCNode new = PPCNode new).
+ self assert: (PPCNode new = PPCNode new).
!
testEquals2
- | n1 n2 n3 |
- n1 := PPCDelegateNode new
- child: #foo;
- yourself.
- n2 := PPCDelegateNode new
- child: #bar;
- yourself.
- n3 := PPCDelegateNode new
- child: #foo;
- yourself.
-
- self assert: (n1 = n3).
- self assert: (n1 = n2) not.
+ | n1 n2 n3 |
+ n1 := PPCDelegateNode new
+ child: #foo;
+ yourself.
+ n2 := PPCDelegateNode new
+ child: #bar;
+ yourself.
+ n3 := PPCDelegateNode new
+ child: #foo;
+ yourself.
+
+ self assert: (n1 = n3).
+ self assert: (n1 = n2) not.
!
testReplaceNode
- | literalNode anotherLiteralNode |
- literalNode := PPCLiteralNode new
- literal: 'foo';
- yourself.
-
- anotherLiteralNode := PPCLiteralNode new
- literal: 'bar';
- yourself.
-
- node := PPCForwardNode new
- child: literalNode;
- yourself.
-
- self assert: node child == literalNode.
- node replace: literalNode with: anotherLiteralNode.
- self assert: node child == anotherLiteralNode.
- self assert: (node child == literalNode) not.
+ | literalNode anotherLiteralNode |
+ literalNode := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+
+ anotherLiteralNode := PPCLiteralNode new
+ literal: 'bar';
+ yourself.
+
+ node := PPCForwardNode new
+ child: literalNode;
+ yourself.
+
+ self assert: node child == literalNode.
+ node replace: literalNode with: anotherLiteralNode.
+ self assert: node child == anotherLiteralNode.
+ self assert: (node child == literalNode) not.
! !
!PPCNodeTest methodsFor:'test support'!
assert: object type: class
- self assert: object class == class
+ self assert: object class == class
+!
+
+setUp
+ configuration := PPCConfiguration default.
+ configuration arguments generate: false.
+!
+
+treeFrom: parser
+ ^ parser compileWithConfiguration: configuration
! !
!PPCNodeTest methodsFor:'tests - converting'!
testConvertBlock
- | parser tree |
- parser := [ :ctx | [ctx atEnd] whileFalse ] asParser.
- tree := parser asCompilerTree.
-
- self assert: tree type: PPCPluggableNode.
- self assert: tree block asString = '[ :ctx | [ ctx atEnd ] whileFalse ]'.
+ | parser tree |
+ parser := [ :ctx | [ctx atEnd] whileFalse ] asParser.
+ tree := parser asCompilerTree.
+
+ self assert: tree type: PPCPluggableNode.
+ self assert: tree block asString = '[ :ctx | [ ctx atEnd ] whileFalse ]'.
!
testConvertChoice
- | parser tree |
- parser := 'foo' asParser / $b asParser.
- tree := parser asCompilerTree.
-
- self assert: tree type: PPCChoiceNode.
- self assert: tree children size = 2.
- self assert: tree children first type: PPCLiteralNode.
- self assert: tree children second type: PPCCharacterNode.
+ | parser tree |
+ parser := 'foo' asParser / $b asParser.
+ tree := parser asCompilerTree.
+
+ self assert: tree type: PPCChoiceNode.
+ self assert: tree children size = 2.
+ self assert: tree children first type: PPCLiteralNode.
+ self assert: tree children second type: PPCCharacterNode.
!
testConvertNil
- | parser tree |
- parser := nil asParser.
- tree := parser asCompilerTree.
-
- self assert: tree type: PPCNilNode.
+ | parser tree |
+ parser := nil asParser.
+ tree := parser asCompilerTree.
+
+ self assert: tree type: PPCNilNode.
!
testConvertSequence
- | parser tree |
- parser := 'foo' asParser, $b asParser.
- tree := parser asCompilerTree.
-
- self assert: tree type: PPCSequenceNode.
- self assert: tree children size = 2.
- self assert: tree children first type: PPCLiteralNode.
- self assert: tree children second type: PPCCharacterNode.
+ | parser tree |
+ parser := 'foo' asParser, $b asParser.
+ tree := parser asCompilerTree.
+
+ self assert: tree type: PPCSequenceNode.
+ self assert: tree children size = 2.
+ self assert: tree children first type: PPCLiteralNode.
+ self assert: tree children second type: PPCCharacterNode.
!
testConvertToken
- | parser tree |
- parser := 'foo' asParser token.
- tree := parser asCompilerTree.
-
- self assert: tree type: PPCTokenNode.
- self assert: tree child type: PPCLiteralNode.
+ | parser tree |
+ parser := 'foo' asParser token.
+ tree := parser asCompilerTree.
+
+ self assert: tree type: PPCTokenNode.
+ self assert: tree child type: PPCLiteralNode.
- parser := ('foo' asParser, $b asParser) token.
- tree := parser asCompilerTree.
-
- self assert: tree type: PPCTokenNode.
- self assert: tree child type: PPCSequenceNode.
-
- parser := $d asParser token star.
- tree := parser asCompilerTree.
-
- self assert: tree type: PPCStarNode.
- self assert: tree child type: PPCTokenNode.
- self assert: tree child child type: PPCCharacterNode.
+ parser := ('foo' asParser, $b asParser) token.
+ tree := parser asCompilerTree.
+
+ self assert: tree type: PPCTokenNode.
+ self assert: tree child type: PPCSequenceNode.
+
+ parser := $d asParser token star.
+ tree := parser asCompilerTree.
+
+ self assert: tree type: PPCStarNode.
+ self assert: tree child type: PPCTokenNode.
+ self assert: tree child child type: PPCCharacterNode.
!
testConvertTrimmingToken
- | parser tree |
- parser := 'foo' asParser trimmingToken.
- tree := parser asCompilerTree optimizeTree.
-
- self assert: tree type: PPCTrimmingTokenNode.
- self assert: tree child type: PPCLiteralNode.
- self assert: tree child isMarkedForInline.
- self assert: (tree whitespace allNodes allSatisfy: [ :n | n isKindOf: PPCNode ]).
+ | parser tree |
+ parser := 'foo' asParser trimmingToken.
+ tree := self treeFrom: parser.
+
+ self assert: tree type: PPCTrimmingTokenNode.
+ self assert: tree child type: PPCLiteralNode.
+ self assert: tree child isMarkedForInline.
+ self assert: (tree whitespace allNodes allSatisfy: [ :n | n isKindOf: PPCNode ]).
!
testConvertTrimmingToken2
- | parser tree |
- parser := ('foo' asParser, $b asParser) trimmingToken.
- tree := parser asCompilerTree optimizeTree.
-
- self assert: tree type: PPCTrimmingTokenNode.
- self assert: tree child type: PPCTokenSequenceNode.
- self assert: tree whitespace type: PPCTokenStarSeparatorNode.
- self assert: tree whitespace isMarkedForInline.
+ | parser tree |
+ parser := ('foo' asParser, $b asParser) trimmingToken.
+ tree := self treeFrom: parser.
+
+ self assert: tree type: PPCTrimmingTokenNode.
+ self assert: tree child type: PPCRecognizingSequenceNode.
+ self assert: tree whitespace type: PPCTokenStarSeparatorNode.
+ self assert: tree whitespace isMarkedForInline.
!
testConvertTrimmingToken3
- | parser tree |
-
- parser := $d asParser trimmingToken star.
- tree := parser asCompilerTree optimizeTree.
-
- self assert: tree type: PPCStarNode.
- self assert: tree child type: PPCTrimmingTokenNode.
- self assert: tree child child type: PPCCharacterNode.
- self assert: tree child child isMarkedForInline.
+ | parser tree |
+
+ parser := $d asParser trimmingToken star.
+ tree := self treeFrom: parser.
+
+ self assert: tree type: PPCStarNode.
+ self assert: tree child type: PPCTrimmingTokenNode.
+ self assert: tree child child type: PPCCharacterNode.
+ self assert: tree child child isMarkedForInline.
! !
!PPCNodeTest methodsFor:'tests - epsilon'!
testActionAcceptsEpsilon
- | tree |
- tree := ('foo' asParser token optional ==> [ :e | e ]) asCompilerTree.
- self assert: tree acceptsEpsilon.
+ | tree |
+ tree := ('foo' asParser token optional ==> [ :e | e ]) asCompilerTree.
+ self assert: tree acceptsEpsilon.
!
testChoiceAcceptsEpsilon
- | tree |
- tree := ($a asParser / $b asParser star) asCompilerTree.
- self assert: tree acceptsEpsilon.
+ | tree |
+ tree := ($a asParser / $b asParser star) asCompilerTree.
+ self assert: tree acceptsEpsilon.
!
testLiteralAcceptsEpsilon
- | tree |
- tree := 'foo' asParser asCompilerTree.
- self assert: tree acceptsEpsilon not.
-
- tree := '' asParser asCompilerTree.
- self assert: tree acceptsEpsilon.
+ | tree |
+ tree := 'foo' asParser asCompilerTree.
+ self assert: tree acceptsEpsilon not.
+
+ tree := '' asParser asCompilerTree.
+ self assert: tree acceptsEpsilon.
!
testPlusAcceptsEpsilon
- | tree |
- tree := ($b asParser plus) asCompilerTree.
- self assert: tree acceptsEpsilon not.
-
- tree := #letter asParser plus asCompilerTree.
- self assert: tree acceptsEpsilon not.
+ | tree |
+ tree := ($b asParser plus) asCompilerTree.
+ self assert: tree acceptsEpsilon not.
+
+ tree := #letter asParser plus asCompilerTree.
+ self assert: tree acceptsEpsilon not.
!
testSequenceAcceptsEpsilon
- | tree parser |
- parser := 'foo' asParser token optional, 'bar' asParser token star, ($a asParser / $b asParser star).
- tree := parser asCompilerTree.
- self assert: tree acceptsEpsilon.
+ | tree parser |
+ parser := 'foo' asParser token optional, 'bar' asParser token star, ($a asParser / $b asParser star).
+ tree := parser asCompilerTree.
+ self assert: tree acceptsEpsilon.
!
testStarAcceptsEpsilon
- | tree |
- tree := $b asParser star asCompilerTree.
- self assert: tree acceptsEpsilon.
+ | tree |
+ tree := $b asParser star asCompilerTree.
+ self assert: tree acceptsEpsilon.
!
testTokenAcceptsEpsilon
- | tree |
- tree := ($a asParser / $b asParser plus) token asCompilerTree.
- self assert: tree acceptsEpsilon not.
-
- tree := ($a asParser / $b asParser star) token asCompilerTree.
- self assert: tree acceptsEpsilon.
+ | tree |
+ tree := ($a asParser / $b asParser plus) token asCompilerTree.
+ self assert: tree acceptsEpsilon not.
+
+ tree := ($a asParser / $b asParser star) token asCompilerTree.
+ self assert: tree acceptsEpsilon.
+!
+
+testTrimNode
+ | tree |
+ tree := $a asParser trim asCompilerTree.
+ self assert: tree type: PPCTrimNode.
+ self assert: tree child type: PPCCharacterNode.
+ self assert: tree trimmer type: PPCStarNode.
+! !
+
+!PPCNodeTest methodsFor:'tests - recognized sentences'!
+
+assert: array anySatisfy: block
+ self assert: (array anySatisfy: block)
+!
+
+testOverlapCharacterNode
+ | node1 node2 |
+ node1 := $a asParser asCompilerTree.
+ node2 := $b asParser asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2) not.
+!
+
+testOverlapCharacterNode2
+ | node1 node2 |
+ node1 := $a asParser asCompilerTree.
+ node2 := $a asParser asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2).
+!
+
+testOverlapNode1
+ | node1 node2 |
+ node1 := $a asParser asCompilerTree.
+ node2 := $a asParser asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2).
+!
+
+testOverlapNode2
+ | node1 node2 |
+ node1 := $a asParser asCompilerTree.
+ node2 := 'a' asParser asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2).
+!
+
+testOverlapNode3
+ | node1 node2 |
+ node1 := ($a asParser / $b asParser) asCompilerTree.
+ node2 := ('c' asParser / 'd' asParser) asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2) not.
+!
+
+testOverlapNode4
+ | node1 node2 |
+ node1 := ($a asParser / $b asParser) asCompilerTree.
+ node2 := ('c' asParser / #any asParser) asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2).
+!
+
+testOverlapNode5
+ | node1 node2 |
+ node1 := ($a asParser, $b asParser) asCompilerTree.
+ node2 := ('ab' asParser) asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2).
+!
+
+testOverlapNode6
+ | node1 node2 |
+ node1 := ($a asParser, $b asParser, $c asParser) asCompilerTree.
+ node2 := ('ab' asParser) asCompilerTree.
+
+ self flag: 'Not sure about this test...'.
+ self assert: (node1 overlapsWith: node2) not.
+!
+
+testOverlapNode7
+ | node1 node2 |
+ node1 := ($a asParser) asCompilerTree.
+ node2 := (#digit asParser) asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2) not.
+!
+
+testOverlapNode8
+ | node1 node2 |
+ node1 := ($a asParser) asCompilerTree.
+ node2 := (#digit asParser plus) asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2) not.
+!
+
+testOverlapNode9
+ | node1 node2 |
+ node1 := ($a asParser) asCompilerTree.
+ node2 := (#letter asParser plus) asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2).
+!
+
+testOverlapTokenNode
+ | node1 node2 |
+ node1 := $a asParser token asCompilerTree.
+ node2 := $b asParser token asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2) not.
+!
+
+testOverlapTokenNode2
+ | node1 node2 |
+ node1 := $a asParser token asCompilerTree.
+ node2 := $a asParser token asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2).
+!
+
+testOverlapTrimmingTokenNode
+ | node1 node2 |
+ node1 := $a asParser token trim asCompilerTree.
+ node2 := $b asParser token trim asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2) not.
+!
+
+testOverlapTrimmingTokenNode1
+ | node1 node2 |
+ node1 := PPCTrimmingTokenNode new
+ child: (PPCCharacterNode new character: $a; yourself);
+ yourself.
+ node2 := PPCTrimmingTokenNode new
+ child: (PPCCharacterNode new character: $b; yourself);
+ yourself.
+
+ self assert: (node1 overlapsWith: node2) not.
+!
+
+testOverlapTrimmingTokenNode2
+ | node1 node2 |
+ node1 := PPCTrimmingTokenNode new
+ child: (PPCCharacterNode new character: $a; yourself);
+ yourself.
+ node2 := PPCTrimmingTokenNode new
+ child: (PPCCharacterNode new character: $a; yourself);
+ yourself.
+
+ self assert: (node1 overlapsWith: node2).
+!
+
+testRSCharacterNode
+ | sentences |
+ node := PPCCharacterNode new
+ character: $f;
+ yourself.
+
+ self assert: node hasFiniteLanguage.
+
+ sentences := node recognizedSentences.
+ self assert: sentences size = 1.
+ self assert: sentences anyOne = 'f'.
+!
+
+testRSChoiceNode
+ | sentences |
+ node := ('a' asParser / 'b' asParser) asCompilerTree.
+
+ self assert: node hasFiniteLanguage.
+
+ sentences := node recognizedSentences.
+ self assert: sentences size = 2.
+ self assert: sentences anySatisfy: [ :e | e = 'a' ].
+ self assert: sentences anySatisfy: [ :e | e = 'b' ].
+!
+
+testRSChoiceNode2
+ | sentences |
+ node := ('a' asParser / 'a' asParser) asCompilerTree.
+
+ self assert: node hasFiniteLanguage.
+
+ sentences := node recognizedSentences.
+ self assert: sentences size = 1.
+ self assert: sentences anySatisfy: [ :e | e = 'a' ].
+!
+
+testRSLiteralNode
+ | sentences |
+ node := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+ self assert: node hasFiniteLanguage.
+
+ sentences := node recognizedSentences.
+ self assert: sentences size = 1.
+ self assert: sentences anyOne = 'foo'.
+!
+
+testRSPredicateNode
+ | sentences |
+ node := PPCPredicateNode new
+ predicate: (PPCharSetPredicate on: [:e | e isDigit]);
+ yourself.
+
+ self assert: node hasFiniteLanguage.
+
+ sentences := node recognizedSentences.
+ self assert: sentences size = 10.
+ self assert: sentences anySatisfy: [ :e | e = '0' ].
+!
+
+testRSSequenceNode
+ | sentences |
+ node := ('a' asParser, 'b' asParser) asCompilerTree.
+
+ self assert: node hasFiniteLanguage.
+
+ sentences := node recognizedSentences.
+ self assert: sentences size = 1.
+ self assert: sentences anySatisfy: [ :e | e = 'ab' ].
+!
+
+testRSSequenceNode2
+ | sentences |
+ node := ('a' asParser, ('b' asParser / 'c' asParser)) asCompilerTree.
+
+ self assert: node hasFiniteLanguage.
+
+ sentences := node recognizedSentences.
+ self assert: sentences size = 2.
+ self assert: sentences anySatisfy: [ :e | e = 'ab' ].
+ self assert: sentences anySatisfy: [ :e | e = 'ac' ].
+!
+
+testRSSequenceNode3
+ | sentences |
+ node := (#digit asParser, #digit asParser) asCompilerTree.
+
+ self assert: node hasFiniteLanguage.
+
+ sentences := node recognizedSentences.
+ self assert: sentences size = 100.
+ self assert: sentences anySatisfy: [ :e | e = '00' ].
+ self assert: sentences anySatisfy: [ :e | e = '99' ].
+ self assert: sentences anySatisfy: [ :e | e = '38' ].
+
! !
!PPCNodeTest class methodsFor:'documentation'!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCOptimizeChoicesTest.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,44 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCOptimizeChoicesTest
+ instanceVariableNames:'node result visitor configuration'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Visitors'
+!
+
+!PPCOptimizeChoicesTest methodsFor:'as yet unclassified'!
+
+asPPCTree: parser
+ ^ parser compileWithConfiguration: configuration
+!
+
+setUp
+ | arguments |
+ super setUp.
+
+ visitor := PPCOptimizeChoices new.
+
+ arguments := PPCArguments default
+ profile: true.
+
+ configuration := PPCPluggableConfiguration on: [ :_self |
+ _self toPPCIr.
+ _self cacheFirstFollow.
+ ].
+ configuration arguments: arguments.
+
+!
+
+testHasCommonPrefix
+ | foo bar |
+ foo := 'foo' asParser name: 'foo'; yourself.
+ bar := 'bar' asParser.
+
+ node := self asPPCTree: (foo, bar) / foo.
+
+ self assert: (visitor hasCommonPrefix: node children).
+! !
+
--- a/compiler/tests/PPCOptimizingTest.st Thu Apr 30 23:43:14 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,355 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
-
-"{ NameSpace: Smalltalk }"
-
-TestCase subclass:#PPCOptimizingTest
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Tests-Nodes'
-!
-
-
-!PPCOptimizingTest methodsFor:'test support'!
-
-assert: object type: class
- self assert: (object isKindOf: class)
-!
-
-optimize: p
- ^ p asCompilerTree optimizeTree
-!
-
-optimize: p parameters: parameters
- ^ p asCompilerTree optimizeTree: parameters
-! !
-
-!PPCOptimizingTest methodsFor:'tests'!
-
-testAnyPredicate
- | tree |
- tree := self optimize: #any asParser.
-
- self assert: tree type: PPCAnyNode.
-!
-
-testCharSetPredicate
- | tree |
- tree := self optimize: (PPPredicateObjectParser on: [:each | each = $b or: [each = $c] ] message: #foo).
-
- self assert: tree type: PPCCharSetPredicateNode
-!
-
-testChoiceInlining
- | tree |
- tree := self optimize: $a asParser / $b asParser.
-
- self assert: tree type: PPCChoiceNode.
- self assert: tree children first type: PPCCharacterNode.
- self assert: tree children first isMarkedForInline.
- self assert: tree children second type: PPCCharacterNode.
- self assert: tree children first isMarkedForInline.
-
-!
-
-testForwarding
- | tree p1 p2 |
- p2 := $a asParser.
- p1 := p2 wrapped.
- p1 name: 'p1'.
- tree := self optimize: p1.
-
- self assert: tree type: PPCAbstractCharacterNode.
- self assert: tree name = 'p1'.
-
- p2 name: 'p2'.
- tree := self optimize: p1.
- self assert: tree type: PPCForwardNode.
- self assert: tree name = 'p1'.
- self assert: tree child name = 'p2'.
-!
-
-testInlineCharacter
- | tree |
- tree := self optimize: $a asParser plus.
-
- self assert: tree type: PPCPlusNode.
- self assert: tree child type: PPCCharacterNode.
- self assert: tree child isMarkedForInline.
- self assert: tree child character = $a.
-!
-
-testInlineCharacter2
- | tree |
- tree := self optimize: $a asParser star.
-
- self assert: tree type: PPCStarNode.
- self assert: tree child type: PPCCharacterNode.
- self assert: tree child isMarkedForInline.
- self assert: tree child character = $a.
-!
-
-testInlineCharacter3
- | tree |
- tree := self optimize: $a asParser, $b asParser.
-
- self assert: tree type: PPCSequenceNode.
- self assert: tree children first type: PPCCharacterNode.
- self assert: tree children first isMarkedForInline.
- self assert: tree children first character = $a.
- self assert: tree children second type: PPCCharacterNode.
- self assert: tree children second isMarkedForInline.
- self assert: tree children second character = $b.
-!
-
-testInlineNil
- | tree |
- tree := self optimize: nil asParser star.
-
- self assert: tree type: PPCStarNode.
- self assert: tree child type: PPCNilNode.
- self assert: tree child isMarkedForInline.
-!
-
-testInlineNotLiteral
- | tree |
- tree := self optimize: 'foo' asParser not star.
-
- self assert: tree type: PPCStarNode.
- self assert: tree child type: PPCNotLiteralNode.
- self assert: tree child literal = 'foo'.
- self assert: tree child isMarkedForInline.
-!
-
-testInlineNotPredicate
- | tree |
- tree := self optimize: (#letter asParser not, (PPPredicateObjectParser on: [ :e | e = $a or: [ e = $b ]] message: #foo) not).
-
- self assert: tree type: PPCSequenceNode.
- self assert: tree children first type: PPCNotMessagePredicateNode.
- self assert: tree children first isMarkedForInline.
- self assert: tree children second type: PPCNotCharSetPredicateNode.
- self assert: tree children second isMarkedForInline.
-
-!
-
-testInlinePluggable
- | tree |
- tree := self optimize: [:ctx | nil] asParser star.
-
- ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ])
- ifTrue:[ self skip: 'not supported in St/X' ].
-
- self assert: tree type: PPCStarNode.
- self assert: tree child type: PPCPluggableNode.
- self assert: tree child isMarkedForInline.
-
- "Modified: / 23-04-2015 / 12:19:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-testInlinePredicate
- | tree |
- tree := self optimize: (#letter asParser, (PPPredicateObjectParser on: [ :e | e = $a or: [ e = $b ]] message: #foo)).
-
- self assert: tree type: PPCSequenceNode.
- self assert: tree children first type: PPCMessagePredicateNode.
- self assert: tree children first isMarkedForInline.
- self assert: tree children second type: PPCCharSetPredicateNode.
- self assert: tree children second isMarkedForInline.
-
-!
-
-testLetterPredicate
- | tree |
- tree := self optimize: #letter asParser.
-
- self assert: tree type: PPCMessagePredicateNode.
- self assert: tree message = #isLetter.
-!
-
-testNotAction
- | tree |
- tree := self optimize: (($f asParser, $o asParser) ==> #second) not.
-
- self assert: tree type: PPCNotNode.
- self assert: tree child type: PPCTokenSequenceNode.
-!
-
-testNotCharSetPredicate
- | tree |
- tree := self optimize: (PPPredicateObjectParser on: [:each | each = $b or: [each = $c] ] message: #foo) asParser not.
-
- self assert: tree type: PPCNotCharSetPredicateNode.
-!
-
-testNotLiteral
- | tree |
- tree := self optimize: 'foo' asParser not.
-
- self assert: tree type: PPCNotLiteralNode.
- self assert: tree literal = 'foo'.
-!
-
-testNotMessagePredicate
- | tree |
- tree := self optimize: #letter asParser not.
-
- self assert: tree type: PPCNotMessagePredicateNode.
-!
-
-testNotSequence
- | tree |
- tree := self optimize: ($f asParser, $o asParser) not.
-
- self assert: tree type: PPCNotNode.
- self assert: tree child type: PPCTokenSequenceNode.
-!
-
-testStarAny
- | tree |
- tree := self optimize: #any asParser star.
-
- self assert: tree type: PPCStarAnyNode.
-!
-
-testStarCharSetPredicate
- | tree |
- tree := self optimize: (PPPredicateObjectParser on: [:each | each = $b or: [each = $c] ] message: #foo) star.
-
- self assert: tree type: PPCStarCharSetPredicateNode
-!
-
-testStarMessagePredicate
- | tree |
- tree := self optimize: #letter asParser star.
-
- self assert: tree type: PPCStarMessagePredicateNode.
-!
-
-testStarSeparator
- | tree |
- tree := self optimize: #space asParser star trimmingToken parameters: { #rewrite . #token }.
-
- self assert: tree type: PPCTrimmingTokenNode.
- self assert: tree child type: PPCTokenStarSeparatorNode.
-!
-
-testStarSeparator2
- | tree |
- tree := self optimize: (#space asParser star, 'whatever' asParser) trimmingToken.
-
- self assert: tree type: PPCTrimmingTokenNode.
- self assert: tree child type: PPCTokenSequenceNode.
- self assert: tree child children first type: PPCTokenStarSeparatorNode.
- self assert: tree child children first isMarkedForInline.
-!
-
-testSymbolAction
- | tree |
- tree := self optimize: (#letter asParser) ==> #second.
-
- self assert: tree type: PPCSymbolActionNode.
-
- tree := self optimize: (#letter asParser) ==> [:e | e second ].
- self assert: tree type: PPCActionNode.
-!
-
-testToken
- | tree |
- tree := self optimize: ((#letter asParser, #word asParser star) token).
-
- self assert: tree type: PPCTokenNode.
- self assert: tree child type: PPCTokenSequenceNode.
- self assert: tree child children size = 2.
- self assert: tree child children first type: PPCMessagePredicateNode.
- self assert: tree child children first isMarkedForInline.
- self assert: tree child children second type: PPCTokenStarMessagePredicateNode.
- self assert: tree child children second isMarkedForInline.
-
-!
-
-testTokenSequence2
- | tree |
- tree := self optimize: ($a asParser, $b asParser) token.
-
- self assert: tree type: PPCTokenNode.
- self assert: tree child type: PPCTokenSequenceNode.
-
- tree := self optimize: ($a asParser, $b asParser) trimmingToken.
-
- self assert: tree type: PPCTrimmingTokenNode.
- self assert: tree child type: PPCTokenSequenceNode.
-!
-
-testTrimmingToken
- | tree |
- tree := self optimize: ((#letter asParser, #word asParser star) trimmingToken).
-
- self assert: tree type: PPCTrimmingTokenNode.
- self assert: tree whitespace type: PPCTokenStarSeparatorNode.
- self assert: tree whitespace isMarkedForInline.
-
- self assert: tree child type: PPCTokenSequenceNode.
- self assert: tree child children size = 2.
- self assert: tree child children first type: PPCMessagePredicateNode.
- self assert: tree child children first isMarkedForInline.
- self assert: tree child children second type: PPCTokenStarMessagePredicateNode.
- self assert: tree child children first isMarkedForInline.
-!
-
-testTrimmingToken2
- | parser tree |
- parser := 'foo' asParser trimmingToken.
- tree := parser asCompilerTree optimizeTree.
-
- self assert: tree type: PPCTrimmingTokenNode.
- self assert: tree child type: PPCLiteralNode.
- self assert: tree child isMarkedForInline.
- self assert: (tree whitespace allNodes allSatisfy: [ :n | n isKindOf: PPCNode ]).
-
- parser := ('foo' asParser, $b asParser) trimmingToken.
- tree := parser asCompilerTree optimizeTree.
-
- self assert: tree type: PPCTrimmingTokenNode.
- self assert: tree child type: PPCTokenSequenceNode.
- self assert: tree whitespace type: PPCTokenStarSeparatorNode.
- self assert: tree whitespace isMarkedForInline.
-
- parser := $d asParser trimmingToken star.
- tree := parser asCompilerTree optimizeTree.
-
- self assert: tree type: PPCStarNode.
- self assert: tree child type: PPCTrimmingTokenNode.
- self assert: tree child child type: PPCCharacterNode.
- self assert: tree child child isMarkedForInline.
-!
-
-testTrimmingToken3
- | parser tree |
- parser := ('foo' asParser trimmingToken name: 'foo'), ('bar' asParser trimmingToken name: 'bar').
- tree := parser asCompilerTree optimizeTree.
-
- self assert: tree type: PPCSequenceNode.
- self assert: tree children first type: PPCTrimmingTokenNode.
- self assert: tree children second type: PPCTrimmingTokenNode.
-!
-
-testTrimmingTokenNested
- | parser tree foo|
- foo := 'foo' asParser trimmingToken name: 'foo'.
- parser := (foo not, 'bar' asParser) trimmingToken name: 'token'.
- tree := self optimize: parser.
-
- self assert: tree type: PPCTrimmingTokenNode.
- self assert: tree children second type: PPCTokenSequenceNode.
- self assert: tree children second children first type: PPCNotLiteralNode.
- self assert: tree children second children first isMarkedForInline.
-! !
-
-!PPCOptimizingTest class methodsFor:'documentation'!
-
-version_HG
-
- ^ '$Changeset: <not expanded> $'
-! !
-
--- a/compiler/tests/PPCOptimizingVisitorTest.st Thu Apr 30 23:43:14 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,155 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
-
-"{ NameSpace: Smalltalk }"
-
-TestCase subclass:#PPCOptimizingVisitorTest
- instanceVariableNames:'node result visitor'
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Tests-Visitors'
-!
-
-!PPCOptimizingVisitorTest methodsFor:'as yet unclassified'!
-
-asNode: aPPParser
- ^ aPPParser asCompilerTree
-!
-
-assert: object type: class
- self assert: object class == class
-!
-
-setUp
- visitor := PPCOptimizingVisitor new.
-!
-
-testAnyPredicate
- node := self asNode: #any asParser.
- result := visitor visit: node.
-
- self assert: result type: PPCAnyNode.
-!
-
-testIdentity
- | token star1 star2 |
- token := $a asParser token.
- star1 := token star.
- star2 := token star.
- node := self asNode: star1, star2.
- result := visitor visit: node.
-
- self assert: result type: PPCSequenceNode.
- self assert: result children first type: PPCStarNode.
- self assert: result children second type: PPCStarNode.
-!
-
-testNoOptimization
- node := self asNode: 'foo' asParser.
- self assert: node type: PPCLiteralNode.
-
- result := visitor visit: node.
- self assert: result type: PPCLiteralNode.
-!
-
-testNotCharSet
- node := self asNode: #hex asParser not.
- result := visitor visit: node.
-
- self assert: result type: PPCNotCharSetPredicateNode.
-!
-
-testNotLiteral
- node := self asNode: 'foo' asParser not.
- result := visitor visit: node.
-
- self assert: result type: PPCNotLiteralNode.
- self assert: result literal = 'foo'.
-!
-
-testNotMessagePredicate
- node := self asNode: #letter asParser not.
- result := visitor visit: node.
-
- self assert: result type: PPCNotMessagePredicateNode.
-!
-
-testPredicateNode01
- node := self asNode: #letter asParser.
- result := visitor visit: node.
-
- self assert: result type: PPCMessagePredicateNode.
- self assert: result message = #isLetter.
-!
-
-testPredicateNode02
- node := self asNode: #digit asParser.
- result := visitor visit: node.
-
- self assert: result type: PPCMessagePredicateNode.
- self assert: result message = #isDigit.
-!
-
-testPredicateNode03
- node := self asNode: #space asParser.
- result := visitor visit: node.
-
- self assert: result type: PPCMessagePredicateNode.
- self assert: result message = #isSeparator.
-!
-
-testPredicateNode04
- node := self asNode: #word asParser.
- result := visitor visit: node.
-
- self assert: result type: PPCMessagePredicateNode.
- self assert: result message = #isAlphaNumeric.
-!
-
-testPredicateNode05
- node := self asNode: #hex asParser.
- result := visitor visit: node.
-
- self assert: result type: PPCCharSetPredicateNode.
-!
-
-testStarNode1
- node := self asNode: #letter asParser star.
- result := visitor visit: node.
-
- self assert: result type: PPCStarMessagePredicateNode.
- self assert: result message = #isLetter.
-!
-
-testStarNode2
- node := self asNode: #any asParser star.
- result := visitor visit: node.
-
- self assert: result type: PPCStarAnyNode.
-!
-
-testStarNode3
- node := self asNode: #hex asParser star.
- result := visitor visit: node.
-
- self assert: result type: PPCStarCharSetPredicateNode.
-!
-
-testStarNode4
- node := self asNode: #letter asParser not star.
- result := visitor visit: node.
-
- self assert: result type: PPCStarNode.
- self assert: result child type: PPCNotMessagePredicateNode.
-!
-
-testStarNode5
- | star |
- star := $a asParser not star.
- node := self asNode: star, star.
- result := visitor visit: node.
-
- self assert: result type: PPCSequenceNode.
- self assert: result children first type: PPCStarNode.
- self assert: result children second type: PPCStarNode.
-! !
-
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCPrototype1OptimizingTest.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,360 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCPrototype1OptimizingTest
+ instanceVariableNames:'configuration'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Core'
+!
+
+!PPCPrototype1OptimizingTest methodsFor:'test support'!
+
+assert: object type: class
+ self assert: (object isKindOf: class)
+!
+
+optimize: aPPParser
+ ^ aPPParser compileWithConfiguration: configuration.
+!
+
+setUp
+ super setUp.
+
+ configuration := PPCUniversalConfiguration new.
+ configuration arguments generate: false.
+
+" ^ configuration := PPCPluggableConfiguration on:
+ [ :_self |
+ _self toPPCIr.
+ _self createTokens.
+ _self specialize.
+ _self createRecognizingComponents.
+ _self inline.
+ _self merge.
+ ]"
+! !
+
+!PPCPrototype1OptimizingTest methodsFor:'tests'!
+
+testAnyPredicate
+ | tree |
+ tree := self optimize: #any asParser.
+
+ self assert: tree type: PPCAnyNode.
+!
+
+testCharSetPredicate
+ | tree |
+ tree := self optimize: (PPPredicateObjectParser on: [:each | each = $b or: [each = $c] ] message: #foo).
+
+ self assert: tree type: PPCCharSetPredicateNode
+!
+
+testChoiceInlining
+ | tree |
+ tree := self optimize: $a asParser / $b asParser.
+
+ self assert: tree type: PPCChoiceNode.
+ self assert: tree children first type: PPCCharacterNode.
+ self assert: tree children first isMarkedForInline.
+ self assert: tree children second type: PPCCharacterNode.
+ self assert: tree children first isMarkedForInline.
+
+!
+
+testForwarding
+ | tree p1 p2 |
+ p2 := $a asParser.
+ p1 := p2 wrapped.
+ p1 name: 'p1'.
+ tree := self optimize: p1.
+
+ self assert: tree type: PPCAbstractCharacterNode.
+ self assert: tree name = 'p1'.
+
+ p2 name: 'p2'.
+ tree := self optimize: p1.
+ self assert: tree type: PPCForwardNode.
+ self assert: tree name = 'p1'.
+ self assert: tree child name = 'p2'.
+!
+
+testInlineCharacter
+ | tree |
+ tree := self optimize: $a asParser plus.
+
+ self assert: tree type: PPCPlusNode.
+ self assert: tree child type: PPCCharacterNode.
+ self assert: tree child isMarkedForInline.
+ self assert: tree child character = $a.
+!
+
+testInlineCharacter2
+ | tree |
+ tree := self optimize: $a asParser star.
+
+ self assert: tree type: PPCStarNode.
+ self assert: tree child type: PPCCharacterNode.
+ self assert: tree child isMarkedForInline.
+ self assert: tree child character = $a.
+!
+
+testInlineCharacter3
+ | tree |
+ tree := self optimize: $a asParser, $b asParser.
+
+ self assert: tree type: PPCSequenceNode.
+ self assert: tree children first type: PPCCharacterNode.
+ self assert: tree children first isMarkedForInline.
+ self assert: tree children first character = $a.
+ self assert: tree children second type: PPCCharacterNode.
+ self assert: tree children second isMarkedForInline.
+ self assert: tree children second character = $b.
+!
+
+testInlineNil
+ | tree |
+ tree := self optimize: nil asParser star.
+
+ self assert: tree type: PPCStarNode.
+ self assert: tree child type: PPCNilNode.
+ self assert: tree child isMarkedForInline.
+!
+
+testInlineNotLiteral
+ | tree |
+ tree := self optimize: 'foo' asParser not star.
+
+ self assert: tree type: PPCStarNode.
+ self assert: tree child type: PPCNotLiteralNode.
+ self assert: tree child literal = 'foo'.
+ self assert: tree child isMarkedForInline.
+!
+
+testInlineNotPredicate
+ | tree |
+ tree := self optimize: (#letter asParser not, (PPPredicateObjectParser on: [ :e | e = $a or: [ e = $b ]] message: #foo) not).
+
+ self assert: tree type: PPCSequenceNode.
+ self assert: tree children first type: PPCNotMessagePredicateNode.
+ self assert: tree children first isMarkedForInline.
+ self assert: tree children second type: PPCNotCharSetPredicateNode.
+ self assert: tree children second isMarkedForInline.
+
+!
+
+testInlinePluggable
+ | tree |
+ tree := self optimize: [:ctx | nil] asParser star.
+
+ ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ])
+ ifTrue:[ self skip: 'not supported in St/X' ].
+
+ self assert: tree type: PPCStarNode.
+ self assert: tree child type: PPCPluggableNode.
+ self assert: tree child isMarkedForInline.
+
+ "Modified: / 23-04-2015 / 12:19:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testInlinePredicate
+ | tree |
+ tree := self optimize: (#letter asParser, (PPPredicateObjectParser on: [ :e | e = $a or: [ e = $b ]] message: #foo)).
+
+ self assert: tree type: PPCSequenceNode.
+ self assert: tree children first type: PPCMessagePredicateNode.
+ self assert: tree children first isMarkedForInline.
+ self assert: tree children second type: PPCCharSetPredicateNode.
+ self assert: tree children second isMarkedForInline.
+
+!
+
+testLetterPredicate
+ | tree |
+ tree := self optimize: #letter asParser.
+
+ self assert: tree type: PPCMessagePredicateNode.
+ self assert: tree message = #isLetter.
+!
+
+testNotAction
+ | tree |
+ tree := self optimize: (($f asParser, $o asParser) ==> #second) not.
+
+ self assert: tree type: PPCNotNode.
+ self assert: tree child type: PPCRecognizingSequenceNode.
+!
+
+testNotCharSetPredicate
+ | tree |
+ tree := self optimize: (PPPredicateObjectParser on: [:each | each = $b or: [each = $c] ] message: #foo) asParser not.
+
+ self assert: tree type: PPCNotCharSetPredicateNode.
+!
+
+testNotLiteral
+ | tree |
+ tree := self optimize: 'foo' asParser not.
+
+ self assert: tree type: PPCNotLiteralNode.
+ self assert: tree literal = 'foo'.
+!
+
+testNotMessagePredicate
+ | tree |
+ tree := self optimize: #letter asParser not.
+
+ self assert: tree type: PPCNotMessagePredicateNode.
+!
+
+testNotSequence
+ | tree |
+ tree := self optimize: ($f asParser, $o asParser) not.
+
+ self assert: tree type: PPCNotNode.
+ self assert: tree child type: PPCRecognizingSequenceNode.
+!
+
+testRecognizingSequence2
+ | tree |
+ tree := self optimize: ($a asParser, $b asParser) token.
+
+ self assert: tree type: PPCTokenNode.
+ self assert: tree child type: PPCRecognizingSequenceNode.
+
+ tree := self optimize: ($a asParser, $b asParser) trimmingToken.
+
+ self assert: tree type: PPCTrimmingTokenNode.
+ self assert: tree child type: PPCRecognizingSequenceNode.
+!
+
+testStarAny
+ | tree |
+ tree := self optimize: #any asParser star.
+
+ self assert: tree type: PPCStarAnyNode.
+!
+
+testStarCharSetPredicate
+ | tree |
+ tree := self optimize: (PPPredicateObjectParser on: [:each | each = $b or: [each = $c] ] message: #foo) star.
+
+ self assert: tree type: PPCStarCharSetPredicateNode
+!
+
+testStarMessagePredicate
+ | tree |
+ tree := self optimize: #letter asParser star.
+
+ self assert: tree type: PPCStarMessagePredicateNode.
+!
+
+testStarSeparator
+ | tree |
+ tree := self optimize: #space asParser star trimmingToken.
+
+ self assert: tree type: PPCTrimmingTokenNode.
+ self assert: tree child type: PPCTokenStarSeparatorNode.
+!
+
+testStarSeparator2
+ | tree |
+ tree := self optimize: (#space asParser star, 'whatever' asParser) trimmingToken.
+
+ self assert: tree type: PPCTrimmingTokenNode.
+ self assert: tree child type: PPCRecognizingSequenceNode.
+ self assert: tree child children first type: PPCTokenStarSeparatorNode.
+ self assert: tree child children first isMarkedForInline.
+!
+
+testSymbolAction
+ | tree |
+ tree := self optimize: (#letter asParser) ==> #second.
+
+ self assert: tree type: PPCSymbolActionNode.
+
+ tree := self optimize: (#letter asParser) ==> [:e | e second ].
+ self assert: tree type: PPCActionNode.
+!
+
+testToken
+ | tree |
+ tree := self optimize: ((#letter asParser, #word asParser star) token).
+
+ self assert: tree type: PPCTokenNode.
+ self assert: tree child type: PPCRecognizingSequenceNode.
+ self assert: tree child children size = 2.
+ self assert: tree child children first type: PPCMessagePredicateNode.
+ self assert: tree child children first isMarkedForInline.
+ self assert: tree child children second type: PPCTokenStarMessagePredicateNode.
+ self assert: tree child children second isMarkedForInline.
+
+!
+
+testTrimmingToken
+ | tree |
+ tree := self optimize: ((#letter asParser, #word asParser star) trimmingToken).
+
+ self assert: tree type: PPCTrimmingTokenNode.
+ self assert: tree whitespace type: PPCTokenStarSeparatorNode.
+ self assert: tree whitespace isMarkedForInline.
+
+ self assert: tree child type: PPCRecognizingSequenceNode.
+ self assert: tree child children size = 2.
+ self assert: tree child children first type: PPCMessagePredicateNode.
+ self assert: tree child children first isMarkedForInline.
+ self assert: tree child children second type: PPCTokenStarMessagePredicateNode.
+ self assert: tree child children first isMarkedForInline.
+!
+
+testTrimmingToken2
+ | parser tree |
+ parser := 'foo' asParser trimmingToken.
+ tree := self optimize: parser.
+
+ self assert: tree type: PPCTrimmingTokenNode.
+ self assert: tree child type: PPCLiteralNode.
+ self assert: tree child isMarkedForInline.
+ self assert: (tree whitespace allNodes allSatisfy: [ :n | n isKindOf: PPCNode ]).
+
+ parser := ('foo' asParser, $b asParser) trimmingToken.
+ tree := self optimize: parser.
+
+ self assert: tree type: PPCTrimmingTokenNode.
+ self assert: tree child type: PPCRecognizingSequenceNode.
+ self assert: tree whitespace type: PPCTokenStarSeparatorNode.
+ self assert: tree whitespace isMarkedForInline.
+
+ parser := $d asParser trimmingToken star.
+ tree := self optimize: parser.
+
+ self assert: tree type: PPCStarNode.
+ self assert: tree child type: PPCTrimmingTokenNode.
+ self assert: tree child child type: PPCCharacterNode.
+ self assert: tree child child isMarkedForInline.
+!
+
+testTrimmingToken3
+ | parser tree |
+ parser := ('foo' asParser trimmingToken name: 'foo'), ('bar' asParser trimmingToken name: 'bar').
+ tree := self optimize: parser.
+
+ self assert: tree type: PPCSequenceNode.
+ self assert: tree children first type: PPCTrimmingTokenNode.
+ self assert: tree children second type: PPCTrimmingTokenNode.
+!
+
+testTrimmingTokenNested
+ | parser tree foo|
+ foo := 'foo' asParser trimmingToken name: 'foo'.
+ parser := (foo not, 'bar' asParser) trimmingToken name: 'token'.
+ tree := self optimize: parser.
+
+ self assert: tree type: PPCTrimmingTokenNode.
+ self assert: tree children second type: PPCRecognizingSequenceNode.
+ self assert: tree children second children first type: PPCNotLiteralNode.
+ self assert: tree children second children first isMarkedForInline.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCPrototype1Test.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,577 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPAbstractParserTest subclass:#PPCPrototype1Test
+ instanceVariableNames:'parser result context node compiler id node2 id2 id1 node1 node3
+ arguments configuration'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Core'
+!
+
+!PPCPrototype1Test methodsFor:'context'!
+
+context
+ ^ context := PPCProfilingContext new
+! !
+
+!PPCPrototype1Test methodsFor:'test support'!
+
+assert: p parse: whatever
+ ^ result := super assert: p parse: whatever.
+!
+
+parse: whatever
+ ^ result := super parse: whatever.
+!
+
+tearDown
+ | parserClass |
+
+ parserClass := (Smalltalk at: arguments name ifAbsent: [nil]).
+ parserClass notNil ifTrue:[
+ parserClass removeFromSystem
+ ].
+! !
+
+!PPCPrototype1Test methodsFor:'tests - compiling'!
+
+testCompileAnd
+ parser := #digit asParser and compileWithConfiguration: configuration.
+
+ self assert: parser parse: '1' to: $1 end: 0.
+ self assert: parser fail: 'a'.
+ self assert: parser fail: ''.
+
+ parser := ('foo' asParser, ($: asParser and)) compile.
+ self assert: parser parse: 'foo:' to: { 'foo'. $: } end: 3.
+!
+
+testCompileAny
+ parser := #any asParser compile.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: '_' to: $_.
+ self assert: parser parse: '
+' to: Character cr.
+!
+
+testCompileAnyStar
+ parser := #any asParser star compileWithConfiguration: configuration.
+
+
+ self assert: parser parse: 'aaa' to: { $a. $a . $a }.
+ self assert: context invocationCount = 1.
+ self assert: parser parse: '' to: { }.
+!
+
+testCompileBlock
+ parser := (#letter asParser) plus ==> [ :res | res collect: [:each | each asUppercase ]].
+ parser := parser compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo' to: { $F . $O . $O}.
+ self assert: parser parse: 'bar' to: { $B . $A . $R}.
+ self assert: parser fail: ''.
+!
+
+testCompileCharacter
+ parser := $a asParser compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: 'b'.
+
+ parser := $# asParser compileWithConfiguration: configuration.
+ self assert: parser parse: '#'.
+!
+
+testCompileChoice
+ parser := (#digit asParser / #letter asParser) compileWithConfiguration: configuration.
+
+ self assert: parser parse: '1' to: $1.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: '_'.
+
+!
+
+testCompileChoice2
+ parser := ('true' asParser / 'false' asParser) compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'true' to: 'true'.
+ self assert: parser parse: 'false' to: 'false'.
+ self assert: parser fail: 'trulse'.
+
+!
+
+testCompileLiteral
+ parser := 'foo' asParser compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo' to: 'foo'.
+ self assert: parser parse: 'foobar' to: 'foo' end: 3.
+ self assert: parser fail: 'boo'.
+
+ parser := '#[' asParser compileWithConfiguration: configuration.
+ self assert: parser parse: '#[1]' to: '#[' end: 2.
+!
+
+testCompileLiteral2
+ | quote |
+ quote := '''' asParser.
+ parser := (quote, $a asParser ) compileWithConfiguration: configuration.
+ self assert: parser parse: '''a' to: {'''' . $a}.
+!
+
+testCompileNegate
+ parser := #letter asParser negate star, #letter asParser.
+ parser := parser compileWithConfiguration: configuration.
+
+ self assert: parser parse: '...a' to: { { $. . $. . $. } . $a }.
+ self assert: parser parse: 'aaa' to: { {} . $a } end: 1.
+ self assert: parser fail: '...'.
+!
+
+testCompileNil
+ parser := nil asParser compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'a' to: nil end: 0.
+ self assert: parser parse: '' to: nil end: 0.
+
+ parser := nil asParser, 'foo' asParser.
+ self assert: parser parse: 'foo' to: { nil . 'foo' }
+!
+
+testCompileNot
+ parser := #digit asParser not compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'a' to: nil end: 0.
+ self assert: parser fail: '1'.
+ self assert: parser parse: '' to: nil end: 0.
+
+ parser := 'foo' asParser, $: asParser not.
+ parser := parser compileWithConfiguration: configuration.
+ self assert: parser parse: 'foo' to: { 'foo'. nil } end: 3.
+
+ parser := 'foo' asParser, $: asParser not, 'bar' asParser.
+ parser := parser compileWithConfiguration: configuration.
+ self assert: parser parse: 'foobar' to: { 'foo'. nil . 'bar' } end: 6.
+!
+
+testCompileNot2
+ parser := ($a asParser, $b asParser) not compileWithConfiguration: configuration.
+
+ self assert: parser parse: '' to: nil end: 0.
+ self assert: parser parse: 'a' to: nil end: 0.
+ self assert: parser parse: 'aa' to: nil end: 0.
+ self assert: parser fail: 'ab'.
+!
+
+testCompileNot3
+ parser := ('foo' asParser not, 'fee' asParser) compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'fee' to: #(nil 'fee').
+ self assert: parser fail: 'foo'.
+!
+
+testCompileNotLiteral
+ parser := 'foo' asParser not compileWithConfiguration: configuration.
+ self assert: parser class methodDictionary size = 1.
+
+ self assert: parser parse: 'bar' to: nil end: 0.
+
+ self assert: parser fail: 'foo'.
+ self assert: parser parse: '' to: nil end: 0.
+
+ parser := '''' asParser not compile.
+ self assert: parser class methodDictionary size = 1.
+
+ self assert: parser parse: 'a' to: nil end: 0.
+ self assert: parser fail: ''''.
+ self assert: parser parse: '' to: nil end: 0.
+
+
+ parser := ('foo' asParser, 'bar' asParser not) compile.
+ self assert: parser parse: 'foofoo' to: { 'foo'. nil } end: 3.
+
+ parser := ('foo' asParser, 'foo' asParser not, #any asParser star) compile.
+ self assert: parser parse: 'foobar' to: { 'foo'. nil . #($b $a $r) } end: 6.
+ self assert: parser fail: 'foofoo'.
+!
+
+testCompileOptional
+ parser := #digit asParser optional compileWithConfiguration: configuration.
+
+ self assert: parser parse: '1' to: $1.
+ self assert: parser parse: 'a' to: nil end: 0.
+
+ parser := (#digit asParser optional, #letter asParser) compile.
+ self assert: parser parse: '1a' to: { $1 . $a }.
+ self assert: parser parse: 'a' to: { nil . $a }.
+!
+
+testCompilePlus
+ parser := #letter asParser plus compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'lorem' to: {$l. $o. $r. $e. $m} .
+ self assert: parser parse: 'a123' to: {$a} end: 1.
+ self assert: parser parse: 'ab123' to: {$a . $b} end: 2.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: '123'.
+!
+
+testCompilePredicate
+ parser := #digit asParser compileWithConfiguration: configuration.
+
+ self assert: parser parse: '1' to: $1.
+ self assert: parser parse: '0' to: $0.
+ self assert: parser fail: 'a'.
+!
+
+testCompilePredicate2
+ parser := #space asParser compileWithConfiguration: configuration.
+
+ self assert: parser parse: ' ' to: Character space.
+ self assert: parser fail: 'a'.
+!
+
+testCompileSequence
+ parser := (#digit asParser, #letter asParser) compileWithConfiguration: configuration.
+
+ self assert: parser parse: '1a' to: {$1 .$a}.
+
+
+!
+
+testCompileSequence2
+ parser := (#digit asParser, #space asParser, #letter asParser) compileWithConfiguration: configuration.
+
+ self assert: parser parse: '9 c' to: {$9 . Character space. $c }.
+ self assert: parser fail: '9c'.
+
+!
+
+testCompileSequence3
+ parser := (#any asParser, #any asParser, #any asParser) compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo' to: #($f $o $o).
+ self assert: parser fail: 'fo'.
+
+!
+
+testCompileStar
+ parser := #letter asParser star compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'lorem' to: {$l. $o. $r. $e. $m} .
+ self assert: parser parse: '' to: {}.
+ self assert: parser parse: '123' to: {} end: 0.
+ self assert: parser parse: 'ab123' to: {$a . $b} end: 2.
+!
+
+testCompileStarLiteral
+ parser := 'foo' asParser star compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo' to: #('foo' ) .
+ self assert: parser parse: 'foofoo' to: #('foo' 'foo') .
+ self assert: parser parse: 'foofoofoo' to: #('foo' 'foo' 'foo') .
+ self assert: parser parse: '' to: #().
+ self assert: parser parse: 'bar' to: #() end: 0.
+!
+
+testCompileStarPredicate
+ parser := #letter asParser star compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo' to: #($f $o $o ) .
+ self assert: parser parse: '' to: #().
+ self assert: parser parse: '123' to: #() end: 0.
+!
+
+testCompileSymbolBlock
+ parser := (#letter asParser) plus ==> #second.
+ parser := parser compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo' to: $o.
+ self assert: parser parse: 'bar' to: $a.
+ self assert: parser fail: ''.
+ self should: [ parser parse: 'f' ] raise: Error.
+!
+
+testCompileTrim
+ parser := $a asParser trim compileWithConfiguration: configuration.
+
+ self assert: parser fail: ''.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: ' a' to: $a.
+ self assert: parser parse: 'a ' to: $a.
+ self assert: parser parse: ' a ' to: $a.
+!
+
+testCompileTrimmingToken
+ | token1 token2 |
+ token1 := (#letter asParser) plus trimmingToken.
+ token2 := (#letter asParser) plus trimmingToken.
+
+ parser := (token1, token2) compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo bar'.
+ self assert: parser parse: ' foo bar '.
+!
+
+testCompileTrimmingToken2
+ | token1 token2 |
+ token1 := (#letter asParser) plus trimmingToken.
+ token2 := (#letter asParser) plus trimmingToken / 'foo' asParser trimmingToken.
+
+ parser := (token1, token2) compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo bar'.
+ self assert: parser parse: ' foo bar '.
+!
+
+testCompileTrimmingToken3
+ | token1 token2 |
+ token1 := ($a asParser, $b asParser) trimmingToken name: 'token1'.
+ token2 := (token1 not, $c asParser) trimmingToken name: 'token2'.
+
+ parser := (token1 / token2) compileWithConfiguration: configuration.
+
+ self assert: (parser class methodDictionary includesKey: #'token1').
+ self assert: (parser class methodDictionary includesKey: #'token1_fast').
+
+ self assert: parser parse: 'ab'.
+ self assert: (result isKindOf: PPToken).
+ self assert: result inputValue = 'ab'.
+
+ self assert: parser parse: 'c'.
+ self assert: (result isKindOf: PPToken).
+ self assert: result inputValue = 'c'.
+
+! !
+
+!PPCPrototype1Test methodsFor:'tests - extra'!
+
+testCompileSmalltalkToken
+ parser := (#letter asParser, ((#letter asParser / #digit asParser) star)) smalltalkToken compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+ self assert: parser parse: 'a'.
+ self assert: result inputValue = 'a'.
+ self assert: parser parse: 'f123a'.
+ self assert: result inputValue = 'f123a'.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: '12'.
+
+ self assert: parser parse: ' "comment" foo'.
+ self assert: result inputValue = 'foo'.
+
+ self assert: parser parse: ' "comment" bar "another comment" '.
+ self assert: result inputValue = 'bar'.
+ self assert: parser parse: '
+ "b"
+ "b"
+ foo
+ "and yet, another comment"
+
+ "one more to make sure :)"
+ '.
+ self assert: result inputValue = 'foo'.
+!
+
+testCycle
+ | p1 block |
+
+ p1 := PPDelegateParser new.
+ block := ${ asParser, p1, $} asParser / nil asParser.
+ p1 setParser: block.
+
+ parser := block compileWithConfiguration: configuration.
+ self assert: parser parse: '{}' to: { ${. nil . $} }.
+ self assert: parser parse: '{{}}' to: { ${. { ${ . nil . $} } . $} }.
+
+!
+
+testSmalltalkToken
+ parser := (#letter asParser, (#digit asParser / #letter asParser) star) smalltalkToken compileWithConfiguration: configuration.
+
+ self assert: parser class methodDictionary size = 5.
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+ self assert: context invocationCount = 8.
+ self assert: context rememberCount = 0.
+ self assert: context lwRememberCount = 1.
+ self assert: context lwRestoreCount = 0.
+!
+
+testSmalltalkToken2
+ id := (#letter asParser, (#digit asParser / #letter asParser) star)
+ name: 'identifier';
+ yourself.
+
+ parser := (id wrapped, $: asParser) smalltalkToken
+ name: 'kw';
+ yourself.
+
+ parser := parser compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo:'.
+ self assert: result inputValue = 'foo:'.
+!
+
+testToken
+ parser := (#letter asParser, (#digit asParser / #letter asParser) star) flatten compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo' to: 'foo'.
+ self assert: parser parse: 'a' to: 'a'.
+ self assert: parser parse: 'f123a' to: 'f123a'.
+ self assert: parser fail: ''.
+!
+
+testToken2
+ parser := (#letter asParser, (#digit asParser / #letter asParser) star) token compileWithConfiguration: configuration.
+
+ self assert: parser class methodDictionary size = 4.
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+ self assert: context invocationCount = 6.
+ self assert: context rememberCount = 0.
+ self assert: context lwRememberCount = 1.
+ self assert: context lwRestoreCount = 0.
+!
+
+testTrimmingToken
+ parser := (#letter asParser, (#digit asParser / #letter asParser) star) trimmingToken compileWithConfiguration: configuration.
+
+ self assert: parser class methodDictionary size = 4.
+
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+
+ self assert: context invocationCount = 6.
+ self assert: context rememberCount = 0.
+ self assert: context lwRememberCount = 1.
+ self assert: context lwRestoreCount = 0.
+
+ self assert: parser parse: ' foo '.
+ self assert: result inputValue = 'foo'.
+
+
+
+ self assert: parser fail: '123'.
+
+ self assert: context invocationCount = 1.
+ self assert: context rememberCount = 0.
+ self assert: context lwRememberCount = 0.
+ self assert: context lwRestoreCount = 0.
+
+
+ self assert: parser fail: ''.
+!
+
+testTrimmingToken2
+
+ 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: context invocationCount = 3.
+
+ self assert: parser parse: ' foobar'.
+ self assert: result first inputValue = 'foo'.
+ self assert: result second inputValue = 'bar'.
+ self assert: context invocationCount = 3.
+ self assert: (context invocations anySatisfy: [ :e | e beginsWith: 'token' ]).
+
+ self assert: parser fail: 'bar'.
+ self assert: context invocationCount = 1.
+ self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]).
+
+!
+
+testTrimmingToken3
+
+ parser := ('foo' asParser trimmingToken / 'bar' asParser trimmingToken)
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+ self assert: context invocationCount = 2.
+
+ self assert: parser parse: ' bar'.
+ self assert: result inputValue = 'bar'.
+ self assert: context invocationCount = 2.
+ self assert: (context invocations anySatisfy: [ :e | e beginsWith: 'token' ]).
+
+ self assert: parser fail: 'baz'.
+ self assert: context invocationCount = 2.
+
+ self assert: parser fail: 'zaz'.
+ self assert: context invocationCount = 1.
+ self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]).
+!
+
+testTrimmingTokenNested
+ | identifier kw |
+ kw := 'false' asParser trimmingToken name: #kw.
+ identifier := (kw not, (#letter asParser, #word asParser star)) trimmingToken name: #identifier.
+
+ parser := identifier / kw.
+ parser := parser compileWithConfiguration: configuration.
+ self assert: parser class methodDictionary size = 5.
+
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+
+ self assert: parser parse: 'false'.
+ self assert: result inputValue = 'false'.
+!
+
+testTrimmingTokenNested2
+ | identifier kw |
+ kw := 'false' asParser trimmingToken name: #kw.
+ identifier := (kw not, (#letter asParser, #word asParser star)) trimmingToken name: #identifier.
+
+ parser := identifier / kw.
+ parser := parser compileWithConfiguration: configuration.
+ self assert: parser class methodDictionary size = 5.
+
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+
+ self assert: parser parse: 'false'.
+ self assert: result inputValue = 'false'.
+!
+
+testTrimmingTokenNested3
+ | identifier kw |
+ kw := ('false' asParser, #word asParser not) trimmingToken name: #kw.
+ identifier := (kw not, (#letter asParser, #word asParser star)) trimmingToken name: #identifier.
+
+ parser := identifier / kw.
+ parser := parser compileWithConfiguration: configuration.
+ self assert: parser class methodDictionary size = 8.
+ self assert: (parser class methods anySatisfy: [ :m | m selector = #kw ]).
+ self assert: (parser class methods anySatisfy: [ :m | m selector = #kw_fast ]).
+
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+
+ self assert: parser parse: 'false'.
+ self assert: result inputValue = 'false'.
+! !
+
+!PPCPrototype1Test methodsFor:'tests - ids'!
+
+setUp
+ arguments := PPCArguments default
+ profile: true;
+ debug: true;
+ yourself.
+
+ configuration := PPCUniversalConfiguration new
+ arguments: arguments;
+ yourself.
+! !
+
--- a/compiler/tests/PPCProtype1Test.st Thu Apr 30 23:43:14 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,532 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPAbstractParserTest subclass:#PPCProtype1Test
- instanceVariableNames:'parser result context node compiler id node2 id2 id1 node1 node3
- arguments configuration'
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Tests-Core'
-!
-
-!PPCProtype1Test methodsFor:'context'!
-
-context
- ^ context := PPCProfilingContext new
-! !
-
-!PPCProtype1Test methodsFor:'test support'!
-
-assert: p parse: whatever
- ^ result := super assert: p parse: whatever.
-!
-
-parse: whatever
- ^ result := super parse: whatever.
-!
-
-tearDown
- | parserClass |
-
- parserClass := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]).
- parserClass notNil ifTrue:[
- parserClass removeFromSystem
- ].
-! !
-
-!PPCProtype1Test methodsFor:'tests - compiling'!
-
-testCompileAnd
- parser := #digit asParser and compileWithConfiguration: configuration.
-
- self assert: parser parse: '1' to: $1 end: 0.
- self assert: parser fail: 'a'.
- self assert: parser fail: ''.
-
- parser := ('foo' asParser, ($: asParser and)) compile.
- self assert: parser parse: 'foo:' to: { 'foo'. $: } end: 3.
-!
-
-testCompileAny
- parser := #any asParser compile.
-
- self assert: parser parse: 'a' to: $a.
- self assert: parser parse: '_' to: $_.
- self assert: parser parse: '
-' to: Character cr.
-!
-
-testCompileAnyStar
- parser := #any asParser star compileWithConfiguration: configuration.
-
-
- self assert: parser parse: 'aaa' to: { $a. $a . $a }.
- self assert: context invocationCount = 1.
- self assert: parser parse: '' to: { }.
-!
-
-testCompileBlock
- parser := (#letter asParser) plus ==> [ :res | res collect: [:each | each asUppercase ]].
- parser := parser compileWithConfiguration: configuration.
-
- self assert: parser parse: 'foo' to: { $F . $O . $O}.
- self assert: parser parse: 'bar' to: { $B . $A . $R}.
- self assert: parser fail: ''.
-!
-
-testCompileCharacter
- parser := $a asParser compileWithConfiguration: configuration.
-
- self assert: parser parse: 'a' to: $a.
- self assert: parser fail: 'b'.
-
- parser := $# asParser compileWithConfiguration: configuration.
- self assert: parser parse: '#'.
-!
-
-testCompileChoice
- parser := (#digit asParser / #letter asParser) compileWithConfiguration: configuration.
-
- self assert: parser parse: '1' to: $1.
- self assert: parser parse: 'a' to: $a.
- self assert: parser fail: '_'.
-
-!
-
-testCompileChoice2
- parser := ('true' asParser / 'false' asParser) compileWithConfiguration: configuration.
-
- self assert: parser parse: 'true' to: 'true'.
- self assert: parser parse: 'false' to: 'false'.
- self assert: parser fail: 'trulse'.
-
-!
-
-testCompileLiteral
- parser := 'foo' asParser compileWithConfiguration: configuration.
-
- self assert: parser parse: 'foo' to: 'foo'.
- self assert: parser parse: 'foobar' to: 'foo' end: 3.
- self assert: parser fail: 'boo'.
-
- parser := '#[' asParser compile.
- self assert: parser parse: '#[1]' to: '#[' end: 2.
-!
-
-testCompileLiteral2
- | quote |
- quote := '''' asParser.
- parser := (quote, $a asParser ) compileWithConfiguration: configuration.
- self assert: parser parse: '''a' to: {'''' . $a}.
-!
-
-testCompileNegate
- parser := #letter asParser negate star, #letter asParser.
- parser := parser compileWithConfiguration: configuration.
-
- self assert: parser parse: '...a' to: { { $. . $. . $. } . $a }.
- self assert: parser parse: 'aaa' to: { {} . $a } end: 1.
- self assert: parser fail: '...'.
-!
-
-testCompileNil
- parser := nil asParser compileWithConfiguration: configuration.
-
- self assert: parser parse: 'a' to: nil end: 0.
- self assert: parser parse: '' to: nil end: 0.
-
- parser := nil asParser, 'foo' asParser.
- self assert: parser parse: 'foo' to: { nil . 'foo' }
-!
-
-testCompileNot
- parser := #digit asParser not compileWithConfiguration: configuration.
-
- self assert: parser parse: 'a' to: nil end: 0.
- self assert: parser fail: '1'.
- self assert: parser parse: '' to: nil end: 0.
-
- parser := 'foo' asParser, $: asParser not.
- parser := parser compileWithConfiguration: configuration.
- self assert: parser parse: 'foo' to: { 'foo'. nil } end: 3.
-
- parser := 'foo' asParser, $: asParser not, 'bar' asParser.
- parser := parser compileWithConfiguration: configuration.
- self assert: parser parse: 'foobar' to: { 'foo'. nil . 'bar' } end: 6.
-!
-
-testCompileNot2
- parser := ($a asParser, $b asParser) not compileWithConfiguration: configuration.
-
- self assert: parser parse: '' to: nil end: 0.
- self assert: parser parse: 'a' to: nil end: 0.
- self assert: parser parse: 'aa' to: nil end: 0.
- self assert: parser fail: 'ab'.
-!
-
-testCompileNot3
- parser := ('foo' asParser not, 'fee' asParser) compileWithConfiguration: configuration.
-
- self assert: parser parse: 'fee' to: #(nil 'fee').
- self assert: parser fail: 'foo'.
-!
-
-testCompileNotLiteral
- parser := 'foo' asParser not compileWithConfiguration: configuration.
- self assert: parser class methodDictionary size = 1.
-
- self assert: parser parse: 'bar' to: nil end: 0.
-
- self assert: parser fail: 'foo'.
- self assert: parser parse: '' to: nil end: 0.
-
- parser := '''' asParser not compile.
- self assert: parser class methodDictionary size = 1.
-
- self assert: parser parse: 'a' to: nil end: 0.
- self assert: parser fail: ''''.
- self assert: parser parse: '' to: nil end: 0.
-
-
- parser := ('foo' asParser, 'bar' asParser not) compile.
- self assert: parser parse: 'foofoo' to: { 'foo'. nil } end: 3.
-
- parser := ('foo' asParser, 'foo' asParser not, #any asParser star) compile.
- self assert: parser parse: 'foobar' to: { 'foo'. nil . #($b $a $r) } end: 6.
- self assert: parser fail: 'foofoo'.
-!
-
-testCompileOptional
- parser := #digit asParser optional compileWithConfiguration: configuration.
-
- self assert: parser parse: '1' to: $1.
- self assert: parser parse: 'a' to: nil end: 0.
-
- parser := (#digit asParser optional, #letter asParser) compile.
- self assert: parser parse: '1a' to: { $1 . $a }.
- self assert: parser parse: 'a' to: { nil . $a }.
-!
-
-testCompilePlus
- parser := #letter asParser plus compileWithConfiguration: configuration.
-
- self assert: parser parse: 'lorem' to: {$l. $o. $r. $e. $m} .
- self assert: parser parse: 'a123' to: {$a} end: 1.
- self assert: parser parse: 'ab123' to: {$a . $b} end: 2.
-
- self assert: parser fail: ''.
- self assert: parser fail: '123'.
-!
-
-testCompilePredicate
- parser := #digit asParser compileWithConfiguration: configuration.
-
- self assert: parser parse: '1' to: $1.
- self assert: parser parse: '0' to: $0.
- self assert: parser fail: 'a'.
-!
-
-testCompilePredicate2
- parser := #space asParser compileWithConfiguration: configuration.
-
- self assert: parser parse: ' ' to: Character space.
- self assert: parser fail: 'a'.
-!
-
-testCompileSequence
- parser := (#digit asParser, #letter asParser) compileWithConfiguration: configuration.
-
- self assert: parser parse: '1a' to: {$1 .$a}.
-
-
-!
-
-testCompileSequence2
- parser := (#digit asParser, #space asParser, #letter asParser) compileWithConfiguration: configuration.
-
- self assert: parser parse: '9 c' to: {$9 . Character space. $c }.
- self assert: parser fail: '9c'.
-
-!
-
-testCompileSequence3
- parser := (#any asParser, #any asParser, #any asParser) compileWithConfiguration: configuration.
-
- self assert: parser parse: 'foo' to: #($f $o $o).
- self assert: parser fail: 'fo'.
-
-!
-
-testCompileStar
- parser := #letter asParser star compileWithConfiguration: configuration.
-
- self assert: parser parse: 'lorem' to: {$l. $o. $r. $e. $m} .
- self assert: parser parse: '' to: {}.
- self assert: parser parse: '123' to: {} end: 0.
- self assert: parser parse: 'ab123' to: {$a . $b} end: 2.
-!
-
-testCompileStarLiteral
- parser := 'foo' asParser star compileWithConfiguration: configuration.
-
- self assert: parser parse: 'foo' to: #('foo' ) .
- self assert: parser parse: 'foofoo' to: #('foo' 'foo') .
- self assert: parser parse: 'foofoofoo' to: #('foo' 'foo' 'foo') .
- self assert: parser parse: '' to: #().
- self assert: parser parse: 'bar' to: #() end: 0.
-!
-
-testCompileStarPredicate
- parser := #letter asParser star compileWithConfiguration: configuration.
-
- self assert: parser parse: 'foo' to: #($f $o $o ) .
- self assert: parser parse: '' to: #().
- self assert: parser parse: '123' to: #() end: 0.
-!
-
-testCompileSymbolBlock
- parser := (#letter asParser) plus ==> #second.
- parser := parser compileWithConfiguration: configuration.
-
- self assert: parser parse: 'foo' to: $o.
- self assert: parser parse: 'bar' to: $a.
- self assert: parser fail: ''.
- self should: [ parser parse: 'f' ] raise: Error.
-!
-
-testCompileTrim
- parser := $a asParser trim compileWithConfiguration: configuration.
-
- self assert: parser fail: ''.
- self assert: parser parse: 'a' to: $a.
- self assert: parser parse: ' a' to: $a.
- self assert: parser parse: 'a ' to: $a.
- self assert: parser parse: ' a ' to: $a.
-!
-
-testCompileTrimmingToken
- | token1 token2 |
- token1 := (#letter asParser) plus trimmingToken.
- token2 := (#letter asParser) plus trimmingToken.
-
- parser := (token1, token2) compileWithConfiguration: configuration.
-
- self assert: parser parse: 'foo bar'.
- self assert: parser parse: ' foo bar '.
-!
-
-testCompileTrimmingToken2
- | token1 token2 |
- token1 := (#letter asParser) plus trimmingToken.
- token2 := (#letter asParser) plus trimmingToken / 'foo' asParser trimmingToken.
-
- parser := (token1, token2) compileWithConfiguration: configuration.
-
- self assert: parser parse: 'foo bar'.
- self assert: parser parse: ' foo bar '.
-!
-
-testCompileTrimmingToken3
- | token1 token2 |
- token1 := ($a asParser, $b asParser) trimmingToken name: 'token1'.
- token2 := (token1 not, $c asParser) trimmingToken name: 'token2'.
-
- parser := (token1 / token2) compileWithConfiguration: configuration.
-
- self assert: (parser class methodDictionary includesKey: #'token1').
- self assert: (parser class methodDictionary includesKey: #'token1_fast').
-
- self assert: parser parse: 'ab'.
- self assert: (result isKindOf: PPToken).
- self assert: result inputValue = 'ab'.
-
- self assert: parser parse: 'c'.
- self assert: (result isKindOf: PPToken).
- self assert: result inputValue = 'c'.
-
-! !
-
-!PPCProtype1Test methodsFor:'tests - extra'!
-
-testCompileSmalltalkToken
- parser := (#letter asParser, ((#letter asParser / #digit asParser) star)) smalltalkToken compileWithConfiguration: configuration.
-
- self assert: parser parse: 'foo'.
- self assert: result inputValue = 'foo'.
- self assert: parser parse: 'a'.
- self assert: result inputValue = 'a'.
- self assert: parser parse: 'f123a'.
- self assert: result inputValue = 'f123a'.
-
- self assert: parser fail: ''.
- self assert: parser fail: '12'.
-
- self assert: parser parse: ' "comment" foo'.
- self assert: result inputValue = 'foo'.
-
- self assert: parser parse: ' "comment" bar "another comment" '.
- self assert: result inputValue = 'bar'.
- self assert: parser parse: '
- "b"
- "b"
- foo
- "and yet, another comment"
-
- "one more to make sure :)"
- '.
- self assert: result inputValue = 'foo'.
-!
-
-testCycle
- | p1 block |
-
- p1 := PPDelegateParser new.
- block := ${ asParser, p1, $} asParser / nil asParser.
- p1 setParser: block.
-
- parser := block compileWithConfiguration: configuration.
- self assert: parser parse: '{}' to: { ${. nil . $} }.
- self assert: parser parse: '{{}}' to: { ${. { ${ . nil . $} } . $} }.
-
-!
-
-testSmalltalkToken
- parser := (#letter asParser, (#digit asParser / #letter asParser) star) smalltalkToken compileWithConfiguration: configuration.
-
- self assert: parser class methodDictionary size = 5.
- self assert: parser parse: 'foo'.
- self assert: result inputValue = 'foo'.
- self assert: context invocationCount = 8.
- self assert: context rememberCount = 0.
- self assert: context lwRememberCount = 1.
- self assert: context lwRestoreCount = 0.
-!
-
-testSmalltalkToken2
- id := (#letter asParser, (#digit asParser / #letter asParser) star)
- name: 'identifier';
- yourself.
-
- parser := (id wrapped, $: asParser) smalltalkToken
- name: 'kw';
- yourself.
-
- parser := parser compileWithConfiguration: configuration.
-
- self assert: parser parse: 'foo:'.
- self assert: result inputValue = 'foo:'.
-!
-
-testToken
- parser := (#letter asParser, (#digit asParser / #letter asParser) star) flatten compileWithConfiguration: configuration.
-
- self assert: parser parse: 'foo' to: 'foo'.
- self assert: parser parse: 'a' to: 'a'.
- self assert: parser parse: 'f123a' to: 'f123a'.
- self assert: parser fail: ''.
-!
-
-testToken2
- parser := (#letter asParser, (#digit asParser / #letter asParser) star) token compileWithConfiguration: configuration.
-
- self assert: parser class methodDictionary size = 4.
- self assert: parser parse: 'foo'.
- self assert: result inputValue = 'foo'.
- self assert: context invocationCount = 6.
- self assert: context rememberCount = 0.
- self assert: context lwRememberCount = 1.
- self assert: context lwRestoreCount = 0.
-!
-
-testTrimmingToken
- parser := (#letter asParser, (#digit asParser / #letter asParser) star) trimmingToken compileWithConfiguration: configuration.
-
- self assert: parser class methodDictionary size = 4.
-
- self assert: parser parse: 'foo'.
- self assert: result inputValue = 'foo'.
-
- self assert: context invocationCount = 6.
- self assert: context rememberCount = 0.
- self assert: context lwRememberCount = 1.
- self assert: context lwRestoreCount = 0.
-
- self assert: parser parse: ' foo '.
- self assert: result inputValue = 'foo'.
-
-
-
- self assert: parser fail: '123'.
-
- self assert: context invocationCount = 1.
- self assert: context rememberCount = 0.
- self assert: context lwRememberCount = 0.
- self assert: context lwRestoreCount = 0.
-
-
- self assert: parser fail: ''.
-!
-
-testTrimmingTokenNested
- | identifier kw |
- kw := 'false' asParser trimmingToken name: #kw.
- identifier := (kw not, (#letter asParser, #word asParser star)) trimmingToken name: #identifier.
-
- parser := identifier / kw.
- parser := parser compileWithConfiguration: configuration.
- self assert: parser class methodDictionary size = 5.
-
- self assert: parser parse: 'foo'.
- self assert: result inputValue = 'foo'.
-
- self assert: parser parse: 'false'.
- self assert: result inputValue = 'false'.
-!
-
-testTrimmingTokenNested2
- | identifier kw |
- kw := 'false' asParser trimmingToken name: #kw.
- identifier := (kw not, (#letter asParser, #word asParser star)) trimmingToken name: #identifier.
-
- parser := identifier / kw.
- parser := parser compileWithConfiguration: configuration.
- self assert: parser class methodDictionary size = 5.
-
- self assert: parser parse: 'foo'.
- self assert: result inputValue = 'foo'.
-
- self assert: parser parse: 'false'.
- self assert: result inputValue = 'false'.
-!
-
-testTrimmingTokenNested3
- | identifier kw |
- kw := ('false' asParser, #word asParser not) trimmingToken name: #kw.
- identifier := (kw not, (#letter asParser, #word asParser star)) trimmingToken name: #identifier.
-
- parser := identifier / kw.
- parser := parser compileWithConfiguration: configuration.
- self assert: parser class methodDictionary size = 8.
- self assert: (parser class methods anySatisfy: [ :m | m selector = #kw ]).
- self assert: (parser class methods anySatisfy: [ :m | m selector = #kw_fast ]).
-
- self assert: parser parse: 'foo'.
- self assert: result inputValue = 'foo'.
-
- self assert: parser parse: 'false'.
- self assert: result inputValue = 'false'.
-! !
-
-!PPCProtype1Test methodsFor:'tests - ids'!
-
-setUp
- arguments := PPCArguments default
- profile: true;
- yourself.
-
- configuration := PPCFirstPrototype new
- arguments: arguments;
- yourself.
-! !
-
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCRecognizerComponentDetectorTest.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,159 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCRecognizerComponentDetectorTest
+ instanceVariableNames:'node result visitor'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Visitors'
+!
+
+!PPCRecognizerComponentDetectorTest methodsFor:'as yet unclassified'!
+
+assert: object type: class
+ self assert: object class == class
+!
+
+setUp
+ visitor := PPCRecognizerComponentDetector new.
+!
+
+testActionNode
+ | seq characterNode1 characterNode2 tokenNode |
+ characterNode1 := PPCCharacterNode new.
+ characterNode2 := PPCCharacterNode new.
+
+ seq := PPCSequenceNode new
+ children: { characterNode1 . characterNode1 };
+ yourself.
+ tokenNode := PPCTokenNode new
+ child: seq;
+ yourself.
+
+ node := PPCActionNode new
+ child: tokenNode;
+ yourself.
+
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCActionNode.
+ self assert: result child type: PPCTokenNode.
+ self assert: result child child type: PPCRecognizingSequenceNode.
+
+ self assert: result == node.
+ self assert: (result child child firstChild == characterNode1) not.
+ self assert: (result child child firstChild = characterNode1).
+ self assert: (result child child secondChild == characterNode1) not.
+ self assert: (result child child secondChild = characterNode1).
+
+!
+
+testNestedTrimmingToken
+ | characterNode token ws trimmingToken |
+ characterNode := PPCCharacterNode new.
+ token := PPCTokenNode new
+ child: characterNode;
+ tokenClass: #foo;
+ yourself.
+ ws := PPCSentinelNode new.
+ trimmingToken := PPCTrimmingTokenNode new
+ child: token;
+ whitespace: ws;
+ propertyAt: #trimmingToken put: true;
+ yourself.
+
+ node := PPCSequenceNode new
+ children: { characterNode . trimmingToken };
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCSequenceNode.
+ self assert: result firstChild == characterNode.
+
+ self assert: result secondChild type: PPCTrimmingTokenNode.
+ self assert: result secondChild child = characterNode.
+ self assert: (result secondChild child == characterNode) not.
+!
+
+testNestedTrimmingToken2
+ | characterNode token1 ws seqWithToken trimmingToken1 token2 |
+ characterNode := PPCCharacterNode new.
+ ws := PPCSentinelNode new.
+
+ token1 := PPCTokenNode new
+ child: characterNode;
+ tokenClass: #foo;
+ yourself.
+ trimmingToken1 := PPCTrimmingTokenNode new
+ child: token1;
+ whitespace: ws;
+ propertyAt: #trimmingToken put: true;
+ yourself.
+
+ seqWithToken := PPCSequenceNode new
+ children: { characterNode . trimmingToken1 };
+ yourself.
+
+ token2 := PPCTokenNode new
+ child: seqWithToken;
+ tokenClass: #bar;
+ yourself.
+ node := PPCTrimmingTokenNode new
+ child: token2;
+ whitespace: ws;
+ propertyAt: #trimmingToken put: true;
+ yourself.
+ result := visitor visit: node.
+
+ self assert: result type: PPCTrimmingTokenNode .
+ self assert: result child type: PPCRecognizingSequenceNode.
+!
+
+testNodeCopy
+ | nilNode forwardNode |
+ nilNode := PPCNilNode new.
+ forwardNode := PPCForwardNode new
+ child: nilNode;
+ yourself.
+ node := PPCTokenNode new
+ child: forwardNode;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: (result == node).
+ self assert: result child = forwardNode.
+ self assert: (result child == forwardNode) not.
+ self assert: (result child child = nilNode).
+ self assert: (result child child == nilNode) not.
+!
+
+testRecognizingSequence1
+ | seq characterNode1 characterNode2 |
+ characterNode1 := PPCCharacterNode new.
+ characterNode2 := PPCCharacterNode new.
+
+ seq := PPCSequenceNode new
+ children: { characterNode1 . characterNode1 };
+ yourself.
+ node := PPCTokenNode new
+ child: seq;
+ yourself.
+
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCTokenNode.
+ self assert: result child type: PPCRecognizingSequenceNode.
+
+ self assert: result == node.
+ self assert: (result child firstChild == characterNode1) not.
+ self assert: (result child firstChild = characterNode1).
+ self assert: (result child secondChild == characterNode1) not.
+ self assert: (result child secondChild = characterNode1).
+
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCRecognizerComponentVisitorTest.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,260 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCRecognizerComponentVisitorTest
+ instanceVariableNames:'node result visitor'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Visitors'
+!
+
+
+!PPCRecognizerComponentVisitorTest methodsFor:'as yet unclassified'!
+
+asNode: aPPParser
+ self error: 'deprecated'.
+ ^ aPPParser asCompilerTree
+!
+
+assert: object type: class
+ self assert: object class == class
+!
+
+setUp
+ visitor := PPCRecognizerComponentVisitor new.
+!
+
+testAction
+ | letterNode |
+ letterNode := PPCMessagePredicateNode new
+ message: #isLetter;
+ yourself.
+
+ node := PPCActionNode new
+ block: [ :nodes | #foo ];
+ child: letterNode;
+ yourself.
+
+ result := visitor visit: node.
+ self assert: result type: PPCMessagePredicateNode.
+ self assert: result = letterNode.
+!
+
+testAction2
+ | letterNode actionNode |
+
+ letterNode := PPCMessagePredicateNode new
+ predicate: #isLetter;
+ yourself.
+
+ actionNode := PPCActionNode new
+ block: #boo;
+ child: letterNode;
+ yourself.
+
+ node := PPCTokenNode new
+ child: actionNode;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCMessagePredicateNode.
+ self assert: result = letterNode.
+!
+
+testAction3
+ | letterNode actionNode |
+
+ letterNode := PPCMessagePredicateNode new
+ predicate: #isLetter;
+ yourself.
+
+ actionNode := PPCActionNode new
+ block: #foo;
+ child: letterNode;
+ yourself.
+
+ node := PPCActionNode new
+ block: #foo;
+ child: actionNode;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCMessagePredicateNode.
+ self assert: result = letterNode.
+!
+
+testNotAction
+ | literalNode actionNode |
+ literalNode := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+
+ actionNode := PPCActionNode new
+ block: #foo;
+ child: literalNode;
+ yourself.
+
+ node := PPCNotNode new
+ child: actionNode;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCNotNode.
+ self assert: result child type: PPCLiteralNode.
+!
+
+testNotAction2
+ | literalNode actionNode seqNode |
+ literalNode := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+
+ seqNode := PPCSequenceNode new
+ children: { literalNode . literalNode };
+ yourself.
+
+ actionNode := PPCActionNode new
+ block: #foo;
+ child: seqNode;
+ yourself.
+
+ node := PPCNotNode new
+ child: actionNode;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCNotNode.
+
+ self assert: result child type: PPCRecognizingSequenceNode.
+ self assert: result child firstChild type: PPCLiteralNode.
+ self assert: result child secondChild type: PPCLiteralNode.
+!
+
+testNotAction3
+ | literalNode actionNode seqNode |
+ literalNode := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+
+ seqNode := PPCSequenceNode new
+ children: { literalNode . literalNode };
+ yourself.
+
+ actionNode := PPCSymbolActionNode new
+ symbol: #second;
+ child: seqNode;
+ yourself.
+
+ node := PPCNotNode new
+ child: actionNode;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCNotNode.
+
+ self assert: result child type: PPCRecognizingSequenceNode.
+ self assert: result child firstChild type: PPCLiteralNode.
+ self assert: result child secondChild type: PPCLiteralNode.
+!
+
+testRecognizingSequence1
+ | letterNode1 letterNode2 |
+ letterNode1 := PPCCharacterNode new character: $a.
+ letterNode2 := PPCCharacterNode new character: $b.
+
+ node := PPCSequenceNode new
+ children: { letterNode1 . letterNode2 };
+ yourself.
+ result := visitor visit: node.
+
+ self assert: result type: PPCRecognizingSequenceNode.
+ self assert: result firstChild = letterNode1.
+ self assert: result secondChild = letterNode2.
+!
+
+testStarMessagePredicate
+ | starNode |
+ starNode := PPCStarMessagePredicateNode new
+ message: #isLetter;
+ yourself.
+
+ node := PPCTokenNode new
+ child: starNode;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCTokenStarMessagePredicateNode.
+!
+
+testStarMessagePredicate2
+ | starNode |
+ starNode := PPCStarMessagePredicateNode new
+ message: #isSeparator;
+ yourself.
+
+ node := PPCTokenNode new
+ child: starNode;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCTokenStarSeparatorNode.
+!
+
+testToken
+ | letterNode |
+ letterNode := PPCMessagePredicateNode new
+ message: #isLetter;
+ yourself.
+
+ node := PPCTokenNode new
+ child: letterNode;
+ yourself.
+
+ result := visitor visit: node.
+ self assert: result type: PPCMessagePredicateNode.
+ self assert: result = letterNode.
+!
+
+testTrimmingToken
+ | letterNode tokenNode whitespaceNode |
+ letterNode := PPCMessagePredicateNode new
+ message: #isLetter;
+ yourself.
+
+ tokenNode := PPCTokenNode new
+ child: letterNode;
+ yourself.
+
+ whitespaceNode := PPCActionNode new
+ block: #foo;
+ child: letterNode;
+ yourself.
+
+ node := PPCTrimmingTokenNode new
+ child: tokenNode;
+ whitespace: whitespaceNode;
+ yourself.
+
+ result := visitor visit: node.
+ self assert: result type: PPCTrimmingTokenNode.
+ self assert: result child type: PPCMessagePredicateNode.
+ self assert: result child = letterNode.
+ self assert: result whitespace type: PPCMessagePredicateNode.
+ self assert: result whitespace = letterNode.
+! !
+
+!PPCRecognizerComponentVisitorTest class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCSpecializingVisitorTest.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,253 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCSpecializingVisitorTest
+ instanceVariableNames:'node result visitor'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Visitors'
+!
+
+!PPCSpecializingVisitorTest methodsFor:'as yet unclassified'!
+
+asNode: aPPParser
+ ^ aPPParser asCompilerTree
+!
+
+assert: object type: class
+ self assert: object class == class
+!
+
+setUp
+ visitor := PPCSpecializingVisitor new.
+!
+
+testAnyPredicate
+ node := self asNode: #any asParser.
+ result := visitor visit: node.
+
+ self assert: result type: PPCAnyNode.
+!
+
+testForward1
+ | literalNode |
+ literalNode := PPCLiteralNode new
+ literal: 'foo'.
+ node := PPCForwardNode new
+ child: literalNode;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCLiteralNode.
+ self assert: result = literalNode.
+!
+
+testForward2
+ | literalNode |
+ literalNode := PPCLiteralNode new
+ literal: 'foo'.
+ node := PPCForwardNode new
+ name: 'foo';
+ child: literalNode;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCLiteralNode.
+ self assert: result = literalNode.
+ self assert: result name = 'foo'.
+!
+
+testForward3
+ | literalNode |
+ literalNode := PPCLiteralNode new
+ name: 'foo';
+ literal: 'foo'.
+ node := PPCForwardNode new
+ name: 'foo';
+ child: literalNode;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCLiteralNode.
+ self assert: result = literalNode.
+ self assert: result name = 'foo'.
+!
+
+testForward4
+ | literalNode |
+ literalNode := PPCLiteralNode new
+ name: 'bar';
+ literal: 'foo'.
+ node := PPCForwardNode new
+ name: 'foo';
+ child: literalNode;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCForwardNode.
+ self assert: result = node.
+ self assert: result name = 'foo'.
+!
+
+testForward5
+ | literalNode |
+ literalNode := PPCLiteralNode new
+ name: 'foo';
+ literal: 'foo'.
+ node := PPCForwardNode new
+ child: literalNode;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCLiteralNode.
+ self assert: result = literalNode.
+ self assert: result name = 'foo'.
+!
+
+testIdentity
+ | token star1 star2 |
+ token := $a asParser token.
+ star1 := token star.
+ star2 := token star.
+ node := self asNode: star1, star2.
+ result := visitor visit: node.
+
+ self assert: result type: PPCSequenceNode.
+ self assert: result children first type: PPCStarNode.
+ self assert: result children second type: PPCStarNode.
+!
+
+testNoOptimization
+ node := self asNode: 'foo' asParser.
+ self assert: node type: PPCLiteralNode.
+
+ result := visitor visit: node.
+ self assert: result type: PPCLiteralNode.
+!
+
+testNotCharSet
+ node := self asNode: #hex asParser not.
+ result := visitor visit: node.
+
+ self assert: result type: PPCNotCharSetPredicateNode.
+!
+
+testNotLiteral
+ node := self asNode: 'foo' asParser not.
+ result := visitor visit: node.
+
+ self assert: result type: PPCNotLiteralNode.
+ self assert: result literal = 'foo'.
+!
+
+testNotMessagePredicate
+ node := self asNode: #letter asParser not.
+ result := visitor visit: node.
+
+ self assert: result type: PPCNotMessagePredicateNode.
+!
+
+testPredicateNode01
+ node := self asNode: #letter asParser.
+ result := visitor visit: node.
+
+ self assert: result type: PPCMessagePredicateNode.
+ self assert: result message = #isLetter.
+!
+
+testPredicateNode02
+ node := self asNode: #digit asParser.
+ result := visitor visit: node.
+
+ self assert: result type: PPCMessagePredicateNode.
+ self assert: result message = #isDigit.
+!
+
+testPredicateNode03
+ node := self asNode: #space asParser.
+ result := visitor visit: node.
+
+ self assert: result type: PPCMessagePredicateNode.
+ self assert: result message = #isSeparator.
+!
+
+testPredicateNode04
+ node := self asNode: #word asParser.
+ result := visitor visit: node.
+
+ self assert: result type: PPCMessagePredicateNode.
+ self assert: result message = #isAlphaNumeric.
+!
+
+testPredicateNode05
+ node := self asNode: #hex asParser.
+ result := visitor visit: node.
+
+ self assert: result type: PPCCharSetPredicateNode.
+!
+
+testStarNode1
+ node := self asNode: #letter asParser star.
+ result := visitor visit: node.
+
+ self assert: result type: PPCStarMessagePredicateNode.
+ self assert: result message = #isLetter.
+!
+
+testStarNode2
+ node := self asNode: #any asParser star.
+ result := visitor visit: node.
+
+ self assert: result type: PPCStarAnyNode.
+!
+
+testStarNode3
+ node := self asNode: #hex asParser star.
+ result := visitor visit: node.
+
+ self assert: result type: PPCStarCharSetPredicateNode.
+!
+
+testStarNode4
+ node := self asNode: #letter asParser not star.
+ result := visitor visit: node.
+
+ self assert: result type: PPCStarNode.
+ self assert: result child type: PPCNotMessagePredicateNode.
+!
+
+testStarNode5
+ | star |
+ star := $a asParser not star.
+ node := self asNode: star, star.
+ result := visitor visit: node.
+
+ self assert: result type: PPCSequenceNode.
+ self assert: result children first type: PPCStarNode.
+ self assert: result children second type: PPCStarNode.
+!
+
+testTrimNode1
+ | literalNode |
+ literalNode := PPCLiteralNode new
+ literal: 'foo'.
+ node := PPCTrimNode new
+ child: literalNode;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCTrimNode.
+ self assert: result trimmer type: PPCStarMessagePredicateNode.
+ self assert: result trimmer message = #isSeparator.
+
+ self assert: result child type: PPCLiteralNode.
+ self assert: result child literal = 'foo'.
+! !
+
--- a/compiler/tests/PPCTokenDetectorTest.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPCTokenDetectorTest.st Sun May 10 06:28:36 2015 +0100
@@ -12,228 +12,206 @@
!PPCTokenDetectorTest methodsFor:'as yet unclassified'!
assert: object type: class
- self assert: object class == class
+ self assert: object class == class
!
setUp
- visitor := PPCTokenDetector new.
+ visitor := PPCTokenDetector new.
!
-testActionNode
- | seq characterNode1 characterNode2 tokenNode |
- characterNode1 := PPCCharacterNode new.
- characterNode2 := PPCCharacterNode new.
-
- seq := PPCSequenceNode new
- children: { characterNode1 . characterNode1 };
- yourself.
- tokenNode := PPCTokenNode new
- child: seq;
- yourself.
-
- node := PPCActionNode new
- child: tokenNode;
- yourself.
-
-
- result := visitor visit: node.
-
- self assert: result type: PPCActionNode.
- self assert: result child type: PPCTokenNode.
- self assert: result child child type: PPCTokenSequenceNode.
+testNestedTrimmingTokenJava
+ | trueToken falseToken booleanLiteral literal abc notBoolean id idSeq javaToken resultId resultBooleanLiteral resultIdBooleanLiteral |
+ "
+ This USE case is based on JavaToken
+
+ javaToken := id / literal
+ id := (not booleanLiteral, 'abc') token
+ literal := booleanLiteral
+ booleanLiteral := 'true' token / 'false' token
+ "
+ trueToken := 'true' asParser token asCompilerTree.
+ falseToken := 'false' asParser token asCompilerTree.
+ abc := 'abc' asParser asCompilerTree.
+
+ booleanLiteral := PPCChoiceNode new
+ children: { trueToken . falseToken }; yourself.
- self assert: result == node.
- self assert: (result child child firstChild == characterNode1) not.
- self assert: (result child child firstChild = characterNode1).
- self assert: (result child child secondChild == characterNode1) not.
- self assert: (result child child secondChild = characterNode1).
-
+ literal := PPCForwardNode new
+ name: #literal;
+ child: booleanLiteral; yourself.
+ notBoolean := PPCNotNode new
+ child: booleanLiteral; yourself.
+ idSeq := PPCSequenceNode new
+ children: { notBoolean . abc }; yourself.
+ id := PPCTokenNode new
+ child: idSeq; yourself.
+ javaToken := PPCChoiceNode new
+ children: { id . literal }; yourself.
+
+ result := visitor visit: javaToken.
+ resultId := result firstChild.
+ resultBooleanLiteral := result secondChild child.
+ resultIdBooleanLiteral := resultId child firstChild child.
+
+
+
+ self assert: result type: PPCChoiceNode.
+ self assert: resultId type: PPCTokenNode.
+ self assert: resultBooleanLiteral type: PPCChoiceNode.
+
+ self assert: resultIdBooleanLiteral firstChild type: PPCLiteralNode.
+ self assert: resultIdBooleanLiteral secondChild type: PPCLiteralNode.
+
+ self assert: resultBooleanLiteral firstChild type: PPCTokenNode.
+ self assert: resultBooleanLiteral secondChild type: PPCTokenNode.
+
+
!
-testNestedTrimmingToken
- | characterNode token ws seq trimmingToken |
- characterNode := PPCCharacterNode new.
- token := PPCTokenNode new
- child: characterNode;
- tokenClass: #foo;
- yourself.
- ws := PPCSentinelNode new.
- seq := PPCSequenceNode new
- children: { ws . token . ws };
- yourself.
- trimmingToken := PPCActionNode new
- child: seq;
- propertyAt: #trimmingToken put: true;
- yourself.
-
- node := PPCSequenceNode new
- children: { characterNode . trimmingToken };
- yourself.
-
- result := visitor visit: node.
-
- self assert: result type: PPCSequenceNode.
- self assert: result firstChild == characterNode.
-
- self assert: result secondChild type: PPCTrimmingTokenNode.
- self assert: result secondChild child = characterNode.
- self assert: (result secondChild child == characterNode) not.
+testToken
+ | characterNode token |
+ characterNode := PPCCharacterNode new.
+ token := PPCTokenNode new
+ child: characterNode;
+ tokenClass: #foo;
+ yourself.
+ node := PPCForwardNode new
+ child: token;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCForwardNode.
+ self assert: result child type: PPCTokenNode.
+ self assert: result child child = characterNode.
!
-testNestedTrimmingToken2
- | characterNode token1 ws seq1 seq2 seqWithToken trimmingToken1 token2 |
- characterNode := PPCCharacterNode new.
- ws := PPCSentinelNode new.
-
- token1 := PPCTokenNode new
- child: characterNode;
- tokenClass: #foo;
- yourself.
- seq1 := PPCSequenceNode new
- children: { ws . token1 . ws };
- yourself.
- trimmingToken1 := PPCActionNode new
- child: seq1;
- propertyAt: #trimmingToken put: true;
- yourself.
-
- seqWithToken := PPCSequenceNode new
- children: { characterNode . trimmingToken1 };
- yourself.
-
- token2 := PPCTokenNode new
- child: seqWithToken;
- tokenClass: #bar;
- yourself.
- seq2 := PPCSequenceNode new
- children: { ws . token2 . ws };
- yourself.
- node := PPCActionNode new
- child: seq2;
- propertyAt: #trimmingToken put: true;
- yourself.
- result := visitor visit: node.
-
- self assert: result type: PPCTrimmingTokenNode .
- self assert: result child type: PPCTokenSequenceNode.
+testToken2
+ | characterNode inToken forwardNode |
+ characterNode := PPCCharacterNode new.
+ forwardNode := PPCForwardNode new
+ child: characterNode;
+ yourself.
+ inToken := PPCTokenNode new
+ child: forwardNode;
+ tokenClass: #foo;
+ name: 'inToken';
+ yourself.
+ node := PPCTokenNode new
+ child: inToken ;
+ tokenClass: #bar;
+ name: 'token';
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCTokenNode.
+ self assert: result child type: PPCForwardNode.
+ self assert: result child name = 'inToken'.
+ self assert: result child child = characterNode.
!
-testNestedTrimmingToken3
- | trueToken falseToken booleanLiteral literal abc notBoolean id idSeq javaToken resultId resultBooleanLiteral resultIdBooleanLiteral |
- "
- This USE case is based on JavaToken
-
- javaToken := id / literal
- id := (not booleanLiteral, 'abc') token
- literal := booleanLiteral
- booleanLiteral := 'true' token / 'false' token
- "
- trueToken := 'true' asParser token asCompilerTree.
- falseToken := 'false' asParser token asCompilerTree.
- abc := 'abc' asParser asCompilerTree.
-
- booleanLiteral := PPCChoiceNode new
- children: { trueToken . falseToken }; yourself.
-
- literal := PPCForwardNode new
- name: #literal;
- child: booleanLiteral; yourself.
- notBoolean := PPCNotNode new
- child: booleanLiteral; yourself.
- idSeq := PPCSequenceNode new
- children: { notBoolean . abc }; yourself.
- id := PPCTokenNode new
- child: idSeq; yourself.
- javaToken := PPCChoiceNode new
- children: { id . literal }; yourself.
-
- result := visitor visit: javaToken.
- resultId := result firstChild.
- resultBooleanLiteral := result secondChild child.
- resultIdBooleanLiteral := resultId child firstChild child.
-
-
-
- self assert: result type: PPCChoiceNode.
- self assert: resultId type: PPCTokenNode.
- self assert: resultBooleanLiteral type: PPCChoiceNode.
-
- self assert: resultIdBooleanLiteral firstChild type: PPCLiteralNode.
- self assert: resultIdBooleanLiteral secondChild type: PPCLiteralNode.
-
- self assert: resultBooleanLiteral firstChild type: PPCTokenNode.
- self assert: resultBooleanLiteral secondChild type: PPCTokenNode.
-
-
+testToken3
+ | characterNode inToken forwardNode |
+ characterNode := PPCCharacterNode new.
+ forwardNode := PPCForwardNode new
+ child: characterNode;
+ name: 'forward';
+ yourself.
+ inToken := PPCTokenNode new
+ child: forwardNode;
+ tokenClass: #foo;
+ name: 'inToken';
+ yourself.
+ node := PPCTokenNode new
+ child: inToken ;
+ tokenClass: #bar;
+ name: 'token';
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCTokenNode.
+ self assert: result child type: PPCForwardNode.
+ self assert: result child name = 'inToken'.
+ self assert: result child child type: PPCForwardNode.
+ self assert: result child child name = 'forward'.
+
!
-testNodeCopy
- | nilNode forwardNode |
- nilNode := PPCNilNode new.
- forwardNode := PPCForwardNode new
- child: nilNode;
- yourself.
- node := PPCTokenNode new
- child: forwardNode;
- yourself.
-
- result := visitor visit: node.
-
- self assert: (result == node).
- self assert: result child = forwardNode.
- self assert: (result child == forwardNode) not.
- self assert: (result child child = nilNode).
- self assert: (result child child == nilNode) not.
-!
+testTrimToken1
+ | literalNode tokenNode |
+ literalNode := PPCLiteralNode new
+ literal: 'foo'.
+ tokenNode := PPCTokenNode new
+ child: literalNode;
+ tokenClass: #foo;
+ yourself.
+ node := PPCTrimNode new
+ child: tokenNode;
+ yourself.
-testTokenSequence1
- | seq characterNode1 characterNode2 |
- characterNode1 := PPCCharacterNode new.
- characterNode2 := PPCCharacterNode new.
-
- seq := PPCSequenceNode new
- children: { characterNode1 . characterNode1 };
- yourself.
- node := PPCTokenNode new
- child: seq;
- yourself.
-
-
- result := visitor visit: node.
-
- self assert: result type: PPCTokenNode.
- self assert: result child type: PPCTokenSequenceNode.
-
- self assert: result == node.
- self assert: (result child firstChild == characterNode1) not.
- self assert: (result child firstChild = characterNode1).
- self assert: (result child secondChild == characterNode1) not.
- self assert: (result child secondChild = characterNode1).
-
+ result := visitor visit: node.
+
+ self assert: result type: PPCTrimmingTokenNode.
+ self assert: result whitespace type: PPCStarNode.
+ self assert: result tokenClass = #foo.
+
+ self assert: result child type: PPCLiteralNode.
+ self assert: result child literal = 'foo'.
!
testTrimmingToken
- | seq characterNode ws token |
- characterNode := PPCCharacterNode new.
- token := PPCTokenNode new
- child: characterNode;
- tokenClass: #foo;
- yourself.
- ws := PPCSentinelNode new.
-
- seq := PPCSequenceNode new
- children: { ws . token . ws };
- yourself.
- node := PPCActionNode new
- child: seq;
- propertyAt: #trimmingToken put: true;
- yourself.
-
- result := visitor visit: node.
-
- self assert: result type: PPCTrimmingTokenNode.
- self assert: result child type: PPCCharacterNode.
- self assert: result child = characterNode.
- self assert: (result child == characterNode) not.
+ | seq characterNode ws token |
+ characterNode := PPCCharacterNode new.
+ token := PPCTokenNode new
+ child: characterNode;
+ tokenClass: #foo;
+ yourself.
+ ws := PPCSentinelNode new.
+
+ seq := PPCSequenceNode new
+ children: { ws . token . ws };
+ yourself.
+ node := PPCActionNode new
+ child: seq;
+ propertyAt: #trimmingToken put: true;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCTrimmingTokenNode.
+ self assert: result child type: PPCCharacterNode.
+ self assert: result child = characterNode.
+ self assert: result whitespace type: PPCSentinelNode.
+!
+
+testTrimmingToken2
+ | seq characterNode ws token tokenIn |
+ characterNode := PPCCharacterNode new.
+ tokenIn := PPCTokenNode new
+ child: characterNode;
+ tokenClass: #foo;
+ yourself.
+ token := PPCTokenNode new
+ child: tokenIn;
+ tokenClass: #bar;
+ yourself.
+ ws := PPCSentinelNode new.
+
+ seq := PPCSequenceNode new
+ children: { ws . token . ws };
+ yourself.
+ node := PPCActionNode new
+ child: seq;
+ propertyAt: #trimmingToken put: true;
+ yourself.
+
+ result := visitor visit: node.
+
+ self assert: result type: PPCTrimmingTokenNode.
+ self assert: result child type: PPCCharacterNode.
+ self assert: result child = characterNode.
+ self assert: result whitespace type: PPCSentinelNode.
! !
--- a/compiler/tests/PPCTokenVisitorTest.st Thu Apr 30 23:43:14 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,194 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
-
-"{ NameSpace: Smalltalk }"
-
-TestCase subclass:#PPCTokenVisitorTest
- instanceVariableNames:'node result visitor'
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Tests-Visitors'
-!
-
-!PPCTokenVisitorTest methodsFor:'as yet unclassified'!
-
-asNode: aPPParser
- self error: 'deprecated'.
- ^ aPPParser asCompilerTree
-!
-
-assert: object type: class
- self assert: object class == class
-!
-
-setUp
- visitor := PPCTokenVisitor new.
-!
-
-testAction
- | letterNode |
- letterNode := PPCMessagePredicateNode new
- message: #isLetter;
- yourself.
-
- node := PPCActionNode new
- block: [ :nodes | #foo ];
- child: letterNode;
- yourself.
-
- result := visitor visit: node.
- self assert: result type: PPCMessagePredicateNode.
- self assert: result = letterNode.
-!
-
-testAction2
- | letterNode actionNode |
-
- letterNode := PPCMessagePredicateNode new
- predicate: #isLetter;
- yourself.
-
- actionNode := PPCActionNode new
- block: #boo;
- child: letterNode;
- yourself.
-
- node := PPCTokenNode new
- child: actionNode;
- yourself.
-
- result := visitor visit: node.
-
- self assert: result type: PPCMessagePredicateNode.
- self assert: result = letterNode.
-!
-
-testAction3
- | letterNode actionNode |
-
- letterNode := PPCMessagePredicateNode new
- predicate: #isLetter;
- yourself.
-
- actionNode := PPCActionNode new
- block: #foo;
- child: letterNode;
- yourself.
-
- node := PPCActionNode new
- block: #foo;
- child: actionNode;
- yourself.
-
- result := visitor visit: node.
-
- self assert: result type: PPCMessagePredicateNode.
- self assert: result = letterNode.
-!
-
-testNotAction
- | literalNode actionNode |
- literalNode := PPCLiteralNode new
- literal: 'foo';
- yourself.
-
- actionNode := PPCActionNode new
- block: #foo;
- child: literalNode;
- yourself.
-
- node := PPCNotNode new
- child: actionNode;
- yourself.
-
- result := visitor visit: node.
-
- self assert: result type: PPCNotNode.
- self assert: result child type: PPCLiteralNode.
-!
-
-testNotAction2
- | literalNode actionNode seqNode |
- literalNode := PPCLiteralNode new
- literal: 'foo';
- yourself.
-
- seqNode := PPCSequenceNode new
- children: { literalNode . literalNode };
- yourself.
-
- actionNode := PPCActionNode new
- block: #foo;
- child: seqNode;
- yourself.
-
- node := PPCNotNode new
- child: actionNode;
- yourself.
-
- result := visitor visit: node.
-
- self assert: result type: PPCNotNode.
-
- self assert: result child type: PPCTokenSequenceNode.
- self assert: result child firstChild type: PPCLiteralNode.
- self assert: result child secondChild type: PPCLiteralNode.
-!
-
-testNotAction3
- | literalNode actionNode seqNode |
- literalNode := PPCLiteralNode new
- literal: 'foo';
- yourself.
-
- seqNode := PPCSequenceNode new
- children: { literalNode . literalNode };
- yourself.
-
- actionNode := PPCSymbolActionNode new
- symbol: #second;
- child: seqNode;
- yourself.
-
- node := PPCNotNode new
- child: actionNode;
- yourself.
-
- result := visitor visit: node.
-
- self assert: result type: PPCNotNode.
-
- self assert: result child type: PPCTokenSequenceNode.
- self assert: result child firstChild type: PPCLiteralNode.
- self assert: result child secondChild type: PPCLiteralNode.
-!
-
-testStarMessagePredicate
- | starNode |
- starNode := PPCStarMessagePredicateNode new
- message: #isLetter;
- yourself.
-
- node := PPCTokenNode new
- child: starNode;
- yourself.
-
- result := visitor visit: node.
-
- self assert: result type: PPCTokenStarMessagePredicateNode.
-!
-
-testTokenSequence1
- | letterNode1 letterNode2 |
- letterNode1 := PPCCharacterNode new character: $a.
- letterNode2 := PPCCharacterNode new character: $b.
-
- node := PPCSequenceNode new
- children: { letterNode1 . letterNode2 };
- yourself.
- result := visitor visit: node.
-
- self assert: result type: PPCTokenSequenceNode.
- self assert: result firstChild = letterNode1.
- self assert: result secondChild = letterNode2.
-! !
-
--- a/compiler/tests/PPCTokenizingCodeGeneratorTest.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPCTokenizingCodeGeneratorTest.st Sun May 10 06:28:36 2015 +0100
@@ -3,141 +3,237 @@
"{ NameSpace: Smalltalk }"
PPAbstractParserTest subclass:#PPCTokenizingCodeGeneratorTest
- instanceVariableNames:'visitor node result compiler parser context choiceNode tokenizer
- arguments'
+ instanceVariableNames:'visitor node result compiler parser context arguments tokenizer'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Tests-Visitors'
!
-!PPCTokenizingCodeGeneratorTest methodsFor:'as yet unclassified'!
-
-assert: whatever parse: input
- result := super assert: whatever parse: input.
-!
-
-assert: whatever recognizesToken: input
- whatever startSymbol: #nextToken.
-
- self assert: whatever parse: input.
- self assert: (result isKindOf: PPToken).
-
- whatever startSymbol: #start
-!
+!PPCTokenizingCodeGeneratorTest methodsFor:'setup'!
compileTokenizer: aNode
-
- tokenizer := visitor visit: 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
- ].
- parser := configuration compile: root arguments: arguments.
-
+ configuration := PPCPluggableConfiguration on: [ :_self |
+ result := (visitor visit: _self ir).
+ compiler compileParser startSymbol: result methodName.
+ parser := compiler compileParser new.
+ _self ir: parser
+ ].
+ configuration arguments: arguments.
+ parser := configuration compile: root.
+
!
context
- ^ context := PPCProfilingContext new
-!
-
-literalNode: literal
- ^ PPCLiteralNode new
- literal: literal;
- yourself
+ ^ context := PPCProfilingContext new
!
setUp
- arguments := PPCArguments default
- profile: true;
- yourself.
-
- compiler := PPCCompiler new.
- compiler arguments: arguments.
-
- visitor := PPCTokenizingCodeGenerator new.
- visitor compiler: compiler.
+ arguments := PPCArguments default
+ profile: true;
+ yourself.
+
+ compiler := PPCTokenizingCompiler new.
+ compiler arguments: arguments.
+
+ visitor := PPCTokenizingCodeGenerator new.
+ visitor compiler: compiler.
+ visitor arguments: arguments.
!
tearDown
- | class |
+ | class |
- class := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]).
- class notNil ifTrue:[
- class removeFromSystem
- ].
+ class := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]).
+ class notNil ifTrue:[
+ class removeFromSystem
+ ].
+! !
+
+!PPCTokenizingCodeGeneratorTest methodsFor:'support'!
+
+assert: whatever parse: input
+ result := super assert: whatever parse: input.
!
-testSimpleChoice1
- | token1 token2 token1Consume token2Consume tokenizerNode eof |
-
- token1 := (self tokenNodeForLiteral: 'foo') markForInline; yourself.
- token2 := (self tokenNodeForLiteral: 'bar') markForInline; yourself.
- eof := (self tokenNodeForEOF) markForInline; yourself.
-
- token1Consume := PPCTokenConsumeNode new
- child: token1;
- yourself.
- token2Consume := PPCTokenConsumeNode new
- child: token2;
- yourself.
+assert: whatever recognizesToken: input
+ whatever startSymbol: #nextToken.
+
+ self assert: whatever parse: input.
+ self assert: (result isKindOf: PPToken).
+
+ whatever startSymbol: #start
+!
- choiceNode := PPCLLChoiceNode new
- children: { token1Consume . token2Consume };
- yourself.
-
- tokenizerNode := PPCChoiceNode new
- children: { token1 . token2 . eof };
- name: 'nextToken';
- yourself.
-
- self compileTokenizer: tokenizerNode.
- self compileTree: choiceNode.
-
- self assert: parser recognizesToken: 'foo'.
- self assert: parser recognizesToken: 'bar'.
- self assert: parser recognizesToken: ''.
-
- parser := compiler compiledParser new.
- self assert: parser parse: 'foo'.
- self assert: result inputValue = 'foo'.
+assert: whatever rejectsToken: input
+ whatever startSymbol: #nextToken.
+
+ self assert: whatever fail: input.
+
+ whatever startSymbol: #start
+!
- parser := compiler compiledParser new.
- self assert: parser parse: 'bar'.
- self assert: result inputValue = 'bar'.
-
- parser := compiler compiledParser new.
- self assert: parser fail: 'baz'.
+literalNode: literal
+ ^ PPCLiteralNode new
+ literal: literal;
+ yourself
!
tokenNode: child
- ^ PPCTokenNode new
- child: child;
- tokenClass: PPToken;
- yourself
+ child markForInline.
+
+ ^ PPCTokenNode new
+ child: child;
+ tokenClass: PPToken;
+ yourself
!
tokenNodeForEOF
- | eof |
- eof := PPCEndOfFileNode new
- yourself.
-
- ^ PPCTokenNode new
- child: eof;
- tokenClass: PPToken;
- yourself.
+ | eof |
+ eof := PPCEndOfFileNode new
+ yourself;
+ markForInline.
+
+ ^ PPCTokenNode new
+ child: eof;
+ tokenClass: PPToken;
+ yourself.
!
tokenNodeForLiteral: literal
- | literalNode |
- literalNode := self literalNode: literal.
- ^ self tokenNode: literalNode
+ | literalNode |
+ literalNode := self literalNode: literal.
+ ^ self trimmingTokenNode: literalNode
+!
+
+trimmingTokenNode: child
+ | ws |
+ ws := PPCStarNode new
+ child: (PPCMessagePredicateNode new
+ message: #isSeparator ;
+ markForInline ;
+ yourself);
+ yourself.
+
+ child markForInline.
+
+ ^ PPCTrimmingTokenNode new
+ child: child;
+ whitespace: ws;
+ tokenClass: PPToken;
+ yourself
! !
+!PPCTokenizingCodeGeneratorTest methodsFor:'testing'!
+
+testSimpleChoice1
+ | token1 token2 token1Consume token2Consume tokenizerNode eof choiceNode |
+
+ token1 := (self tokenNodeForLiteral: 'foo') yourself.
+ token2 := (self tokenNodeForLiteral: 'bar') yourself.
+ eof := (self tokenNodeForEOF) yourself.
+
+ token1Consume := PPCTokenConsumeNode new
+ child: token1;
+ yourself.
+ token2Consume := PPCTokenConsumeNode new
+ child: token2;
+ yourself.
+
+ choiceNode := PPCDeterministicChoiceNode new
+ children: { token1Consume . token2Consume };
+ yourself.
+
+ tokenizerNode := PPCTokenChoiceNode new
+ children: { token1 . token2 . eof };
+ name: 'nextToken';
+ yourself.
+
+ self compileTokenizer: tokenizerNode.
+ self compileTree: choiceNode.
+
+ self assert: parser recognizesToken: 'foo'.
+ self assert: parser recognizesToken: 'bar'.
+ self assert: parser recognizesToken: ''.
+
+ parser := compiler compiledParser new.
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+
+ parser := compiler compiledParser new.
+ self assert: parser parse: 'bar'.
+ self assert: result inputValue = 'bar'.
+
+ parser := compiler compiledParser new.
+ self assert: parser fail: 'baz'.
+!
+
+testTokenizingParserNode
+ | tokenNode tokenizerNode consumeNode eof |
+ tokenNode := (self tokenNodeForLiteral: 'bar') yourself.
+ eof := (self tokenNodeForEOF) yourself.
+
+ tokenizerNode := PPCTokenChoiceNode new
+ children: { tokenNode . eof };
+ name: 'nextToken';
+ yourself.
+ consumeNode := PPCTokenConsumeNode new
+ child: tokenNode;
+ yourself.
+ node := PPCTokenizingParserNode new
+ parser: consumeNode;
+ tokenizer: tokenizerNode;
+ yourself.
+
+
+ self compileTree: node.
+
+ self assert: parser recognizesToken: 'bar'.
+ self assert: parser recognizesToken: ''.
+ self assert: parser rejectsToken: 'foo'.
+
+ parser := compiler compiledParser new.
+ self assert: parser parse: 'bar'.
+ self assert: result inputValue = 'bar'.
+
+ parser := compiler compiledParser new.
+ self assert: parser fail: 'foo'.
+!
+
+testTrimmingToken1
+ | token tokenConsume tokenizerNode eof |
+
+ token := self trimmingTokenNode: (self literalNode: 'foo').
+ eof := (self tokenNodeForEOF) yourself.
+
+ tokenConsume := PPCTokenConsumeNode new
+ child: token;
+ yourself.
+
+ tokenizerNode := PPCTokenChoiceNode new
+ children: { token . eof };
+ name: 'nextToken';
+ yourself.
+
+ self compileTokenizer: tokenizerNode.
+ self compileTree: tokenConsume.
+
+ self assert: parser recognizesToken: 'foo'.
+ self assert: parser recognizesToken: ' foo'.
+ self assert: parser recognizesToken: ' '.
+ self assert: parser recognizesToken: ''.
+
+ parser := compiler compiledParser new.
+ self assert: parser parse: ' foo'.
+ self assert: result inputValue = 'foo'.
+
+ parser := compiler compiledParser new.
+ self assert: parser fail: 'baz'.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCTokenizingVisitorTest.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,79 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCTokenizingVisitorTest
+ instanceVariableNames:'node result visitor'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Visitors'
+!
+
+!PPCTokenizingVisitorTest methodsFor:'as yet unclassified'!
+
+assert: object type: class
+ self assert: object class == class
+!
+
+setUp
+ visitor := PPCTokenizingVisitor new.
+!
+
+testTokenNode1
+ | nilNode |
+ nilNode := PPCNilNode new.
+ node := PPCTokenNode new
+ child: nilNode.
+ result := visitor visit: node.
+
+ self assert: result type: PPCTokenizingParserNode.
+ 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 ]).
+!
+
+testTokenizingParserNode
+ node := PPCNilNode new.
+ result := visitor visit: node.
+
+ self assert: result type: PPCTokenizingParserNode.
+ self assert: result parser = node.
+ self assert: result tokenizer children size = 1.
+!
+
+testTokenizingParserNode2
+ | nilNode |
+ nilNode := PPCNilNode new.
+ node := PPCTokenNode new
+ child: nilNode.
+ result := visitor visit: node.
+
+ self assert: result type: PPCTokenizingParserNode.
+ 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 ]).
+!
+
+testTrimmingTokenNode1
+ | nilNode tokenNode |
+ nilNode := PPCNilNode new.
+ tokenNode := PPCTokenNode new
+ child: nilNode.
+ node := PPCTrimmingTokenNode new
+ child: tokenNode;
+ whitespace: nilNode;
+ yourself.
+ result := visitor visit: node.
+
+ self assert: result type: PPCTokenizingParserNode.
+ 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 ]).
+! !
+
--- a/compiler/tests/PPCVerificationTest.st Thu Apr 30 23:43:14 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,113 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPAbstractParserTest subclass:#PPCVerificationTest
- instanceVariableNames:'parser result context resource'
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Tests-Core'
-!
-
-!PPCVerificationTest class methodsFor:'as yet unclassified'!
-
-resources
- ^ (OrderedCollection with: PPCompiledJavaResource with: PPCompiledSmalltalkGrammarResource)
- addAll: super resources;
- yourself
-! !
-
-!PPCVerificationTest methodsFor:'tests - verification Java'!
-
-compiledJavaSyntax
- ^ (Smalltalk at: #PPCompiledJavaSyntax) new
-!
-
-compiledSmalltalkGrammar
- ^ (Smalltalk at: #PPCompiledSmalltalkGrammar) new
-!
-
-context
- ^ context := PPCProfilingContext new
-!
-
-javaSyntax
- ^ PPJavaSyntax new
-!
-
-setUp
- super setUp.
-!
-
-smalltalkGrammar
- ^ PPSmalltalkGrammar new
-!
-
-testJava
- | compiledParser normalParser |
- normalParser := self javaSyntax.
- compiledParser := self compiledJavaSyntax.
-
- PPCBenchmarkResources new javaSourcesBig do: [ :source |
- result := normalParser parse: source.
- result isPetitFailure not ifTrue: [
- self assert: (compiledParser parse: source withContext: self context)
- equals: result
- ]
- ].
-!
-
-testJavaTimer
- | compiledParser normalParser source |
- normalParser := self javaSyntax.
-
- source := FileStream fileNamed: '../java-src/java/util/Timer.java'.
- result := normalParser parse: source.
-
- result isPetitFailure not ifTrue: [
- compiledParser := self compiledJavaSyntax.
- self assert: (compiledParser parse: source withContext: self context)
- equals: result
- ]
-! !
-
-!PPCVerificationTest methodsFor:'tests - verification Smalltalk'!
-
-testSmalltalk
- | compiledParser normalParser expected actual |
- normalParser := self smalltalkGrammar.
- compiledParser := self compiledSmalltalkGrammar.
-
- PPCBenchmarkResources new 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 source |
- normalParser := self smalltalkGrammar.
- compiledParser := self compiledSmalltalkGrammar.
-
- Class methods do: [ :m |
- source := m sourceCode.
- self assert: (normalParser parse: source)
- equals: (compiledParser parse: source withContext: self context).
- ].
-!
-
-testSmalltalkObject
- | compiledParser normalParser source |
- normalParser := self smalltalkGrammar.
- compiledParser := self compiledSmalltalkGrammar.
-
- Object methods do: [ :m |
- source := m sourceCode.
- self assert: (normalParser parse: source)
- equals: (compiledParser parse: source withContext: self context).
- ].
-! !
-
--- a/compiler/tests/PPCompiledExpressionGrammarResource.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPCompiledExpressionGrammarResource.st Sun May 10 06:28:36 2015 +0100
@@ -12,11 +12,15 @@
!PPCompiledExpressionGrammarResource methodsFor:'as yet unclassified'!
setUp
- | time |
- time := Time millisecondsToRun: [
- PPExpressionGrammar new compileAs: #PPCompiledExpressionGrammar
- ].
- Transcript crShow: 'Exprssion grammar compiled in: ', time asString, 'ms'.
-
+ | time configuration |
+ configuration := PPCLL1Configuration new.
+ configuration arguments name:#PPCompiledExpressionGrammar.
+
+
+ time := Time millisecondsToRun: [
+ PPExpressionGrammar new compileWithConfiguration: configuration.
+ ].
+ Transcript crShow: 'Expression grammar compiled in: ', time asString, 'ms'.
+
! !
--- a/compiler/tests/PPCompiledExpressionGrammarTest.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPCompiledExpressionGrammarTest.st Sun May 10 06:28:36 2015 +0100
@@ -12,43 +12,112 @@
!PPCompiledExpressionGrammarTest class methodsFor:'as yet unclassified'!
resources
- ^ (OrderedCollection with: PPCompiledExpressionGrammarResource)
- addAll: super resources;
- yourself
+ ^ (OrderedCollection with: PPCompiledExpressionGrammarResource)
+ addAll: super resources;
+ yourself
! !
!PPCompiledExpressionGrammarTest methodsFor:'as yet unclassified'!
compilerArguments
- ^ PPCArguments default
- profile: true;
- ll: true;
- yourself
+ ^ PPCArguments default
+ profile: true;
+ ll: true;
+ yourself
!
context
- ^ PPCContext new
+ ^ PPCContext new
!
parserClass
- ^ Smalltalk at: #PPCompiledExpressionGrammar
+ ^ Smalltalk at: #PPCompiledExpressionGrammar
!
parserInstanceFor: aSymbol
- ^ (Smalltalk at: #PPCompiledExpressionGrammar) new startSymbol: 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.
+ 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 + 2' rule: #term.
- self assert: result size = 3.
- self assert: result first = 1.
- self assert: result second inputValue = '+'.
- self assert: result third = 2.
-
+ result := self parse: '1' rule: #term.
+ self assert: result = 1.
+
+!
+
+testTerm11
+ result := self parse: '1 + 2' rule: #term.
+ self assert: result size = 3.
+ self assert: result first = 1.
+ self assert: result second inputValue = '+'.
+ self assert: result third = 2.
+
+!
+
+testTerm12
+ result := self parse: '1 + 2 * 3' rule: #term.
+ self assert: result size = 3.
+ self assert: result second inputValue = '+'.
+ self assert: result first = 1.
+ self assert: result third isArray.
+ self assert: result third first = 2.
+ self assert: result third second inputValue = '*'.
+ self assert: result third third = 3.
+!
+
+testTerm13
+ result := self parse: '1 * 2 + 3' rule: #term.
+ self assert: result size = 3.
+ self assert: result first isArray.
+ self assert: result first first = 1.
+ self assert: result first second inputValue = '*'.
+ self assert: result first third = 2.
+ self assert: result second inputValue = '+'.
+ self assert: result third = 3.
! !
--- a/compiler/tests/PPCompiledJavaResource.st Thu Apr 30 23:43:14 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,21 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
-
-"{ NameSpace: Smalltalk }"
-
-TestResource subclass:#PPCompiledJavaResource
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Tests-Java'
-!
-
-!PPCompiledJavaResource methodsFor:'as yet unclassified'!
-
-setUp
- | time |
- time := Time millisecondsToRun: [
- PPJavaSyntax new compileAs: #PPCompiledJavaSyntax.
- ].
- Transcript crShow: 'Grammar compiled in: ', time asString, 'ms'.
-! !
-
--- a/compiler/tests/PPCompiledJavaSyntaxTest.st Thu Apr 30 23:43:14 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,573 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPJavaLexiconTest subclass:#PPCompiledJavaSyntaxTest
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Tests-Java'
-!
-
-!PPCompiledJavaSyntaxTest class methodsFor:'as yet unclassified'!
-
-resources
- ^ (OrderedCollection with: PPCompiledJavaResource)
- addAll: super resources;
- yourself
-! !
-
-!PPCompiledJavaSyntaxTest methodsFor:'accessing'!
-
-context
- ^ PPCContext new
-!
-
-parserClass
- ^ Smalltalk at: #PPCompiledJavaSyntax
-!
-
-parserInstanceFor: aSymbol
- ^ (Smalltalk at: #PPCompiledJavaSyntax) new startSymbol: aSymbol
-! !
-
-!PPCompiledJavaSyntaxTest methodsFor:'testing'!
-
-testAdditiveExpression1
-
- self parse: 'true'
- rule: #additiveExpression
-!
-
-testAdditiveExpression2
-
- self parse: '3 + 5'
- rule: #additiveExpression
-!
-
-testAdditiveExpression3
-
- self parse: '4 + 8 - 2 + 9'
- rule: #additiveExpression
-!
-
-testAndExpression1
-
- self parse: 'true'
- rule: #andExpression
-!
-
-testBlock1
-
- self parse: '{ }'
- rule: #block
-!
-
-testBlock2
-
- self
- parse:
- '{
- System.out.println("Hello World!!");
- System.out.println("Hello World!!");
- }'
- rule: #block
-!
-
-testCompilationUnit1
-
- self parse: 'package foo;
- public class CU1 {}'
- rule: #compilationUnit
-!
-
-testCompilationUnit2
-
- self parse: 'package foo;
- import foo.Bar;
- public class CU2 {
- }'
- rule: #compilationUnit
-!
-
-testCompilationUnit3
-
- self parse: 'class myfirstjavaprog
-{
- public static void main(String args[])
- {
- System.out.println("Hello World!!");
- }
-}'
- rule: #compilationUnit
-!
-
-testCompilationUnit4
-
- self parse: '
- public class OddEven {
- private int input;
- public static void main(String[] args) {
- OddEven number = new OddEven();
- number.showDialog(); }
- public void showDialog() {
-
- try {
-
- input = Integer.parseInt(JOptionPane.showInputDialog("Please Enter A Number"));
- calculate();
- } catch (NumberFormatException e) {
-
- System.err.println("ERROR: Invalid input. Please type in a numerical value.");
- }
- }
-
-private void calculate() {
- if (input % 2 == 0) {
- System.out.println("Even");
- } else {
- System.out.println("Odd");
- }
- }
- }'
- rule: #compilationUnit
-!
-
-testCompilationUnit5
-
- self parse: 'class myfirstjavaprog
-{
-
- public myfirstjavaprog() {
-
- }
-
- public static void main(String args[])
- {
- System.out.println("Hello World!!");
- }
-}'
- rule: #compilationUnit
-!
-
-testConditionalAndExpression1
-
- self parse: 'true'
- rule: #conditionalAndExpression
-!
-
-testConditionalOrExpression1
-
- self parse: 'true'
- rule: #conditionalOrExpression
-!
-
-testEqualityExpression1
-
- self
- parse: 'true'
- rule: #equalityExpression
-!
-
-testExclusiveOrExpression1
-
- self parse: 'true'
- rule: #exclusiveOrExpression
-!
-
-testExpression1
-
- self parse: '1 + 2'
- rule: #expression
-!
-
-testExpression2
-
- self parse: 'true'
- rule: #expression
-!
-
-testExpression3
-
- self parse: 'a.method()'
- rule: #expression
-!
-
-testExpression4
-
- self parse: 'a'
- rule: #expression
-!
-
-testExpression5
-
- self parse: 'a += 5'
- rule: #expression
-!
-
-testFormalParameters1
-
- self
- parse: '
- (String s, Object parameterType)'
- rule: #formalParameters
-!
-
-testFormalParameters2
-
- self
- parse: '
- (Object ... parameterType)'
- rule: #formalParameters
-!
-
-testFormalParameters3
-
- self
- parse: '(String name, Class<?>... parameterTypes)'
- rule: #formalParameters
-!
-
-testFormalParameters4
-
- self
- parse: '(int one, int two, int three, int four)'
- rule: #formalParameters
-!
-
-testFormalParameters5
-
- self
- parse: '()'
- rule: #formalParameters
-!
-
-testIdentifier
-
- self parse: 'method'
- rule: #identifier
-!
-
-testIfStatement1
-
- self parse: 'if (true) {}'
- rule: #ifStatement
-!
-
-testIfStatement2
-
- self parse: 'if (true) {} else {}'
- rule: #ifStatement
-!
-
-testIfStatement3
-
- self parse: '
- if (true)
- {int a = 0; a = 1;}
- else
- {return false;}'
- rule: #ifStatement
-!
-
-testIfStatement4
-
- self parse: 'if (true) a = 0;'
- rule: #ifStatement
-!
-
-testIfStatement5
-
- self parse: 'if (a < 4) {}'
- rule: #ifStatement
-!
-
-testImportDeclaration1
-
- self parse: 'import foo.Top;'
- rule: #importDeclaration
-!
-
-testImportDeclaration2
-
- self parse: 'import foo.Top2.*;'
- rule: #importDeclaration
-!
-
-testInclusiveOrExpression1
-
- self parse: 'true'
- rule: #inclusiveOrExpression
-!
-
-testInstanceofExpression1
-
- self
- parse: 'true'
- rule: #instanceofExpression
-!
-
-testJavaToken
-
- self parse: 'false' rule: #literal.
- self assert: (result isKindOf: PPJavaToken).
- self assert: (result inputValue = 'false').
-!
-
-testLocalVariableDeclaration1
-
- self parse: 'Type name'
- rule: #localVariableDeclaration
-!
-
-testLocalVariableDeclaration2
-
- self parse: 'Type name = value, name2'
- rule: #localVariableDeclaration
-!
-
-testLocalVariableDeclarationStatement1
-
- self parse: 'int i = 5;'
- rule: #localVariableDeclarationStatement
-!
-
-testLocalVariableDeclarationStatement2
-
- self parse: 'int i, j = 6;'
- rule: #localVariableDeclarationStatement
-!
-
-testLocalVariableDeclarationStatement3
-
- self parse: 'Srting str, in, g;'
- rule: #localVariableDeclarationStatement
-!
-
-testMethodDeclaration3
-
- self
- parse: '
- public void getMethod(String s, Object ... parameterType)
- {
- }'
- rule: #methodDeclaration
-!
-
-testMethodDeclaration4
-
- self
- parse: '
- public void getMethod(String s, int o)
- {
- }'
- rule: #methodDeclaration
-!
-
-testMultiplicativeExpression1
-
- self parse: 'true'
- rule: #multiplicativeExpression
-!
-
-testMultiplicativeExpression2
-
- self parse: '3 * 5'
- rule: #multiplicativeExpression
-!
-
-testMultiplicativeExpression3
-
- self parse: '4 * 8 / 2 * 9'
- rule: #multiplicativeExpression
-!
-
-testNormalParameterDecl1
-
- self parse: 'final int integers[]'
- rule: #normalParameterDecl
-!
-
-testNormalParameterDecl2
-
- self parse: 'String str'
- rule: #normalParameterDecl
-!
-
-testPackageDeclaration
- self
- parse: 'package java.util;'
- rule: #packageDeclaration
-!
-
-testPackageDeclaration1
-
- self parse: 'package foo;'
- rule: #packageDeclaration
-!
-
-testPackageDeclaration2
-
- self parse: 'package foo.Bar;'
- rule: #packageDeclaration
-!
-
-testPackageDeclaration3
-
- self fail: 'package ;'
- rule: #packageDeclaration
-!
-
-testPrimary1
-
- self
- parse: 'true'
- rule: #primary
-!
-
-testPrimary2
-
- self
- parse: '"Java string"'
- rule: #primary
-!
-
-testPrimaryWithselectors1
-
- self
- parse: 'true'
- rule: #primaryWithselectors
-!
-
-testQualifiedName1
-
- self parse: 'a.a'
- rule: #qualifiedName
-!
-
-testRelationalExpression1
-
- self parse: 'true'
- rule: #relationalExpression
-!
-
-testRelationalExpression2
-
- self parse: '3 > 5'
- rule: #relationalExpression
-!
-
-testReturnStatement1
-
- self parse: 'return true;'
- rule: #returnStatement
-!
-
-testReturnStatement2
-
- self parse: 'return;'
- rule: #returnStatement
-!
-
-testShiftExpression1
-
- self parse: 'true'
- rule: #shiftExpression
-!
-
-testStatement1
-
- self parse: 'System.out.println("Hello World!!");'
- rule: #statement
-!
-
-testStatement2
-
- self parse: 'return true;'
- rule: #statement
-!
-
-testStatement3
-
- self parse: '{}'
- rule: #statement
-!
-
-testUnaryExpression1
-
- self parse: 'a'
- rule: #unaryExpression
-!
-
-testUnaryExpression2
-
- self parse: 'true'
- rule: #unaryExpression
-!
-
-testUnaryExpressionNotPlusMinus1
-
- self
- parse: 'true'
- rule: #unaryExpressionNotPlusMinus
-!
-
-testVariableDeclarator1
-
- self parse: 'var'
- rule: #variableDeclarator
-!
-
-testVariableDeclarator2
-
- self parse: 'var[][]'
- rule: #variableDeclarator
-!
-
-testVariableDeclarator3
-
- self parse: 'var = a.methd()'
- rule: #variableDeclarator
-!
-
-testWhileStatement1
-
- self parse: 'while (true) object.executeMethod();'
- rule: #whileStatement
-!
-
-testWhileStatement2
-
- self parse: 'while (3>2) {block; of; statements;}'
- rule: #whileStatement
-! !
-
-!PPCompiledJavaSyntaxTest methodsFor:'testing-classes'!
-
-testClassDeclaration1
-
- self parse: '//comment
- class myfirstjavaprog
-{
- public static void main(String args[])
- {
- System.out.println("Hello World!!");
- }
-}'
- rule: #classDeclaration
-!
-
-testMethodDeclaration1
-
- self
- parse: 'public void aMethod() { }'
- rule: #methodDeclaration
-!
-
-testMethodDeclaration2
-
- self
- parse: 'public aMethod() { }'
- rule: #methodDeclaration
-! !
-
--- a/compiler/tests/PPCompiledSmalltalkGrammarResource.st Thu Apr 30 23:43:14 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,22 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
-
-"{ NameSpace: Smalltalk }"
-
-TestResource subclass:#PPCompiledSmalltalkGrammarResource
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Tests-Smalltalk'
-!
-
-!PPCompiledSmalltalkGrammarResource methodsFor:'as yet unclassified'!
-
-setUp
- | time |
- time := Time millisecondsToRun: [
- PPSmalltalkGrammar new compileAs: #PPCompiledSmalltalkGrammar
- ].
- Transcript crShow: 'Smalltalk Grammar compiled in: ', time asString, 'ms'.
-
-! !
-
--- a/compiler/tests/PPCompiledSmalltalkGrammarTests.st Thu Apr 30 23:43:14 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,926 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCompositeParserTest subclass:#PPCompiledSmalltalkGrammarTests
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Tests-Smalltalk'
-!
-
-!PPCompiledSmalltalkGrammarTests class methodsFor:'accessing'!
-
-packageNamesUnderTest
- ^ #('PetitSmalltalk')
-!
-
-resources
- ^ (OrderedCollection with: PPCompiledSmalltalkGrammarResource)
- addAll: super resources;
- yourself
-! !
-
-!PPCompiledSmalltalkGrammarTests methodsFor:'accessing'!
-
-context
- ^ PPCContext new
-!
-
-parserClass
- ^ Smalltalk at: #PPCompiledSmalltalkGrammar
-!
-
-parserInstanceFor: aSymbol
- ^ (Smalltalk at: #PPCompiledSmalltalkGrammar) new startSymbol: aSymbol
-! !
-
-!PPCompiledSmalltalkGrammarTests methodsFor:'testing'!
-
-testArray1
- self
- parse: '{}'
- rule: #array
-!
-
-testArray2
- self
- parse: '{self foo}'
- rule: #array
-!
-
-testArray3
- self
- parse: '{self foo. self bar}'
- rule: #array
-!
-
-testArray4
- self
- parse: '{self foo. self bar.}'
- rule: #array
-!
-
-testAssignment1
- self
- parse: '1'
- rule: #expression
-!
-
-testAssignment2
- self
- parse: 'a := 1'
- rule: #expression
-!
-
-testAssignment3
- self
- parse: 'a := b := 1'
- rule: #expression
-!
-
-testAssignment4
- PPSmalltalkGrammar allowUnderscoreAssignment
- ifTrue: [ self parse: 'a _ 1' rule: #expression ]
- ifFalse: [ self fail: 'a _ 1' rule: #expression ]
-!
-
-testAssignment5
- PPSmalltalkGrammar allowUnderscoreAssignment
- ifTrue: [ self parse: 'a _ b _ 1' rule: #expression ]
- ifFalse: [ self fail: 'a _ b _ 1' rule: #expression ]
-!
-
-testAssignment6
- self
- parse: 'a := (b := c)'
- rule: #expression
-!
-
-testComment1
- self
- parse: '1"one"+2'
- rule: #expression
-!
-
-testComment2
- self
- parse: '1 "one" +2'
- rule: #expression
-!
-
-testComment3
- self
- parse: '1"one"+"two"2'
- rule: #expression
-!
-
-testComment4
- self
- parse: '1"one""two"+2'
- rule: #expression
-!
-
-testComment5
- self
- parse: '1"one" "two"+2'
- rule: #expression
-!
-
-testCompleteness
- "This test asserts that all subclasses override all test methods."
-
- self class allSubclasses do: [ :subclass |
- self class testSelectors do: [ :selector |
- self
- assert: (selector = #testCompleteness or: [ subclass selectors includes: selector ])
- description: subclass printString , ' does not test ' , selector printString ] ]
-!
-
-testMethod1
- self
- parse: 'negated ^ 0 - self'
- rule: #method
-!
-
-testMethod2
- "Spaces at the beginning of the method."
- self
- parse: ' negated ^ 0 - self'
- rule: #method
-!
-
-testMethod3
- "Spaces at the end of the method."
- self
- parse: ' negated ^ 0 - self '
- rule: #method
-!
-
-testSequence1
- self
- parse: '| a | 1 . 2'
- rule: #sequence
-!
-
-testStatements1
- self
- parse: '1'
- rule: #sequence
-!
-
-testStatements2
- self
- parse: '1 . 2'
- rule: #sequence
-!
-
-testStatements3
- self
- parse: '1 . 2 . 3'
- rule: #sequence
-!
-
-testStatements4
- self
- parse: '1 . 2 . 3 .'
- rule: #sequence
-!
-
-testStatements5
- self
- parse: '1 . . 2'
- rule: #sequence
-!
-
-testStatements6
- self
- parse: '1. 2'
- rule: #sequence
-!
-
-testStatements7
- self
- parse: '. 1'
- rule: #sequence
-!
-
-testStatements8
- self
- parse: '.1'
- rule: #sequence
-!
-
-testStatements9
- self
- parse: ''
- rule: #statements
-!
-
-testTemporaries1
- self
- parse: '| a |'
- rule: #sequence
-!
-
-testTemporaries2
- self
- parse: '| a b |'
- rule: #sequence
-!
-
-testTemporaries3
- self
- parse: '| a b c |'
- rule: #sequence
-!
-
-testVariable1
- self
- parse: 'trueBinding'
- rule: #primary
-!
-
-testVariable2
- self
- parse: 'falseBinding'
- rule: #primary
-!
-
-testVariable3
- self
- parse: 'nilly'
- rule: #primary
-!
-
-testVariable4
- self
- parse: 'selfish'
- rule: #primary
-!
-
-testVariable5
- self
- parse: 'supernanny'
- rule: #primary
-!
-
-testVariable6
- PPSmalltalkGrammar allowUnderscoreAssignment ifFalse: [
- self
- parse: 'super_nanny'
- rule: #primary ]
-!
-
-testVariable7
- PPSmalltalkGrammar allowUnderscoreAssignment ifFalse: [
- self
- parse: '__gen_var_123__'
- rule: #primary ]
-! !
-
-!PPCompiledSmalltalkGrammarTests methodsFor:'testing-blocks'!
-
-testArgumentsBlock1
- self
- parse: '[ :a | ]'
- rule: #block
-!
-
-testArgumentsBlock2
- self
- parse: '[ :a :b | ]'
- rule: #block
-!
-
-testArgumentsBlock3
- self
- parse: '[ :a :b :c | ]'
- rule: #block
-!
-
-testBlock1
- self
- parse: '[]'
- rule: #block
-!
-
-testComplexBlock1
- self
- parse: '[ :a | | b | c ]'
- rule: #block
-!
-
-testComplexBlock2
- self
- parse: '[:a||b|c]'
- rule: #block
-!
-
-testSimpleBlock1
- self
- parse: '[ ]'
- rule: #block
-!
-
-testSimpleBlock2
- self
- parse: '[ nil ]'
- rule: #block
-!
-
-testSimpleBlock3
- self
- parse: '[ :a ]'
- rule: #block
-!
-
-testStatementBlock1
- self
- parse: '[ nil ]'
- rule: #block
-!
-
-testStatementBlock2
- self
- parse: '[ | a | nil ]'
- rule: #block
-!
-
-testStatementBlock3
- self
- parse: '[ | a b | nil ]'
- rule: #block
-! !
-
-!PPCompiledSmalltalkGrammarTests methodsFor:'testing-literals'!
-
-testArrayLiteral1
- self
- parse: '#()'
- rule: #arrayLiteral
-!
-
-testArrayLiteral10
- self
- parse: '#((1 2) #(1 2 3))'
- rule: #arrayLiteral
-!
-
-testArrayLiteral11
- self
- parse: '#([1 2] #[1 2 3])'
- rule: #arrayLiteral
-!
-
-testArrayLiteral2
- self
- parse: '#(1)'
- rule: #arrayLiteral
-!
-
-testArrayLiteral3
- self
- parse: '#(1 2)'
- rule: #arrayLiteral
-!
-
-testArrayLiteral4
- self
- parse: '#(true false nil)'
- rule: #arrayLiteral
-!
-
-testArrayLiteral5
- self
- parse: '#($a)'
- rule: #arrayLiteral
-!
-
-testArrayLiteral6
- self
- parse: '#(1.2)'
- rule: #arrayLiteral
-!
-
-testArrayLiteral7
- self
- parse: '#(size #at: at:put: #''=='')'
- rule: #arrayLiteral
-!
-
-testArrayLiteral8
- self
- parse: '#(''baz'')'
- rule: #arrayLiteral
-!
-
-testArrayLiteral9
- self
- parse: '#((1) 2)'
- rule: #arrayLiteral
-!
-
-testByteLiteral1
- self
- parse: '#[]'
- rule: #byteLiteral
-!
-
-testByteLiteral2
- self
- parse: '#[0]'
- rule: #byteLiteral
-!
-
-testByteLiteral3
- self
- parse: '#[255]'
- rule: #byteLiteral
-!
-
-testByteLiteral4
- self
- parse: '#[ 1 2 ]'
- rule: #byteLiteral
-!
-
-testByteLiteral5
- self
- parse: '#[ 2r1010 8r77 16rFF ]'
- rule: #byteLiteral
-!
-
-testCharLiteral1
- self
- parse: '$a'
- rule: #charLiteral
-!
-
-testCharLiteral2
- self
- parse: '$ '
- rule: #charLiteral
-!
-
-testCharLiteral3
- self
- parse: '$$'
- rule: #charLiteral
-!
-
-testNumberLiteral1
- self
- parse: '0'
- rule: #numberLiteral
-!
-
-testNumberLiteral10
- self
- parse: '10r10'
- rule: #numberLiteral
-!
-
-testNumberLiteral11
- self
- parse: '8r777'
- rule: #numberLiteral
-!
-
-testNumberLiteral12
- self
- parse: '16rAF'
- rule: #numberLiteral
-!
-
-testNumberLiteral13
- self
- parse: '16rCA.FE'
- rule: #numberLiteral
-!
-
-testNumberLiteral14
- self
- parse: '3r-22.2'
- rule: #numberLiteral
-!
-
-testNumberLiteral15
- self
- parse: '0.50s2'
- rule: #numberLiteral
-!
-
-testNumberLiteral2
- self
- parse: '0.1'
- rule: #numberLiteral
-!
-
-testNumberLiteral3
- self
- parse: '123'
- rule: #numberLiteral
-!
-
-testNumberLiteral4
- self
- parse: '123.456'
- rule: #numberLiteral
-!
-
-testNumberLiteral5
- self
- parse: '-0'
- rule: #numberLiteral
-!
-
-testNumberLiteral6
- self
- parse: '-0.1'
- rule: #numberLiteral
-!
-
-testNumberLiteral7
- self
- parse: '-123'
- rule: #numberLiteral
-!
-
-testNumberLiteral8
- self
- parse: '-125'
- rule: #numberLiteral
-!
-
-testNumberLiteral9
- self
- parse: '-123.456'
- rule: #numberLiteral
-!
-
-testSpecialLiteral1
- self
- parse: 'true'
- rule: #trueLiteral
-!
-
-testSpecialLiteral2
- self
- parse: 'false'
- rule: #falseLiteral
-!
-
-testSpecialLiteral3
- self
- parse: 'nil'
- rule: #nilLiteral
-!
-
-testStringLiteral1
- self
- parse: ''''''
- rule: #stringLiteral
-!
-
-testStringLiteral2
- self
- parse: '''ab'''
- rule: #stringLiteral
-!
-
-testStringLiteral3
- self
- parse: '''ab''''cd'''
- rule: #stringLiteral
-!
-
-testSymbolLiteral1
- self
- parse: '#foo'
- rule: #symbolLiteral
-!
-
-testSymbolLiteral2
- self
- parse: '#+'
- rule: #symbolLiteral
-!
-
-testSymbolLiteral3
- self
- parse: '#key:'
- rule: #symbolLiteral
-!
-
-testSymbolLiteral4
- self
- parse: '#key:value:'
- rule: #symbolLiteral
-!
-
-testSymbolLiteral5
- self
- parse: '#''testing-result'''
- rule: #symbolLiteral
-!
-
-testSymbolLiteral6
- PPSmalltalkGrammar allowUnderscoreAssignment ifFalse: [
- self
- parse: '#__gen__binding'
- rule: #symbolLiteral ]
-!
-
-testSymbolLiteral7
- self
- parse: '# fucker'
- rule: #symbolLiteral
-!
-
-testSymbolLiteral8
- self
- parse: '##fucker'
- rule: #symbolLiteral
-!
-
-testSymbolLiteral9
- self
- parse: '## fucker'
- rule: #symbolLiteral
-! !
-
-!PPCompiledSmalltalkGrammarTests methodsFor:'testing-messages'!
-
-testBinaryExpression1
- self
- parse: '1 + 2'
- rule: #expression
-!
-
-testBinaryExpression2
- self
- parse: '1 + 2 + 3'
- rule: #expression
-!
-
-testBinaryExpression3
- self
- parse: '1 // 2'
- rule: #expression
-!
-
-testBinaryExpression4
- self
- parse: '1 -- 2'
- rule: #expression
-!
-
-testBinaryExpression5
- self
- parse: '1 ==> 2'
- rule: #expression.
-!
-
-testBinaryMethod1
- self
- parse: '+ a'
- rule: #method
-!
-
-testBinaryMethod2
- self
- parse: '+ a | b |'
- rule: #method
-!
-
-testBinaryMethod3
- self
- parse: '+ a b'
- rule: #method
-!
-
-testBinaryMethod4
- self
- parse: '+ a | b | c'
- rule: #method
-!
-
-testBinaryMethod5
- self
- parse: '-- a'
- rule: #method
-!
-
-testCascadeExpression1
- self
- parse: '1 abs; negated'
- rule: #expression
-!
-
-testCascadeExpression2
- self
- parse: '1 abs negated; raisedTo: 12; negated'
- rule: #expression
-!
-
-testCascadeExpression3
- self
- parse: '1 + 2; - 3'
- rule: #expression
-!
-
-testIdentifierToken
- self
- parse: 'foo'
- rule: #identifierToken
-!
-
-testIdentifierToken2
- self
- parse: ' foo'
- rule: #identifierToken
-!
-
-testKeywordExpression1
- self
- parse: '1 to: 2'
- rule: #expression
-!
-
-testKeywordExpression2
- self
- parse: '1 to: 2 by: 3'
- rule: #expression
-!
-
-testKeywordExpression3
- self
- parse: '1 to: 2 by: 3 do: 4'
- rule: #expression
-!
-
-testKeywordMethod1
- self
- parse: 'to: a'
- rule: #method
-!
-
-testKeywordMethod2
- self
- parse: 'to: a do: b | c |'
- rule: #method
-!
-
-testKeywordMethod3
- self
- parse: 'to: a do: b by: c d'
- rule: #method
-!
-
-testKeywordMethod4
- self
- parse: 'to: a do: b by: c | d | e'
- rule: #method
-!
-
-testUnaryExpression1
- self
- parse: '1 abs'
- rule: #expression
-!
-
-testUnaryExpression2
- self
- parse: '1 abs negated'
- rule: #expression
-!
-
-testUnaryMethod1
- self
- parse: 'abs'
- rule: #method
-!
-
-testUnaryMethod2
- self
- parse: 'abs | a |'
- rule: #method
-!
-
-testUnaryMethod3
- self
- parse: 'abs a'
- rule: #method
-!
-
-testUnaryMethod4
- self
- parse: 'abs | a | b'
- rule: #method
-!
-
-testUnaryMethod5
- self
- parse: 'abs | a |'
- rule: #method
-! !
-
-!PPCompiledSmalltalkGrammarTests methodsFor:'testing-pragmas'!
-
-testPragma1
- self
- parse: 'method <foo>'
- rule: #method
-!
-
-testPragma10
- self
- parse: 'method <foo: bar>'
- rule: #method
-!
-
-testPragma11
- self
- parse: 'method <foo: true>'
- rule: #method
-!
-
-testPragma12
- self
- parse: 'method <foo: false>'
- rule: #method
-!
-
-testPragma13
- self
- parse: 'method <foo: nil>'
- rule: #method
-!
-
-testPragma14
- self
- parse: 'method <foo: ()>'
- rule: #method
-!
-
-testPragma15
- self
- parse: 'method <foo: #()>'
- rule: #method
-!
-
-testPragma16
- self
- parse: 'method < + 1 >'
- rule: #method
-!
-
-testPragma2
- self
- parse: 'method <foo> <bar>'
- rule: #method
-!
-
-testPragma3
- self
- parse: 'method | a | <foo>'
- rule: #method
-!
-
-testPragma4
- self
- parse: 'method <foo> | a |'
- rule: #method
-!
-
-testPragma5
- self
- parse: 'method <foo> | a | <bar>'
- rule: #method
-!
-
-testPragma6
- self
- parse: 'method <foo: 1>'
- rule: #method
-!
-
-testPragma7
- self
- parse: 'method <foo: 1.2>'
- rule: #method
-!
-
-testPragma8
- self
- parse: 'method <foo: ''bar''>'
- rule: #method
-!
-
-testPragma9
- self
- parse: 'method <foo: #''bar''>'
- rule: #method
-! !
-
--- a/compiler/tests/PPExpressionGrammar.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPExpressionGrammar.st Sun May 10 06:28:36 2015 +0100
@@ -24,7 +24,7 @@
!
parens
- ^ $( asParser trim, term , $) asParser trim
+ ^ ($( asParser token trim), term , ($) asParser token trim)
!
prim
--- a/compiler/tests/PPExpressionGrammarTest.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/PPExpressionGrammarTest.st Sun May 10 06:28:36 2015 +0100
@@ -12,36 +12,89 @@
!PPExpressionGrammarTest methodsFor:'as yet unclassified'!
parserClass
- ^ PPExpressionGrammar
+ ^ PPExpressionGrammar
+!
+
+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.
+ 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 + 2' rule: #term.
- self assert: result size = 3.
- self assert: result first = 1.
- self assert: result second inputValue = '+'.
- self assert: result third = 2.
-
+ 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.
+
!
-testTerm2
- 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.
+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.
!
-testTerm3
- result := self parse: '1 * 2 + 3' rule: #term.
- self assert: result size = 3.
- self assert: result second inputValue = '+'.
- self assert: result first isArray.
- self assert: result third = 3.
+testTerm13
+ result := self parse: '1 * 2 + 3' rule: #term.
+ self assert: result size = 3.
+ self assert: result first isArray.
+ self assert: result first first = 1.
+ self assert: result first second inputValue = '*'.
+ self assert: result first third = 2.
+ self assert: result second inputValue = '+'.
+ self assert: result third = 3.
! !
--- a/compiler/tests/abbrev.stc Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/abbrev.stc Sun May 10 06:28:36 2015 +0100
@@ -8,24 +8,24 @@
PPCCopyVisitorTest PPCCopyVisitorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
PPCGuardTest PPCGuardTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 1
PPCInliningVisitorTest PPCInliningVisitorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
+PPCLL1OptimizingTest PPCLL1OptimizingTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 1
+PPCLL1Test PPCLL1Test stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 1
+PPCLL1VisitorTest PPCLL1VisitorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
PPCMergingVisitorTest PPCMergingVisitorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
PPCMockCompiler PPCMockCompiler stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 0
-PPCNodeCompilingTest PPCNodeCompilingTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Nodes' 1
PPCNodeFirstFollowNextTests PPCNodeFirstFollowNextTests stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Nodes' 1
PPCNodeTest PPCNodeTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Nodes' 1
-PPCOptimizingTest PPCOptimizingTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Nodes' 1
-PPCOptimizingVisitorTest PPCOptimizingVisitorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
-PPCProtype1Test PPCProtype1Test stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 1
+PPCOptimizeChoicesTest PPCOptimizeChoicesTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
+PPCPrototype1OptimizingTest PPCPrototype1OptimizingTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 1
+PPCPrototype1Test PPCPrototype1Test stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 1
+PPCRecognizerComponentDetectorTest PPCRecognizerComponentDetectorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
+PPCRecognizerComponentVisitorTest PPCRecognizerComponentVisitorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
+PPCSpecializingVisitorTest PPCSpecializingVisitorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
PPCTokenDetectorTest PPCTokenDetectorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
-PPCTokenVisitorTest PPCTokenVisitorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
PPCTokenizingCodeGeneratorTest PPCTokenizingCodeGeneratorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
-PPCVerificationTest PPCVerificationTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 1
+PPCTokenizingVisitorTest PPCTokenizingVisitorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
PPCompiledExpressionGrammarResource PPCompiledExpressionGrammarResource stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-ExpressionGrammar' 1
PPCompiledExpressionGrammarTest PPCompiledExpressionGrammarTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-ExpressionGrammar' 1
-PPCompiledJavaResource PPCompiledJavaResource stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Java' 1
-PPCompiledJavaSyntaxTest PPCompiledJavaSyntaxTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Java' 1
-PPCompiledSmalltalkGrammarResource PPCompiledSmalltalkGrammarResource stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Smalltalk' 1
-PPCompiledSmalltalkGrammarTests PPCompiledSmalltalkGrammarTests stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Smalltalk' 1
PPExpressionGrammar PPExpressionGrammar stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-ExpressionGrammar' 0
PPExpressionGrammarTest PPExpressionGrammarTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-ExpressionGrammar' 1
stx_goodies_petitparser_compiler_tests stx_goodies_petitparser_compiler_tests stx:goodies/petitparser/compiler/tests '* Projects & Packages *' 3
--- a/compiler/tests/bc.mak Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/bc.mak Sun May 10 06:28:36 2015 +0100
@@ -35,7 +35,7 @@
-LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\compiler -I$(INCLUDE_TOP)\stx\goodies\petitparser\compiler\benchmarks -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
+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\tests -I$(INCLUDE_TOP)\stx\goodies\sunit -I$(INCLUDE_TOP)\stx\libbasic
LOCALDEFINES=
STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
@@ -59,7 +59,6 @@
pushd ..\..\..\..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
pushd ..\..\..\sunit & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
pushd ..\..\tests & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\parsers\java & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
@@ -83,21 +82,24 @@
$(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)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)PPCLL1OptimizingTest.$(O) PPCLL1OptimizingTest.$(H): PPCLL1OptimizingTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCLL1Test.$(O) PPCLL1Test.$(H): PPCLL1Test.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)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)PPCMergingVisitorTest.$(O) PPCMergingVisitorTest.$(H): PPCMergingVisitorTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCMockCompiler.$(O) PPCMockCompiler.$(H): PPCMockCompiler.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(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)PPCOptimizingTest.$(O) PPCOptimizingTest.$(H): PPCOptimizingTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCOptimizingVisitorTest.$(O) PPCOptimizingVisitorTest.$(H): PPCOptimizingVisitorTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCProtype1Test.$(O) PPCProtype1Test.$(H): PPCProtype1Test.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)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)PPCPrototype1OptimizingTest.$(O) PPCPrototype1OptimizingTest.$(H): PPCPrototype1OptimizingTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCPrototype1Test.$(O) PPCPrototype1Test.$(H): PPCPrototype1Test.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)PPCSpecializingVisitorTest.$(O) PPCSpecializingVisitorTest.$(H): PPCSpecializingVisitorTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenDetectorTest.$(O) PPCTokenDetectorTest.$(H): PPCTokenDetectorTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCTokenVisitorTest.$(O) PPCTokenVisitorTest.$(H): PPCTokenVisitorTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenizingCodeGeneratorTest.$(O) PPCTokenizingCodeGeneratorTest.$(H): PPCTokenizingCodeGeneratorTest.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)PPCVerificationTest.$(O) PPCVerificationTest.$(H): PPCVerificationTest.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)PPCTokenizingVisitorTest.$(O) PPCTokenizingVisitorTest.$(H): PPCTokenizingVisitorTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCompiledExpressionGrammarResource.$(O) PPCompiledExpressionGrammarResource.$(H): PPCompiledExpressionGrammarResource.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestResource.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCompiledExpressionGrammarTest.$(O) PPCompiledExpressionGrammarTest.$(H): PPCompiledExpressionGrammarTest.st $(INCLUDE_TOP)\stx\goodies\petitparser\tests\PPAbstractParserTest.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\tests\PPCompositeParserTest.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCompiledJavaResource.$(O) PPCompiledJavaResource.$(H): PPCompiledJavaResource.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestResource.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCompiledSmalltalkGrammarResource.$(O) PPCompiledSmalltalkGrammarResource.$(H): PPCompiledSmalltalkGrammarResource.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestResource.$(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)PPExpressionGrammarTest.$(O) PPExpressionGrammarTest.$(H): PPExpressionGrammarTest.st $(INCLUDE_TOP)\stx\goodies\petitparser\tests\PPAbstractParserTest.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\tests\PPCompositeParserTest.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)stx_goodies_petitparser_compiler_tests.$(O) stx_goodies_petitparser_compiler_tests.$(H): stx_goodies_petitparser_compiler_tests.st $(INCLUDE_TOP)\stx\libbasic\LibraryDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProjectDefinition.$(H) $(STCHDR)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/Make.proto Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,135 @@
+# $Header$
+#
+# DO NOT EDIT
+# automagically generated from the projectDefinition: stx_goodies_petitparser_compiler_tests_extras.
+#
+# Warning: once you modify this file, do not rerun
+# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
+#
+# The Makefile as generated by this Make.proto supports the following targets:
+# make - compile all st-files to a classLib
+# make clean - clean all temp files
+# make clobber - clean all
+#
+# This file contains definitions for Unix based platforms.
+# It shares common definitions with the win32-make in Make.spec.
+
+#
+# position (of this package) in directory hierarchy:
+# (must point to ST/X top directory, for tools and includes)
+TOP=../../../../..
+INCLUDE_TOP=$(TOP)/..
+
+# subdirectories where targets are to be made:
+SUBDIRS=
+
+
+# subdirectories where Makefiles are to be made:
+# (only define if different from SUBDIRS)
+# ALLSUBDIRS=
+
+REQUIRED_SUPPORT_DIRS=
+
+# if your embedded C code requires any system includes,
+# 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
+
+
+# if you need any additional defines for embedded C code,
+# add them here:,
+# ********** OPTIONAL: MODIFY the next lines ***
+# LOCALDEFINES=-Dfoo -Dbar -DDEBUG
+LOCALDEFINES=
+
+LIBNAME=libstx_goodies_petitparser_compiler_tests_extras
+STCLOCALOPT='-package=$(PACKAGE)' -I. $(LOCALINCLUDES) $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -headerDir=. -varPrefix=$(LIBNAME)
+
+
+# ********** OPTIONAL: MODIFY the next line ***
+# additional C-libraries that should be pre-linked with the class-objects
+LD_OBJ_LIBS=
+LOCAL_SHARED_LIBS=
+
+
+# ********** OPTIONAL: MODIFY the next line ***
+# additional C targets or libraries should be added below
+LOCAL_EXTRA_TARGETS=
+
+OBJS= $(COMMON_OBJS) $(UNIX_OBJS)
+
+
+
+all:: preMake classLibRule postMake
+
+pre_objs::
+
+
+
+
+
+
+# Enforce recompilation of package definition class if Mercurial working
+# copy state changes. Together with --guessVersion it ensures that package
+# definition class always contains correct binary revision string.
+ifneq (**NOHG**, $(shell hg root 2> /dev/null || echo -n '**NOHG**'))
+stx_goodies_petitparser_compiler_tests_extras.$(O): $(shell hg root)/.hg/dirstate
+endif
+
+
+
+
+# run default testsuite for this package
+test: $(TOP)/goodies/builder/reports
+ $(MAKE) -C $(TOP)/goodies/builder/reports -f Makefile.init
+ $(TOP)/goodies/builder/reports/report-runner.sh -D . -r Builder::TestReport -p $(PACKAGE)
+
+
+
+# add more install actions here
+install::
+
+# add more install actions for aux-files (resources) here
+installAux::
+
+# add more preMake actions here
+preMake::
+
+# add more postMake actions here
+postMake:: cleanjunk
+
+# build all mandatory prerequisite packages (containing superclasses) for this package
+prereq:
+ cd ../../../../../libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../../../../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../../../../libbasic3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../../../../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../../ && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../../../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../../../sunit && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../../tests && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../../parsers/java && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+
+
+
+# build all packages containing referenced classes for this package
+# they are not needed to compile the package (but later, to load it)
+references:
+
+
+cleanjunk::
+ -rm -f *.s *.s2
+
+clean::
+ -rm -f *.o *.H
+
+clobber:: clean
+ -rm -f *.so *.dll
+
+
+# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(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)
+
+# ENDMAKEDEPEND --- do not remove this line
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/Make.spec Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,63 @@
+# $Header$
+#
+# DO NOT EDIT
+# automagically generated from the projectDefinition: stx_goodies_petitparser_compiler_tests_extras.
+#
+# Warning: once you modify this file, do not rerun
+# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
+#
+# This file contains specifications which are common to all platforms.
+#
+
+# Do NOT CHANGE THESE DEFINITIONS
+# (otherwise, ST/X will have a hard time to find out the packages location from its packageID,
+# to find the source code of a class and to find the library for a package)
+MODULE=stx
+MODULE_DIR=goodies/petitparser/compiler/tests/extras
+PACKAGE=$(MODULE):$(MODULE_DIR)
+
+
+# Argument(s) to the stc compiler (stc --usage).
+# -headerDir=. : create header files locally
+# (if removed, they will be created as common
+# -Pxxx : defines the package
+# -Zxxx : a prefix for variables within the classLib
+# -Dxxx : defines passed to to CC for inline C-code
+# -Ixxx : include path passed to CC for inline C-code
+# +optspace : optimized for space
+# +optspace2 : optimized more for space
+# +optspace3 : optimized even more for space
+# +optinline : generate inline code for some ST constructs
+# +inlineNew : additionally inline new
+# +inlineMath : additionally inline some floatPnt math stuff
+#
+# ********** OPTIONAL: MODIFY the next line(s) ***
+# STCLOCALOPTIMIZATIONS=+optinline +inlineNew
+# STCLOCALOPTIMIZATIONS=+optspace3
+STCLOCALOPTIMIZATIONS=+optspace3
+
+
+# Argument(s) to the stc compiler (stc --usage).
+# -warn : no warnings
+# -warnNonStandard : no warnings about ST/X extensions
+# -warnEOLComments : no warnings about EOL comment extension
+# -warnPrivacy : no warnings about privateClass extension
+# -warnUnused : no warnings about unused variables
+#
+# ********** OPTIONAL: MODIFY the next line(s) ***
+# STCWARNINGS=-warn
+# STCWARNINGS=-warnNonStandard
+# STCWARNINGS=-warnEOLComments
+STCWARNINGS=-warnNonStandard
+
+COMMON_CLASSES= \
+ stx_goodies_petitparser_compiler_tests_extras \
+
+
+
+
+COMMON_OBJS= \
+ $(OUTDIR_SLASH)stx_goodies_petitparser_compiler_tests_extras.$(O) \
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/Makefile.init Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,27 @@
+#
+# DO NOT EDIT
+#
+# make uses this file (Makefile) only, if there is no
+# file named "makefile" (lower-case m) in the same directory.
+# My only task is to generate the real makefile and call make again.
+# Thereafter, I am no longer used and needed.
+#
+# MACOSX caveat:
+# as filenames are not case sensitive (in a default setup),
+# we cannot use the above trick. Therefore, this file is now named
+# "Makefile.init", and you have to execute "make -f Makefile.init" to
+# get the initial makefile. This is now also done by the toplevel CONFIG
+# script.
+
+.PHONY: run
+
+run: makefile
+ $(MAKE) -f makefile
+
+#only needed for the definition of $(TOP)
+include Make.proto
+
+makefile: mf
+
+mf:
+ $(TOP)/rules/stmkmf
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCCompiledJavaVerificationTest.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,87 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPAbstractParserTest subclass:#PPCCompiledJavaVerificationTest
+ instanceVariableNames:'parser result context resource fileResources'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Java'
+!
+
+PPCCompiledJavaVerificationTest comment:''
+!
+
+!PPCCompiledJavaVerificationTest class methodsFor:'as yet unclassified'!
+
+resources
+ ^ (OrderedCollection with: PPCompiledJavaResource with: PPCResources)
+ addAll: super resources;
+ yourself
+! !
+
+!PPCCompiledJavaVerificationTest methodsFor:'accessing'!
+
+compiledJavaSyntax
+ ^ (Smalltalk at: #PPCompiledJavaSyntax) new
+!
+
+context
+ ^ context := PPCProfilingContext new
+!
+
+javaSyntax
+ ^ PPJavaSyntax new
+! !
+
+!PPCCompiledJavaVerificationTest methodsFor:'setup'!
+
+setUp
+ super setUp.
+ fileResources := (self resources detect: [:e | e = PPCResources ]) current.
+! !
+
+!PPCCompiledJavaVerificationTest methodsFor:'tests'!
+
+testJava
+ | compiledParser normalParser |
+ normalParser := self javaSyntax.
+ compiledParser := self compiledJavaSyntax.
+
+ fileResources javaSourcesBig do: [ :source |
+ result := normalParser parse: source.
+ result isPetitFailure not ifTrue: [
+ self assert: (compiledParser parse: source withContext: self context)
+ equals: result
+ ]
+ ].
+!
+
+testJavaMath
+ | compiledParser normalParser source |
+ normalParser := self javaSyntax.
+
+ source := fileResources javaLangMath.
+ result := normalParser parse: source.
+
+ result isPetitFailure not ifTrue: [
+ compiledParser := self compiledJavaSyntax.
+ self assert: (compiledParser parse: source withContext: self context)
+ equals: result
+ ]
+!
+
+testJavaTimer
+ | compiledParser normalParser source |
+ normalParser := self javaSyntax.
+
+ source := fileResources javaUtilTimer.
+ result := normalParser parse: source.
+
+ result isPetitFailure not ifTrue: [
+ compiledParser := self compiledJavaSyntax.
+ self assert: (compiledParser parse: source withContext: self context)
+ equals: result
+ ]
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCResources.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,94 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestResource subclass:#PPCResources
+ instanceVariableNames:''
+ classVariableNames:'javaCache'
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Support'
+!
+
+PPCResources comment:''
+!
+
+!PPCResources methodsFor:'java'!
+
+javaInDirectory: directory
+ | files |
+ files := self readDirectory: directory.
+ files := self files: files withExtension: 'java'.
+
+ ^ files collect: [ :f | (FileStream fileNamed: f) contents ]
+!
+
+javaLangMath
+ ^ (FileStream fileNamed: '../java-src/java/lang/Math.java') contents
+!
+
+javaSourcesBig
+ ^ self javaInDirectory: '../java-src/java/util'.
+ "^ self workingJavaInDirectory: '../java-src/java/util'"
+!
+
+javaUtilTimer
+ ^ (FileStream fileNamed: '../java-src/java/util/Timer.java') contents
+!
+
+workingJavaInDirectory: directory
+ | sources parser |
+ "return only such a files, that can be parsed by PPJavaSyntax"
+
+ javaCache ifNil: [ javaCache := Dictionary new ].
+
+ ^ javaCache at: directory ifAbsentPut: [
+ sources := self javaInDirectory: directory.
+ parser := PPJavaSyntax new.
+
+ sources select: [ :source | ([parser parse: source ] on: Error do: [ PPFailure new ]) isPetitFailure not ]
+ ]
+! !
+
+!PPCResources methodsFor:'private utilities'!
+
+files: files withExtension: extension
+ ^ files select: [ :f | f extension = extension ]
+!
+
+readDirectory: directory
+ | file |
+ file := directory asFileReference.
+ file exists ifTrue: [
+ ^ file allFiles
+ ].
+ ^ #()
+! !
+
+!PPCResources methodsFor:'smalltalk'!
+
+smalltalkClassMethods
+ ^ self smalltalkInDirectory: '../smalltalk-src/Class/'
+
+!
+
+smalltalkInDirectory: directory
+ | files |
+ files := self readDirectory: directory.
+ files := self files: files withExtension: 'st'.
+
+ ^ files collect: [ :f | (FileStream fileNamed: f) contents ]
+!
+
+smalltalkObjectMethods
+ ^ self smalltalkInDirectory: '../smalltalk-src/Object/'
+
+!
+
+smalltalkSourcesBig
+ ^ self smalltalkInDirectory: '../smalltalk-src/'
+!
+
+smalltalkSourcesSmall
+ ^ (self smalltalkInDirectory: '../smalltalk-src/') copyFrom: 1 to: 5000.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCSmalltalkTests.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,48 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCSmalltalkTests
+ instanceVariableNames:'configuration arguments'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+PPCSmalltalkTests comment:''
+!
+
+!PPCSmalltalkTests methodsFor:'as yet unclassified'!
+
+setUp
+ arguments := PPCArguments default
+ profile: true;
+ guards: false;
+ yourself.
+
+ configuration := PPCLL1Configuration new
+ arguments: arguments;
+ yourself.
+!
+
+testSmalltakToken
+ | token1 token2 |
+ arguments generate: false.
+ 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.
+!
+
+testSmalltakWhitespace
+ | ws1 ws2 |
+ ws1 := PPSmalltalkWhitespaceParser new.
+ ws2 := PPSmalltalkWhitespaceParser new.
+
+ self assert: ws1 = ws2.
+ self assert: (ws1 == ws2) not.
+
+ self assert: ws1 hash = ws2 hash.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCSmalltalkVerificationTest.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,94 @@
+"{ 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 comment:''
+!
+
+!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).
+ ].
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCompiledJavaResource.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,28 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestResource subclass:#PPCompiledJavaResource
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Java'
+!
+
+PPCompiledJavaResource comment:''
+!
+
+!PPCompiledJavaResource methodsFor:'as yet unclassified'!
+
+setUp
+ | time configuration |
+
+ configuration := PPCConfiguration universal.
+ configuration arguments name:#PPCompiledJavaSyntax.
+
+ time := Time millisecondsToRun: [
+ PPJavaSyntax new compileWithConfiguration: configuration.
+ ].
+ Transcript crShow: 'Java Syntax compiled in: ', time asString, 'ms'.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCompiledJavaSyntaxTest.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,576 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPJavaLexiconTest subclass:#PPCompiledJavaSyntaxTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Java'
+!
+
+PPCompiledJavaSyntaxTest comment:''
+!
+
+!PPCompiledJavaSyntaxTest class methodsFor:'as yet unclassified'!
+
+resources
+ ^ (OrderedCollection with: PPCompiledJavaResource)
+ addAll: super resources;
+ yourself
+! !
+
+!PPCompiledJavaSyntaxTest methodsFor:'accessing'!
+
+context
+ ^ PPCContext new
+!
+
+parserClass
+ ^ Smalltalk at: #PPCompiledJavaSyntax
+!
+
+parserInstanceFor: aSymbol
+ ^ (Smalltalk at: #PPCompiledJavaSyntax) new startSymbol: aSymbol
+! !
+
+!PPCompiledJavaSyntaxTest methodsFor:'testing'!
+
+testAdditiveExpression1
+
+ self parse: 'true'
+ rule: #additiveExpression
+!
+
+testAdditiveExpression2
+
+ self parse: '3 + 5'
+ rule: #additiveExpression
+!
+
+testAdditiveExpression3
+
+ self parse: '4 + 8 - 2 + 9'
+ rule: #additiveExpression
+!
+
+testAndExpression1
+
+ self parse: 'true'
+ rule: #andExpression
+!
+
+testBlock1
+
+ self parse: '{ }'
+ rule: #block
+!
+
+testBlock2
+
+ self
+ parse:
+ '{
+ System.out.println("Hello World!!");
+ System.out.println("Hello World!!");
+ }'
+ rule: #block
+!
+
+testCompilationUnit1
+
+ self parse: 'package foo;
+ public class CU1 {}'
+ rule: #compilationUnit
+!
+
+testCompilationUnit2
+
+ self parse: 'package foo;
+ import foo.Bar;
+ public class CU2 {
+ }'
+ rule: #compilationUnit
+!
+
+testCompilationUnit3
+
+ self parse: 'class myfirstjavaprog
+{
+ public static void main(String args[])
+ {
+ System.out.println("Hello World!!");
+ }
+}'
+ rule: #compilationUnit
+!
+
+testCompilationUnit4
+
+ self parse: '
+ public class OddEven {
+ private int input;
+ public static void main(String[] args) {
+ OddEven number = new OddEven();
+ number.showDialog(); }
+ public void showDialog() {
+
+ try {
+
+ input = Integer.parseInt(JOptionPane.showInputDialog("Please Enter A Number"));
+ calculate();
+ } catch (NumberFormatException e) {
+
+ System.err.println("ERROR: Invalid input. Please type in a numerical value.");
+ }
+ }
+
+private void calculate() {
+ if (input % 2 == 0) {
+ System.out.println("Even");
+ } else {
+ System.out.println("Odd");
+ }
+ }
+ }'
+ rule: #compilationUnit
+!
+
+testCompilationUnit5
+
+ self parse: 'class myfirstjavaprog
+{
+
+ public myfirstjavaprog() {
+
+ }
+
+ public static void main(String args[])
+ {
+ System.out.println("Hello World!!");
+ }
+}'
+ rule: #compilationUnit
+!
+
+testConditionalAndExpression1
+
+ self parse: 'true'
+ rule: #conditionalAndExpression
+!
+
+testConditionalOrExpression1
+
+ self parse: 'true'
+ rule: #conditionalOrExpression
+!
+
+testEqualityExpression1
+
+ self
+ parse: 'true'
+ rule: #equalityExpression
+!
+
+testExclusiveOrExpression1
+
+ self parse: 'true'
+ rule: #exclusiveOrExpression
+!
+
+testExpression1
+
+ self parse: '1 + 2'
+ rule: #expression
+!
+
+testExpression2
+
+ self parse: 'true'
+ rule: #expression
+!
+
+testExpression3
+
+ self parse: 'a.method()'
+ rule: #expression
+!
+
+testExpression4
+
+ self parse: 'a'
+ rule: #expression
+!
+
+testExpression5
+
+ self parse: 'a += 5'
+ rule: #expression
+!
+
+testFormalParameters1
+
+ self
+ parse: '
+ (String s, Object parameterType)'
+ rule: #formalParameters
+!
+
+testFormalParameters2
+
+ self
+ parse: '
+ (Object ... parameterType)'
+ rule: #formalParameters
+!
+
+testFormalParameters3
+
+ self
+ parse: '(String name, Class<?>... parameterTypes)'
+ rule: #formalParameters
+!
+
+testFormalParameters4
+
+ self
+ parse: '(int one, int two, int three, int four)'
+ rule: #formalParameters
+!
+
+testFormalParameters5
+
+ self
+ parse: '()'
+ rule: #formalParameters
+!
+
+testIdentifier
+
+ self parse: 'method'
+ rule: #identifier
+!
+
+testIfStatement1
+
+ self parse: 'if (true) {}'
+ rule: #ifStatement
+!
+
+testIfStatement2
+
+ self parse: 'if (true) {} else {}'
+ rule: #ifStatement
+!
+
+testIfStatement3
+
+ self parse: '
+ if (true)
+ {int a = 0; a = 1;}
+ else
+ {return false;}'
+ rule: #ifStatement
+!
+
+testIfStatement4
+
+ self parse: 'if (true) a = 0;'
+ rule: #ifStatement
+!
+
+testIfStatement5
+
+ self parse: 'if (a < 4) {}'
+ rule: #ifStatement
+!
+
+testImportDeclaration1
+
+ self parse: 'import foo.Top;'
+ rule: #importDeclaration
+!
+
+testImportDeclaration2
+
+ self parse: 'import foo.Top2.*;'
+ rule: #importDeclaration
+!
+
+testInclusiveOrExpression1
+
+ self parse: 'true'
+ rule: #inclusiveOrExpression
+!
+
+testInstanceofExpression1
+
+ self
+ parse: 'true'
+ rule: #instanceofExpression
+!
+
+testJavaToken
+
+ self parse: 'false' rule: #literal.
+ self assert: (result isKindOf: PPJavaToken).
+ self assert: (result inputValue = 'false').
+!
+
+testLocalVariableDeclaration1
+
+ self parse: 'Type name'
+ rule: #localVariableDeclaration
+!
+
+testLocalVariableDeclaration2
+
+ self parse: 'Type name = value, name2'
+ rule: #localVariableDeclaration
+!
+
+testLocalVariableDeclarationStatement1
+
+ self parse: 'int i = 5;'
+ rule: #localVariableDeclarationStatement
+!
+
+testLocalVariableDeclarationStatement2
+
+ self parse: 'int i, j = 6;'
+ rule: #localVariableDeclarationStatement
+!
+
+testLocalVariableDeclarationStatement3
+
+ self parse: 'Srting str, in, g;'
+ rule: #localVariableDeclarationStatement
+!
+
+testMethodDeclaration3
+
+ self
+ parse: '
+ public void getMethod(String s, Object ... parameterType)
+ {
+ }'
+ rule: #methodDeclaration
+!
+
+testMethodDeclaration4
+
+ self
+ parse: '
+ public void getMethod(String s, int o)
+ {
+ }'
+ rule: #methodDeclaration
+!
+
+testMultiplicativeExpression1
+
+ self parse: 'true'
+ rule: #multiplicativeExpression
+!
+
+testMultiplicativeExpression2
+
+ self parse: '3 * 5'
+ rule: #multiplicativeExpression
+!
+
+testMultiplicativeExpression3
+
+ self parse: '4 * 8 / 2 * 9'
+ rule: #multiplicativeExpression
+!
+
+testNormalParameterDecl1
+
+ self parse: 'final int integers[]'
+ rule: #normalParameterDecl
+!
+
+testNormalParameterDecl2
+
+ self parse: 'String str'
+ rule: #normalParameterDecl
+!
+
+testPackageDeclaration
+ self
+ parse: 'package java.util;'
+ rule: #packageDeclaration
+!
+
+testPackageDeclaration1
+
+ self parse: 'package foo;'
+ rule: #packageDeclaration
+!
+
+testPackageDeclaration2
+
+ self parse: 'package foo.Bar;'
+ rule: #packageDeclaration
+!
+
+testPackageDeclaration3
+
+ self fail: 'package ;'
+ rule: #packageDeclaration
+!
+
+testPrimary1
+
+ self
+ parse: 'true'
+ rule: #primary
+!
+
+testPrimary2
+
+ self
+ parse: '"Java string"'
+ rule: #primary
+!
+
+testPrimaryWithselectors1
+
+ self
+ parse: 'true'
+ rule: #primaryWithselectors
+!
+
+testQualifiedName1
+
+ self parse: 'a.a'
+ rule: #qualifiedName
+!
+
+testRelationalExpression1
+
+ self parse: 'true'
+ rule: #relationalExpression
+!
+
+testRelationalExpression2
+
+ self parse: '3 > 5'
+ rule: #relationalExpression
+!
+
+testReturnStatement1
+
+ self parse: 'return true;'
+ rule: #returnStatement
+!
+
+testReturnStatement2
+
+ self parse: 'return;'
+ rule: #returnStatement
+!
+
+testShiftExpression1
+
+ self parse: 'true'
+ rule: #shiftExpression
+!
+
+testStatement1
+
+ self parse: 'System.out.println("Hello World!!");'
+ rule: #statement
+!
+
+testStatement2
+
+ self parse: 'return true;'
+ rule: #statement
+!
+
+testStatement3
+
+ self parse: '{}'
+ rule: #statement
+!
+
+testUnaryExpression1
+
+ self parse: 'a'
+ rule: #unaryExpression
+!
+
+testUnaryExpression2
+
+ self parse: 'true'
+ rule: #unaryExpression
+!
+
+testUnaryExpressionNotPlusMinus1
+
+ self
+ parse: 'true'
+ rule: #unaryExpressionNotPlusMinus
+!
+
+testVariableDeclarator1
+
+ self parse: 'var'
+ rule: #variableDeclarator
+!
+
+testVariableDeclarator2
+
+ self parse: 'var[][]'
+ rule: #variableDeclarator
+!
+
+testVariableDeclarator3
+
+ self parse: 'var = a.methd()'
+ rule: #variableDeclarator
+!
+
+testWhileStatement1
+
+ self parse: 'while (true) object.executeMethod();'
+ rule: #whileStatement
+!
+
+testWhileStatement2
+
+ self parse: 'while (3>2) {block; of; statements;}'
+ rule: #whileStatement
+! !
+
+!PPCompiledJavaSyntaxTest methodsFor:'testing-classes'!
+
+testClassDeclaration1
+
+ self parse: '//comment
+ class myfirstjavaprog
+{
+ public static void main(String args[])
+ {
+ System.out.println("Hello World!!");
+ }
+}'
+ rule: #classDeclaration
+!
+
+testMethodDeclaration1
+
+ self
+ parse: 'public void aMethod() { }'
+ rule: #methodDeclaration
+!
+
+testMethodDeclaration2
+
+ self
+ parse: 'public aMethod() { }'
+ rule: #methodDeclaration
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCompiledSmalltalkGrammarResource.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,28 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestResource subclass:#PPCompiledSmalltalkGrammarResource
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+PPCompiledSmalltalkGrammarResource comment:''
+!
+
+!PPCompiledSmalltalkGrammarResource methodsFor:'as yet unclassified'!
+
+setUp
+ | time configuration |
+ configuration := PPCConfiguration universal.
+ configuration arguments name:#PPCompiledSmalltalkGrammar.
+
+ time := Time millisecondsToRun: [
+ PPSmalltalkGrammar new compileWithConfiguration: configuration.
+ ].
+ Transcript crShow: 'Smalltalk Grammar compiled in: ', time asString, 'ms'.
+
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCompiledSmalltalkGrammarTests.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,933 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCompositeParserTest subclass:#PPCompiledSmalltalkGrammarTests
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+PPCompiledSmalltalkGrammarTests comment:''
+!
+
+
+!PPCompiledSmalltalkGrammarTests class methodsFor:'accessing'!
+
+resources
+ ^ (OrderedCollection with: PPCompiledSmalltalkGrammarResource)
+ addAll: super resources;
+ yourself
+! !
+
+!PPCompiledSmalltalkGrammarTests methodsFor:'accessing'!
+
+context
+ ^ PPCContext new
+!
+
+parserClass
+ ^ Smalltalk at: #PPCompiledSmalltalkGrammar
+!
+
+parserInstanceFor: aSymbol
+ ^ (Smalltalk at: #PPCompiledSmalltalkGrammar) new startSymbol: aSymbol
+! !
+
+!PPCompiledSmalltalkGrammarTests methodsFor:'testing'!
+
+testArray1
+ self
+ parse: '{}'
+ rule: #array
+!
+
+testArray2
+ self
+ parse: '{self foo}'
+ rule: #array
+!
+
+testArray3
+ self
+ parse: '{self foo. self bar}'
+ rule: #array
+!
+
+testArray4
+ self
+ parse: '{self foo. self bar.}'
+ rule: #array
+!
+
+testAssignment1
+ self
+ parse: '1'
+ rule: #expression
+!
+
+testAssignment2
+ self
+ parse: 'a := 1'
+ rule: #expression
+!
+
+testAssignment3
+ self
+ parse: 'a := b := 1'
+ rule: #expression
+!
+
+testAssignment4
+ PPSmalltalkGrammar allowUnderscoreAssignment
+ ifTrue: [ self parse: 'a _ 1' rule: #expression ]
+ ifFalse: [ self fail: 'a _ 1' rule: #expression ]
+!
+
+testAssignment5
+ PPSmalltalkGrammar allowUnderscoreAssignment
+ ifTrue: [ self parse: 'a _ b _ 1' rule: #expression ]
+ ifFalse: [ self fail: 'a _ b _ 1' rule: #expression ]
+!
+
+testAssignment6
+ self
+ parse: 'a := (b := c)'
+ rule: #expression
+!
+
+testComment1
+ self
+ parse: '1"one"+2'
+ rule: #expression
+!
+
+testComment2
+ self
+ parse: '1 "one" +2'
+ rule: #expression
+!
+
+testComment3
+ self
+ parse: '1"one"+"two"2'
+ rule: #expression
+!
+
+testComment4
+ self
+ parse: '1"one""two"+2'
+ rule: #expression
+!
+
+testComment5
+ self
+ parse: '1"one" "two"+2'
+ rule: #expression
+!
+
+testCompleteness
+ "This test asserts that all subclasses override all test methods."
+
+ self class allSubclasses do: [ :subclass |
+ self class testSelectors do: [ :selector |
+ self
+ assert: (selector = #testCompleteness or: [ subclass selectors includes: selector ])
+ description: subclass printString , ' does not test ' , selector printString ] ]
+!
+
+testMethod1
+ self
+ parse: 'negated ^ 0 - self'
+ rule: #method
+!
+
+testMethod2
+ "Spaces at the beginning of the method."
+ self
+ parse: ' negated ^ 0 - self'
+ rule: #method
+!
+
+testMethod3
+ "Spaces at the end of the method."
+ self
+ parse: ' negated ^ 0 - self '
+ rule: #method
+!
+
+testSequence1
+ self
+ parse: '| a | 1 . 2'
+ rule: #sequence
+!
+
+testStatements1
+ self
+ parse: '1'
+ rule: #sequence
+!
+
+testStatements2
+ self
+ parse: '1 . 2'
+ rule: #sequence
+!
+
+testStatements3
+ self
+ parse: '1 . 2 . 3'
+ rule: #sequence
+!
+
+testStatements4
+ self
+ parse: '1 . 2 . 3 .'
+ rule: #sequence
+!
+
+testStatements5
+ self
+ parse: '1 . . 2'
+ rule: #sequence
+!
+
+testStatements6
+ self
+ parse: '1. 2'
+ rule: #sequence
+!
+
+testStatements7
+ self
+ parse: '. 1'
+ rule: #sequence
+!
+
+testStatements8
+ self
+ parse: '.1'
+ rule: #sequence
+!
+
+testStatements9
+ self
+ parse: ''
+ rule: #statements
+!
+
+testTemporaries1
+ self
+ parse: '| a |'
+ rule: #sequence
+!
+
+testTemporaries2
+ self
+ parse: '| a b |'
+ rule: #sequence
+!
+
+testTemporaries3
+ self
+ parse: '| a b c |'
+ rule: #sequence
+!
+
+testVariable1
+ self
+ parse: 'trueBinding'
+ rule: #primary
+!
+
+testVariable2
+ self
+ parse: 'falseBinding'
+ rule: #primary
+!
+
+testVariable3
+ self
+ parse: 'nilly'
+ rule: #primary
+!
+
+testVariable4
+ self
+ parse: 'selfish'
+ rule: #primary
+!
+
+testVariable5
+ self
+ parse: 'supernanny'
+ rule: #primary
+!
+
+testVariable6
+ PPSmalltalkGrammar allowUnderscoreAssignment ifFalse: [
+ self
+ parse: 'super_nanny'
+ rule: #primary ]
+!
+
+testVariable7
+ PPSmalltalkGrammar allowUnderscoreAssignment ifFalse: [
+ self
+ parse: '__gen_var_123__'
+ rule: #primary ]
+! !
+
+!PPCompiledSmalltalkGrammarTests methodsFor:'testing-blocks'!
+
+testArgumentsBlock1
+ self
+ parse: '[ :a | ]'
+ rule: #block
+!
+
+testArgumentsBlock2
+ self
+ parse: '[ :a :b | ]'
+ rule: #block
+!
+
+testArgumentsBlock3
+ self
+ parse: '[ :a :b :c | ]'
+ rule: #block
+!
+
+testBlock1
+ self
+ parse: '[]'
+ rule: #block
+!
+
+testComplexBlock1
+ self
+ parse: '[ :a | | b | c ]'
+ rule: #block
+!
+
+testComplexBlock2
+ self
+ parse: '[:a||b|c]'
+ rule: #block
+!
+
+testSimpleBlock1
+ self
+ parse: '[ ]'
+ rule: #block
+!
+
+testSimpleBlock2
+ self
+ parse: '[ nil ]'
+ rule: #block
+!
+
+testSimpleBlock3
+ self
+ parse: '[ :a ]'
+ rule: #block
+!
+
+testStatementBlock1
+ self
+ parse: '[ nil ]'
+ rule: #block
+!
+
+testStatementBlock2
+ self
+ parse: '[ | a | nil ]'
+ rule: #block
+!
+
+testStatementBlock3
+ self
+ parse: '[ | a b | nil ]'
+ rule: #block
+! !
+
+!PPCompiledSmalltalkGrammarTests methodsFor:'testing-literals'!
+
+testArrayLiteral1
+ self
+ parse: '#()'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral10
+ self
+ parse: '#((1 2) #(1 2 3))'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral11
+ self
+ parse: '#([1 2] #[1 2 3])'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral2
+ self
+ parse: '#(1)'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral3
+ self
+ parse: '#(1 2)'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral4
+ self
+ parse: '#(true false nil)'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral5
+ self
+ parse: '#($a)'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral6
+ self
+ parse: '#(1.2)'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral7
+ self
+ parse: '#(size #at: at:put: #''=='')'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral8
+ self
+ parse: '#(''baz'')'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral9
+ self
+ parse: '#((1) 2)'
+ rule: #arrayLiteral
+!
+
+testByteLiteral1
+ self
+ parse: '#[]'
+ rule: #byteLiteral
+!
+
+testByteLiteral2
+ self
+ parse: '#[0]'
+ rule: #byteLiteral
+!
+
+testByteLiteral3
+ self
+ parse: '#[255]'
+ rule: #byteLiteral
+!
+
+testByteLiteral4
+ self
+ parse: '#[ 1 2 ]'
+ rule: #byteLiteral
+!
+
+testByteLiteral5
+ self
+ parse: '#[ 2r1010 8r77 16rFF ]'
+ rule: #byteLiteral
+!
+
+testCharLiteral1
+ self
+ parse: '$a'
+ rule: #charLiteral
+!
+
+testCharLiteral2
+ self
+ parse: '$ '
+ rule: #charLiteral
+!
+
+testCharLiteral3
+ self
+ parse: '$$'
+ rule: #charLiteral
+!
+
+testNumberLiteral1
+ self
+ parse: '0'
+ rule: #numberLiteral
+!
+
+testNumberLiteral10
+ self
+ parse: '10r10'
+ rule: #numberLiteral
+!
+
+testNumberLiteral11
+ self
+ parse: '8r777'
+ rule: #numberLiteral
+!
+
+testNumberLiteral12
+ self
+ parse: '16rAF'
+ rule: #numberLiteral
+!
+
+testNumberLiteral13
+ self
+ parse: '16rCA.FE'
+ rule: #numberLiteral
+!
+
+testNumberLiteral14
+ self
+ parse: '3r-22.2'
+ rule: #numberLiteral
+!
+
+testNumberLiteral15
+ self
+ parse: '0.50s2'
+ rule: #numberLiteral
+!
+
+testNumberLiteral2
+ self
+ parse: '0.1'
+ rule: #numberLiteral
+!
+
+testNumberLiteral3
+ self
+ parse: '123'
+ rule: #numberLiteral
+!
+
+testNumberLiteral4
+ self
+ parse: '123.456'
+ rule: #numberLiteral
+!
+
+testNumberLiteral5
+ self
+ parse: '-0'
+ rule: #numberLiteral
+!
+
+testNumberLiteral6
+ self
+ parse: '-0.1'
+ rule: #numberLiteral
+!
+
+testNumberLiteral7
+ self
+ parse: '-123'
+ rule: #numberLiteral
+!
+
+testNumberLiteral8
+ self
+ parse: '-125'
+ rule: #numberLiteral
+!
+
+testNumberLiteral9
+ self
+ parse: '-123.456'
+ rule: #numberLiteral
+!
+
+testSpecialLiteral1
+ self
+ parse: 'true'
+ rule: #trueLiteral
+!
+
+testSpecialLiteral2
+ self
+ parse: 'false'
+ rule: #falseLiteral
+!
+
+testSpecialLiteral3
+ self
+ parse: 'nil'
+ rule: #nilLiteral
+!
+
+testStringLiteral1
+ self
+ parse: ''''''
+ rule: #stringLiteral
+!
+
+testStringLiteral2
+ self
+ parse: '''ab'''
+ rule: #stringLiteral
+!
+
+testStringLiteral3
+ self
+ parse: '''ab''''cd'''
+ rule: #stringLiteral
+!
+
+testSymbolLiteral1
+ self
+ parse: '#foo'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral2
+ self
+ parse: '#+'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral3
+ self
+ parse: '#key:'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral4
+ self
+ parse: '#key:value:'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral5
+ self
+ parse: '#''testing-result'''
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral6
+ PPSmalltalkGrammar allowUnderscoreAssignment ifFalse: [
+ self
+ parse: '#__gen__binding'
+ rule: #symbolLiteral ]
+!
+
+testSymbolLiteral7
+ self
+ parse: '# fucker'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral8
+ self
+ parse: '##fucker'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral9
+ self
+ parse: '## fucker'
+ rule: #symbolLiteral
+! !
+
+!PPCompiledSmalltalkGrammarTests methodsFor:'testing-messages'!
+
+testBinaryExpression1
+ self
+ parse: '1 + 2'
+ rule: #expression
+!
+
+testBinaryExpression2
+ self
+ parse: '1 + 2 + 3'
+ rule: #expression
+!
+
+testBinaryExpression3
+ self
+ parse: '1 // 2'
+ rule: #expression
+!
+
+testBinaryExpression4
+ self
+ parse: '1 -- 2'
+ rule: #expression
+!
+
+testBinaryExpression5
+ self
+ parse: '1 ==> 2'
+ rule: #expression.
+!
+
+testBinaryMethod1
+ self
+ parse: '+ a'
+ rule: #method
+!
+
+testBinaryMethod2
+ self
+ parse: '+ a | b |'
+ rule: #method
+!
+
+testBinaryMethod3
+ self
+ parse: '+ a b'
+ rule: #method
+!
+
+testBinaryMethod4
+ self
+ parse: '+ a | b | c'
+ rule: #method
+!
+
+testBinaryMethod5
+ self
+ parse: '-- a'
+ rule: #method
+!
+
+testCascadeExpression1
+ self
+ parse: '1 abs; negated'
+ rule: #expression
+!
+
+testCascadeExpression2
+ self
+ parse: '1 abs negated; raisedTo: 12; negated'
+ rule: #expression
+!
+
+testCascadeExpression3
+ self
+ parse: '1 + 2; - 3'
+ rule: #expression
+!
+
+testIdentifierToken
+ self
+ parse: 'foo'
+ rule: #identifierToken
+!
+
+testIdentifierToken2
+ self
+ parse: ' foo'
+ rule: #identifierToken
+!
+
+testKeywordExpression1
+ self
+ parse: '1 to: 2'
+ rule: #expression
+!
+
+testKeywordExpression2
+ self
+ parse: '1 to: 2 by: 3'
+ rule: #expression
+!
+
+testKeywordExpression3
+ self
+ parse: '1 to: 2 by: 3 do: 4'
+ rule: #expression
+!
+
+testKeywordMethod1
+ self
+ parse: 'to: a'
+ rule: #method
+!
+
+testKeywordMethod2
+ self
+ parse: 'to: a do: b | c |'
+ rule: #method
+!
+
+testKeywordMethod3
+ self
+ parse: 'to: a do: b by: c d'
+ rule: #method
+!
+
+testKeywordMethod4
+ self
+ parse: 'to: a do: b by: c | d | e'
+ rule: #method
+!
+
+testUnaryExpression1
+ self
+ parse: '1 abs'
+ rule: #expression
+!
+
+testUnaryExpression2
+ self
+ parse: '1 abs negated'
+ rule: #expression
+!
+
+testUnaryMethod1
+ self
+ parse: 'abs'
+ rule: #method
+!
+
+testUnaryMethod2
+ self
+ parse: 'abs | a |'
+ rule: #method
+!
+
+testUnaryMethod3
+ self
+ parse: 'abs a'
+ rule: #method
+!
+
+testUnaryMethod4
+ self
+ parse: 'abs | a | b'
+ rule: #method
+!
+
+testUnaryMethod5
+ self
+ parse: 'abs | a |'
+ rule: #method
+! !
+
+!PPCompiledSmalltalkGrammarTests methodsFor:'testing-pragmas'!
+
+testPragma1
+ self
+ parse: 'method <foo>'
+ rule: #method
+!
+
+testPragma10
+ self
+ parse: 'method <foo: bar>'
+ rule: #method
+!
+
+testPragma11
+ self
+ parse: 'method <foo: true>'
+ rule: #method
+!
+
+testPragma12
+ self
+ parse: 'method <foo: false>'
+ rule: #method
+!
+
+testPragma13
+ self
+ parse: 'method <foo: nil>'
+ rule: #method
+!
+
+testPragma14
+ self
+ parse: 'method <foo: ()>'
+ rule: #method
+!
+
+testPragma15
+ self
+ parse: 'method <foo: #()>'
+ rule: #method
+!
+
+testPragma16
+ self
+ parse: 'method < + 1 >'
+ rule: #method
+!
+
+testPragma2
+ self
+ parse: 'method <foo> <bar>'
+ rule: #method
+!
+
+testPragma3
+ self
+ parse: 'method | a | <foo>'
+ rule: #method
+!
+
+testPragma4
+ self
+ parse: 'method <foo> | a |'
+ rule: #method
+!
+
+testPragma5
+ self
+ parse: 'method <foo> | a | <bar>'
+ rule: #method
+!
+
+testPragma6
+ self
+ parse: 'method <foo: 1>'
+ rule: #method
+!
+
+testPragma7
+ self
+ parse: 'method <foo: 1.2>'
+ rule: #method
+!
+
+testPragma8
+ self
+ parse: 'method <foo: ''bar''>'
+ rule: #method
+!
+
+testPragma9
+ self
+ parse: 'method <foo: #''bar''>'
+ rule: #method
+! !
+
+!PPCompiledSmalltalkGrammarTests class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCompiledSmalltalkVerificationTest.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,42 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCSmalltalkVerificationTest subclass:#PPCompiledSmalltalkVerificationTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+PPCompiledSmalltalkVerificationTest comment:''
+!
+
+!PPCompiledSmalltalkVerificationTest class methodsFor:'as yet unclassified'!
+
+resources
+ ^ (OrderedCollection with: PPCompiledSmalltalkGrammarResource)
+ addAll: super resources;
+ yourself
+! !
+
+!PPCompiledSmalltalkVerificationTest methodsFor:'accessing'!
+
+compiledSmalltalkGrammarClass
+ ^ (Smalltalk at: #PPCompiledSmalltalkGrammar)
+! !
+
+!PPCompiledSmalltalkVerificationTest methodsFor:'tests'!
+
+testSmalltalk
+ super testSmalltalk
+!
+
+testSmalltalkClass
+ super testSmalltalkClass
+!
+
+testSmalltalkObject
+ super testSmalltalkObject
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPTokenizedSmalltalkGrammarResource.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,41 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestResource subclass:#PPTokenizedSmalltalkGrammarResource
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+PPTokenizedSmalltalkGrammarResource comment:''
+!
+
+!PPTokenizedSmalltalkGrammarResource methodsFor:'as yet unclassified'!
+
+setUp
+ | time configuration |
+ configuration := PPCConfiguration LL1.
+ configuration arguments name:#PPTokenizedSmalltalkGrammar.
+
+ time := Time millisecondsToRun: [
+ PPSmalltalkGrammar new compileWithConfiguration: configuration.
+ ].
+ Transcript crShow: 'Smalltalk Grammar tokenized in: ', time asString, 'ms'.
+
+!
+
+tearDown
+ | parserClass |
+ super tearDown.
+
+ parserClass := (Smalltalk at: #PPTokenizedSmalltalkGrammar ifAbsent: [nil]).
+ self flag: 'uncomment:'.
+"
+ parserClass notNil ifTrue:[
+ parserClass removeFromSystem
+ ].
+"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPTokenizedSmalltalkGrammarTests.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,931 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCompositeParserTest subclass:#PPTokenizedSmalltalkGrammarTests
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+PPTokenizedSmalltalkGrammarTests comment:''
+!
+
+!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
+!
+
+testSequence1
+ self
+ parse: '| a | 1 . 2'
+ rule: #sequence
+!
+
+testStatements1
+ self
+ parse: '1'
+ rule: #sequence
+!
+
+testStatements2
+ self
+ parse: '1 . 2'
+ rule: #sequence
+!
+
+testStatements3
+ self
+ parse: '1 . 2 . 3'
+ rule: #sequence
+!
+
+testStatements4
+ self
+ parse: '1 . 2 . 3 .'
+ rule: #sequence
+!
+
+testStatements5
+ self
+ parse: '1 . . 2'
+ rule: #sequence
+!
+
+testStatements6
+ self
+ parse: '1. 2'
+ rule: #sequence
+!
+
+testStatements7
+ self
+ parse: '. 1'
+ rule: #sequence
+!
+
+testStatements8
+ self
+ parse: '.1'
+ rule: #sequence
+!
+
+testStatements9
+ self
+ parse: ''
+ rule: #statements
+!
+
+testTemporaries1
+ self
+ parse: '| a |'
+ rule: #sequence
+!
+
+testTemporaries2
+ self
+ parse: '| a b |'
+ rule: #sequence
+!
+
+testTemporaries3
+ self
+ parse: '| a b c |'
+ rule: #sequence
+!
+
+testVariable1
+ self
+ parse: 'trueBinding'
+ rule: #primary
+!
+
+testVariable2
+ self
+ parse: 'falseBinding'
+ rule: #primary
+!
+
+testVariable3
+ self
+ parse: 'nilly'
+ rule: #primary
+!
+
+testVariable4
+ self
+ parse: 'selfish'
+ rule: #primary
+!
+
+testVariable5
+ self
+ parse: 'supernanny'
+ rule: #primary
+!
+
+testVariable6
+ PPSmalltalkGrammar allowUnderscoreAssignment ifFalse: [
+ self
+ parse: 'super_nanny'
+ rule: #primary ]
+!
+
+testVariable7
+ PPSmalltalkGrammar allowUnderscoreAssignment ifFalse: [
+ self
+ parse: '__gen_var_123__'
+ rule: #primary ]
+! !
+
+!PPTokenizedSmalltalkGrammarTests methodsFor:'testing-blocks'!
+
+testArgumentsBlock1
+ self
+ parse: '[ :a | ]'
+ rule: #block
+!
+
+testArgumentsBlock2
+ self
+ parse: '[ :a :b | ]'
+ rule: #block
+!
+
+testArgumentsBlock3
+ self
+ parse: '[ :a :b :c | ]'
+ rule: #block
+!
+
+testBlock1
+ self
+ parse: '[]'
+ rule: #block
+!
+
+testComplexBlock1
+ self
+ parse: '[ :a | | b | c ]'
+ rule: #block
+!
+
+testComplexBlock2
+ self
+ parse: '[:a||b|c]'
+ rule: #block
+!
+
+testSimpleBlock1
+ self
+ parse: '[ ]'
+ rule: #block
+!
+
+testSimpleBlock2
+ self
+ parse: '[ nil ]'
+ rule: #block
+!
+
+testSimpleBlock3
+ self
+ parse: '[ :a ]'
+ rule: #block
+!
+
+testStatementBlock1
+ self
+ parse: '[ nil ]'
+ rule: #block
+!
+
+testStatementBlock2
+ self
+ parse: '[ | a | nil ]'
+ rule: #block
+!
+
+testStatementBlock3
+ self
+ parse: '[ | a b | nil ]'
+ rule: #block
+! !
+
+!PPTokenizedSmalltalkGrammarTests methodsFor:'testing-literals'!
+
+testArrayLiteral1
+ self
+ parse: '#()'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral10
+ self
+ parse: '#((1 2) #(1 2 3))'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral11
+ self
+ parse: '#([1 2] #[1 2 3])'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral2
+ self
+ parse: '#(1)'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral3
+ self
+ parse: '#(1 2)'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral4
+ self
+ parse: '#(true false nil)'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral5
+ self
+ parse: '#($a)'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral6
+ self
+ parse: '#(1.2)'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral7
+ self
+ parse: '#(size #at: at:put: #''=='')'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral8
+ self
+ parse: '#(''baz'')'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral9
+ self
+ parse: '#((1) 2)'
+ rule: #arrayLiteral
+!
+
+testByteLiteral1
+ self
+ parse: '#[]'
+ rule: #byteLiteral
+!
+
+testByteLiteral2
+ self
+ parse: '#[0]'
+ rule: #byteLiteral
+!
+
+testByteLiteral3
+ self
+ parse: '#[255]'
+ rule: #byteLiteral
+!
+
+testByteLiteral4
+ self
+ parse: '#[ 1 2 ]'
+ rule: #byteLiteral
+!
+
+testByteLiteral5
+ self
+ parse: '#[ 2r1010 8r77 16rFF ]'
+ rule: #byteLiteral
+!
+
+testCharLiteral1
+ self
+ parse: '$a'
+ rule: #charLiteral
+!
+
+testCharLiteral2
+ self
+ parse: '$ '
+ rule: #charLiteral
+!
+
+testCharLiteral3
+ self
+ parse: '$$'
+ rule: #charLiteral
+!
+
+testNumberLiteral1
+ self
+ parse: '0'
+ rule: #numberLiteral
+!
+
+testNumberLiteral10
+ self
+ parse: '10r10'
+ rule: #numberLiteral
+!
+
+testNumberLiteral11
+ self
+ parse: '8r777'
+ rule: #numberLiteral
+!
+
+testNumberLiteral12
+ self
+ parse: '16rAF'
+ rule: #numberLiteral
+!
+
+testNumberLiteral13
+ self
+ parse: '16rCA.FE'
+ rule: #numberLiteral
+!
+
+testNumberLiteral14
+ self
+ parse: '3r-22.2'
+ rule: #numberLiteral
+!
+
+testNumberLiteral15
+ self
+ parse: '0.50s2'
+ rule: #numberLiteral
+!
+
+testNumberLiteral2
+ self
+ parse: '0.1'
+ rule: #numberLiteral
+!
+
+testNumberLiteral3
+ self
+ parse: '123'
+ rule: #numberLiteral
+!
+
+testNumberLiteral4
+ self
+ parse: '123.456'
+ rule: #numberLiteral
+!
+
+testNumberLiteral5
+ self
+ parse: '-0'
+ rule: #numberLiteral
+!
+
+testNumberLiteral6
+ self
+ parse: '-0.1'
+ rule: #numberLiteral
+!
+
+testNumberLiteral7
+ self
+ parse: '-123'
+ rule: #numberLiteral
+!
+
+testNumberLiteral8
+ self
+ parse: '-125'
+ rule: #numberLiteral
+!
+
+testNumberLiteral9
+ self
+ parse: '-123.456'
+ rule: #numberLiteral
+!
+
+testSpecialLiteral1
+ self
+ parse: 'true'
+ rule: #trueLiteral
+!
+
+testSpecialLiteral2
+ self
+ parse: 'false'
+ rule: #falseLiteral
+!
+
+testSpecialLiteral3
+ self
+ parse: 'nil'
+ rule: #nilLiteral
+!
+
+testStringLiteral1
+ self
+ parse: ''''''
+ rule: #stringLiteral
+!
+
+testStringLiteral2
+ self
+ parse: '''ab'''
+ rule: #stringLiteral
+!
+
+testStringLiteral3
+ self
+ parse: '''ab''''cd'''
+ rule: #stringLiteral
+!
+
+testSymbolLiteral1
+ self
+ parse: '#foo'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral2
+ self
+ parse: '#+'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral3
+ self
+ parse: '#key:'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral4
+ self
+ parse: '#key:value:'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral5
+ self
+ parse: '#''testing-result'''
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral6
+ PPSmalltalkGrammar allowUnderscoreAssignment ifFalse: [
+ self
+ parse: '#__gen__binding'
+ rule: #symbolLiteral ]
+!
+
+testSymbolLiteral7
+ self
+ parse: '# fucker'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral8
+ self
+ parse: '##fucker'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral9
+ self
+ parse: '## fucker'
+ rule: #symbolLiteral
+! !
+
+!PPTokenizedSmalltalkGrammarTests methodsFor:'testing-messages'!
+
+testBinaryExpression1
+ self
+ parse: '1 + 2'
+ rule: #expression
+!
+
+testBinaryExpression2
+ self
+ parse: '1 + 2 + 3'
+ rule: #expression
+!
+
+testBinaryExpression3
+ self
+ parse: '1 // 2'
+ rule: #expression
+!
+
+testBinaryExpression4
+ self
+ parse: '1 -- 2'
+ rule: #expression
+!
+
+testBinaryExpression5
+ self
+ parse: '1 ==> 2'
+ rule: #expression.
+!
+
+testBinaryMethod1
+ self
+ parse: '+ a'
+ rule: #method
+!
+
+testBinaryMethod2
+ self
+ parse: '+ a | b |'
+ rule: #method
+!
+
+testBinaryMethod3
+ self
+ parse: '+ a b'
+ rule: #method
+!
+
+testBinaryMethod4
+ self
+ parse: '+ a | b | c'
+ rule: #method
+!
+
+testBinaryMethod5
+ self
+ parse: '-- a'
+ rule: #method
+!
+
+testCascadeExpression1
+ self
+ parse: '1 abs; negated'
+ rule: #expression
+!
+
+testCascadeExpression2
+ self
+ parse: '1 abs negated; raisedTo: 12; negated'
+ rule: #expression
+!
+
+testCascadeExpression3
+ self
+ parse: '1 + 2; - 3'
+ rule: #expression
+!
+
+testIdentifierToken
+ self
+ parse: 'foo'
+ rule: #identifierToken
+!
+
+testIdentifierToken2
+ self
+ parse: ' foo'
+ rule: #identifierToken
+!
+
+testKeywordExpression1
+ self
+ parse: '1 to: 2'
+ rule: #expression
+!
+
+testKeywordExpression2
+ self
+ parse: '1 to: 2 by: 3'
+ rule: #expression
+!
+
+testKeywordExpression3
+ self
+ parse: '1 to: 2 by: 3 do: 4'
+ rule: #expression
+!
+
+testKeywordMethod1
+ self
+ parse: 'to: a'
+ rule: #method
+!
+
+testKeywordMethod2
+ self
+ parse: 'to: a do: b | c |'
+ rule: #method
+!
+
+testKeywordMethod3
+ self
+ parse: 'to: a do: b by: c d'
+ rule: #method
+!
+
+testKeywordMethod4
+ self
+ parse: 'to: a do: b by: c | d | e'
+ rule: #method
+!
+
+testUnaryExpression1
+ self
+ parse: '1 abs'
+ rule: #expression
+!
+
+testUnaryExpression2
+ self
+ parse: '1 abs negated'
+ rule: #expression
+!
+
+testUnaryMethod1
+ self
+ parse: 'abs'
+ rule: #method
+!
+
+testUnaryMethod2
+ self
+ parse: 'abs | a |'
+ rule: #method
+!
+
+testUnaryMethod3
+ self
+ parse: 'abs a'
+ rule: #method
+!
+
+testUnaryMethod4
+ self
+ parse: 'abs | a | b'
+ rule: #method
+!
+
+testUnaryMethod5
+ self
+ parse: 'abs | a |'
+ rule: #method
+! !
+
+!PPTokenizedSmalltalkGrammarTests methodsFor:'testing-pragmas'!
+
+testPragma1
+ self
+ parse: 'method <foo>'
+ rule: #method
+!
+
+testPragma10
+ self
+ parse: 'method <foo: bar>'
+ rule: #method
+!
+
+testPragma11
+ self
+ parse: 'method <foo: true>'
+ rule: #method
+!
+
+testPragma12
+ self
+ parse: 'method <foo: false>'
+ rule: #method
+!
+
+testPragma13
+ self
+ parse: 'method <foo: nil>'
+ rule: #method
+!
+
+testPragma14
+ self
+ parse: 'method <foo: ()>'
+ rule: #method
+!
+
+testPragma15
+ self
+ parse: 'method <foo: #()>'
+ rule: #method
+!
+
+testPragma16
+ self
+ parse: 'method < + 1 >'
+ rule: #method
+!
+
+testPragma2
+ self
+ parse: 'method <foo> <bar>'
+ rule: #method
+!
+
+testPragma3
+ self
+ parse: 'method | a | <foo>'
+ rule: #method
+!
+
+testPragma4
+ self
+ parse: 'method <foo> | a |'
+ rule: #method
+!
+
+testPragma5
+ self
+ parse: 'method <foo> | a | <bar>'
+ rule: #method
+!
+
+testPragma6
+ self
+ parse: 'method <foo: 1>'
+ rule: #method
+!
+
+testPragma7
+ self
+ parse: 'method <foo: 1.2>'
+ rule: #method
+!
+
+testPragma8
+ self
+ parse: 'method <foo: ''bar''>'
+ rule: #method
+!
+
+testPragma9
+ self
+ parse: 'method <foo: #''bar''>'
+ rule: #method
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPTokenizedSmalltalkVerificationTest.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,42 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCSmalltalkVerificationTest subclass:#PPTokenizedSmalltalkVerificationTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Extras-Tests-Smalltalk'
+!
+
+PPTokenizedSmalltalkVerificationTest comment:''
+!
+
+!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
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/abbrev.stc Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,16 @@
+# 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.
+PPCCompiledJavaVerificationTest PPCCompiledJavaVerificationTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Java' 1
+PPCResources PPCResources stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Support' 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
+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
+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
+stx_goodies_petitparser_compiler_tests_extras stx_goodies_petitparser_compiler_tests_extras stx:goodies/petitparser/compiler/tests/extras '* Projects & Packages *' 3
+PPCompiledSmalltalkVerificationTest PPCompiledSmalltalkVerificationTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1
+PPTokenizedSmalltalkVerificationTest PPTokenizedSmalltalkVerificationTest stx:goodies/petitparser/compiler/tests/extras 'PetitCompiler-Extras-Tests-Smalltalk' 1
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/bc.mak Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,90 @@
+# $Header$
+#
+# DO NOT EDIT
+# automagically generated from the projectDefinition: stx_goodies_petitparser_compiler_tests_extras.
+#
+# Warning: once you modify this file, do not rerun
+# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
+#
+# Notice, that the name bc.mak is historical (from times, when only borland c was supported).
+# This file contains make rules for the win32 platform using either borland-bcc or visual-c.
+# It shares common definitions with the unix-make in Make.spec.
+# The bc.mak supports the following targets:
+# bmake - compile all st-files to a classLib (dll)
+# bmake clean - clean all temp files
+# bmake clobber - clean all
+#
+# Historic Note:
+# this used to contain only rules to make with borland
+# (called via bmake, by "make.exe -f bc.mak")
+# this has changed; it is now also possible to build using microsoft visual c
+# (called via vcmake, by "make.exe -f bc.mak -DUSEVC")
+#
+TOP=..\..\..\..\..
+INCLUDE_TOP=$(TOP)\..
+
+
+
+!INCLUDE $(TOP)\rules\stdHeader_bc
+
+!INCLUDE Make.spec
+
+LIBNAME=libstx_goodies_petitparser_compiler_tests_extras
+MODULE_PATH=goodies\petitparser\compiler\tests\extras
+RESFILES=extras.$(RES)
+
+
+
+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
+LOCALDEFINES=
+
+STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
+LOCALLIBS=
+
+OBJS= $(COMMON_OBJS) $(WIN32_OBJS)
+
+ALL:: classLibRule
+
+classLibRule: $(OUTDIR) $(OUTDIR)$(LIBNAME).dll
+
+!INCLUDE $(TOP)\rules\stdRules_bc
+
+# build all mandatory prerequisite packages (containing superclasses) for this package
+prereq:
+ pushd ..\..\..\..\..\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\..\..\..\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\..\..\..\libbasic3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\..\..\..\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\.. & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\..\..\..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\..\..\sunit & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\..\tests & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\..\parsers\java & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+
+
+
+
+
+
+
+test: $(TOP)\goodies\builder\reports\NUL
+ pushd $(TOP)\goodies\builder\reports & $(MAKE_BAT)
+ $(TOP)\goodies\builder\reports\report-runner.bat -D . -r Builder::TestReport -p $(PACKAGE)
+
+clean::
+ del *.$(CSUFFIX)
+
+
+# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(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)
+
+# ENDMAKEDEPEND --- do not remove this line
+
+# **Must be at end**
+
+# Enforce recompilation of package definition class if Mercurial working
+# copy state changes. Together with --guessVersion it ensures that package
+# definition class always contains correct binary revision string.
+!IFDEF HGROOT
+$(OUTDIR)stx_goodies_petitparser_compiler_tests_extras.$(O): $(HGROOT)\.hg\dirstate
+!ENDIF
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/bmake.bat Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,12 @@
+@REM -------
+@REM make using Borland bcc32
+@REM type bmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+make.exe -N -f bc.mak %DEFINES% %*
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/extras.rc Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,37 @@
+//
+// DO NOT EDIT
+// automagically generated from the projectDefinition: stx_goodies_petitparser_compiler_tests_extras.
+//
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION 6,2,32767,32767
+ PRODUCTVERSION 6,2,5,0
+#if (__BORLANDC__)
+ FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
+ FILEFLAGS VS_FF_PRERELEASE | VS_FF_SPECIALBUILD
+ FILEOS VOS_NT_WINDOWS32
+ FILETYPE VFT_DLL
+ FILESUBTYPE VS_USER_DEFINED
+#endif
+
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904E4"
+ BEGIN
+ VALUE "CompanyName", "eXept Software AG\0"
+ VALUE "FileDescription", "Smalltalk/X Class library (LIB)\0"
+ VALUE "FileVersion", "6.2.32767.32767\0"
+ VALUE "InternalName", "stx:goodies/petitparser/compiler/tests/extras\0"
+ VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2015\nCopyright eXept Software AG 1998-2015\0"
+ VALUE "ProductName", "Smalltalk/X\0"
+ VALUE "ProductVersion", "6.2.5.0\0"
+ VALUE "ProductDate", "Sun, 10 May 2015 05:28:22 GMT\0"
+ END
+
+ END
+
+ BLOCK "VarFileInfo"
+ BEGIN // Language | Translation
+ VALUE "Translation", 0x409, 0x4E4 // U.S. English, Windows Multilingual
+ END
+END
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/lccmake.bat Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,8 @@
+@REM -------
+@REM make using lcc compiler
+@REM type lccmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+make.exe -N -f bc.mak -DUSELCC=1 %*
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/libInit.cc Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,34 @@
+/*
+ * $Header$
+ *
+ * DO NOT EDIT
+ * automagically generated from the projectDefinition: stx_goodies_petitparser_compiler_tests_extras.
+ */
+#define __INDIRECTVMINITCALLS__
+#include <stc.h>
+
+#ifdef WIN32
+# pragma codeseg INITCODE "INITCODE"
+#endif
+
+#if defined(INIT_TEXT_SECTION) || defined(DLL_EXPORT)
+DLL_EXPORT void _libstx_goodies_petitparser_compiler_tests_extras_Init() INIT_TEXT_SECTION;
+DLL_EXPORT void _libstx_goodies_petitparser_compiler_tests_extras_InitDefinition() INIT_TEXT_SECTION;
+#endif
+
+void _libstx_goodies_petitparser_compiler_tests_extras_InitDefinition(pass, __pRT__, snd)
+OBJ snd; struct __vmData__ *__pRT__; {
+__BEGIN_PACKAGE2__("libstx_goodies_petitparser_compiler_tests_extras__DFN", _libstx_goodies_petitparser_compiler_tests_extras_InitDefinition, "stx:goodies/petitparser/compiler/tests/extras");
+_stx_137goodies_137petitparser_137compiler_137tests_137extras_Init(pass,__pRT__,snd);
+
+__END_PACKAGE__();
+}
+
+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");
+_stx_137goodies_137petitparser_137compiler_137tests_137extras_Init(pass,__pRT__,snd);
+
+
+__END_PACKAGE__();
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/mingwmake.bat Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,16 @@
+@REM -------
+@REM make using mingw gnu compiler
+@REM type mingwmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
+@pushd ..\..\..\..\..\rules
+@call find_mingw.bat
+@popd
+make.exe -N -f bc.mak %DEFINES% %USEMINGW_ARG% %*
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/stx_goodies_petitparser_compiler_tests_extras.st Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,163 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+LibraryDefinition subclass:#stx_goodies_petitparser_compiler_tests_extras
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'* Projects & Packages *'
+!
+
+
+!stx_goodies_petitparser_compiler_tests_extras class methodsFor:'accessing - monticello'!
+
+monticelloLastMergedVersionInfo
+ "The last merged version is: "
+
+ ^ '
+ Name: PetitCompiler-Extras-Tests-JanKurs.4
+ Author: JanKurs
+ Time: 08-05-2015, 05:56:46.180 PM
+ UUID: 4d4d4d23-c5bc-41ef-ad41-8a56528ddb42
+ Repository: http://smalltalkhub.com/mc/JanKurs/PetitParser/main
+
+ '
+
+ "Created: / 03-10-2014 / 02:27:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 10-05-2015 / 06:28:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+monticelloName
+ "Return name of the package for Monticello. This is used when package is exported"
+
+ ^ 'PetitCompiler-Extras-Tests'
+
+ "Created: / 03-10-2014 / 01:47:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 10-05-2015 / 06:27:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!stx_goodies_petitparser_compiler_tests_extras class methodsFor:'description'!
+
+excludedFromPreRequisites
+ "list packages which are to be explicitely excluded from the automatic constructed
+ prerequisites list. If empty, everything that is found along the inheritance of any of
+ my classes is considered to be a prerequisite package."
+
+ ^ #(
+ )
+!
+
+mandatoryPreRequisites
+ "list packages which are mandatory as a prerequisite.
+ This are packages containing superclasses of my classes and classes which
+ are extended by myself.
+ They are mandatory, because we need these packages as a prerequisite for loading and compiling.
+ This method is generated automatically,
+ by searching along the inheritance chain of all of my classes."
+
+ ^ #(
+ #'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:libbasic' "LibraryDefinition - superclass of stx_goodies_petitparser_compiler_tests_extras"
+ )
+!
+
+referencedPreRequisites
+ "list packages which are a prerequisite, because they contain
+ classes which are referenced by my classes.
+ We do not need these packages as a prerequisite for compiling or loading,
+ however, a class from it may be referenced during execution and having it
+ unloaded then may lead to a runtime doesNotUnderstand error, unless the caller
+ includes explicit checks for the package being present.
+ This method is generated automatically,
+ by searching all classes (and their packages) which are referenced by my classes."
+
+ ^ #(
+ #'stx:goodies/petitparser' "PPFailure - referenced by PPCResources>>workingJavaInDirectory:"
+ #'stx:goodies/petitparser/compiler' "PPCArguments - referenced by PPCSmalltalkTests>>setUp"
+ #'stx:goodies/petitparser/parsers/smalltalk' "PPSmalltalkGrammar - referenced by PPCSmalltalkVerificationTest>>smalltalkGrammar"
+ )
+!
+
+subProjects
+ "list packages which are known as subprojects.
+ The generated makefile will enter those and make there as well.
+ However: they are not forced to be loaded when a package is loaded;
+ for those, redefine requiredPrerequisites."
+
+ ^ #(
+ )
+! !
+
+!stx_goodies_petitparser_compiler_tests_extras class methodsFor:'description - contents'!
+
+classNamesAndAttributes
+ "lists the classes which are to be included in the project.
+ Each entry in the list may be: a single class-name (symbol),
+ or an array-literal consisting of class name and attributes.
+ Attributes are: #autoload or #<os> where os is one of win32, unix,..."
+
+ ^ #(
+ "<className> or (<className> attributes...) in load order"
+ (PPCCompiledJavaVerificationTest autoload)
+ (PPCResources autoload)
+ (PPCSmalltalkTests autoload)
+ (PPCSmalltalkVerificationTest autoload)
+ (PPCompiledJavaResource autoload)
+ (PPCompiledJavaSyntaxTest autoload)
+ (PPCompiledSmalltalkGrammarResource autoload)
+ (PPCompiledSmalltalkGrammarTests autoload)
+ (PPTokenizedSmalltalkGrammarResource autoload)
+ (PPTokenizedSmalltalkGrammarTests autoload)
+ #'stx_goodies_petitparser_compiler_tests_extras'
+ (PPCompiledSmalltalkVerificationTest autoload)
+ (PPTokenizedSmalltalkVerificationTest autoload)
+ )
+!
+
+extensionMethodNames
+ "list class/selector pairs of extensions.
+ A correponding method with real names must be present in my concrete subclasses"
+
+ ^ #(
+ )
+! !
+
+!stx_goodies_petitparser_compiler_tests_extras class methodsFor:'description - project information'!
+
+companyName
+ "Returns a company string which will appear in <lib>.rc.
+ Under win32, this is placed into the dlls file-info"
+
+ ^ 'eXept Software AG'
+!
+
+description
+ "Returns a description string which will appear in nt.def / bc.def"
+
+ ^ 'Smalltalk/X Class library'
+!
+
+legalCopyright
+ "Returns a copyright string which will appear in <lib>.rc.
+ Under win32, this is placed into the dlls file-info"
+
+ ^ 'Copyright Claus Gittinger 1988-2015\nCopyright eXept Software AG 1998-2015'
+!
+
+productName
+ "Returns a product name which will appear in <lib>.rc.
+ Under win32, this is placed into the dlls file-info.
+ This method is usually redefined in a concrete application definition"
+
+ ^ 'Smalltalk/X'
+! !
+
+!stx_goodies_petitparser_compiler_tests_extras class methodsFor:'documentation'!
+
+version_HG
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/vcmake.bat Sun May 10 06:28:36 2015 +0100
@@ -0,0 +1,20 @@
+@REM -------
+@REM make using Microsoft Visual C compiler
+@REM type vcmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+
+@if not defined VSINSTALLDIR (
+ pushd ..\..\..\..\..\rules
+ call vcsetup.bat
+ popd
+)
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+make.exe -N -f bc.mak -DUSEVC=1 %DEFINES% %*
+
+
+
+
--- a/compiler/tests/libInit.cc Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/libInit.cc Sun May 10 06:28:36 2015 +0100
@@ -34,21 +34,24 @@
_PPCCopyVisitorTest_Init(pass,__pRT__,snd);
_PPCGuardTest_Init(pass,__pRT__,snd);
_PPCInliningVisitorTest_Init(pass,__pRT__,snd);
+_PPCLL1OptimizingTest_Init(pass,__pRT__,snd);
+_PPCLL1Test_Init(pass,__pRT__,snd);
+_PPCLL1VisitorTest_Init(pass,__pRT__,snd);
_PPCMergingVisitorTest_Init(pass,__pRT__,snd);
_PPCMockCompiler_Init(pass,__pRT__,snd);
_PPCNodeFirstFollowNextTests_Init(pass,__pRT__,snd);
_PPCNodeTest_Init(pass,__pRT__,snd);
-_PPCOptimizingTest_Init(pass,__pRT__,snd);
-_PPCOptimizingVisitorTest_Init(pass,__pRT__,snd);
-_PPCProtype1Test_Init(pass,__pRT__,snd);
+_PPCOptimizeChoicesTest_Init(pass,__pRT__,snd);
+_PPCPrototype1OptimizingTest_Init(pass,__pRT__,snd);
+_PPCPrototype1Test_Init(pass,__pRT__,snd);
+_PPCRecognizerComponentDetectorTest_Init(pass,__pRT__,snd);
+_PPCRecognizerComponentVisitorTest_Init(pass,__pRT__,snd);
+_PPCSpecializingVisitorTest_Init(pass,__pRT__,snd);
_PPCTokenDetectorTest_Init(pass,__pRT__,snd);
-_PPCTokenVisitorTest_Init(pass,__pRT__,snd);
_PPCTokenizingCodeGeneratorTest_Init(pass,__pRT__,snd);
-_PPCVerificationTest_Init(pass,__pRT__,snd);
+_PPCTokenizingVisitorTest_Init(pass,__pRT__,snd);
_PPCompiledExpressionGrammarResource_Init(pass,__pRT__,snd);
_PPCompiledExpressionGrammarTest_Init(pass,__pRT__,snd);
-_PPCompiledJavaResource_Init(pass,__pRT__,snd);
-_PPCompiledSmalltalkGrammarResource_Init(pass,__pRT__,snd);
_PPExpressionGrammar_Init(pass,__pRT__,snd);
_PPExpressionGrammarTest_Init(pass,__pRT__,snd);
_stx_137goodies_137petitparser_137compiler_137tests_Init(pass,__pRT__,snd);
--- a/compiler/tests/stx_goodies_petitparser_compiler_tests.st Thu Apr 30 23:43:14 2015 +0200
+++ b/compiler/tests/stx_goodies_petitparser_compiler_tests.st Sun May 10 06:28:36 2015 +0100
@@ -58,7 +58,6 @@
^ #(
#'stx:goodies/petitparser' "PPCompositeParser - superclass of PPExpressionGrammar"
- #'stx:goodies/petitparser/parsers/java' "PPJavaLexiconTest - superclass of PPCompiledJavaSyntaxTest"
#'stx:goodies/petitparser/tests' "PPAbstractParserTest - superclass of PPCCodeGeneratorTest"
#'stx:goodies/sunit' "TestAsserter - superclass of PPCCodeGeneratorTest"
#'stx:libbasic' "LibraryDefinition - superclass of stx_goodies_petitparser_compiler_tests"
@@ -76,9 +75,8 @@
by searching all classes (and their packages) which are referenced by my classes."
^ #(
- #'stx:goodies/petitparser/compiler' "PPCAbstractCharacterNode - referenced by PPCOptimizingTest>>testForwarding"
- #'stx:goodies/petitparser/compiler/benchmarks' "PPCBenchmarkResources - referenced by PPCVerificationTest>>testJava"
- #'stx:goodies/petitparser/parsers/smalltalk' "PPSmalltalkGrammar - referenced by PPCVerificationTest>>smalltalkGrammar"
+ #'stx:goodies/petitparser/compiler' "PPCAbstractCharacterNode - referenced by PPCPrototype1OptimizingTest>>testForwarding"
+ #'stx:goodies/petitparser/parsers/java' "PPJavaWhitespaceParser - referenced by PPCMergingVisitorTest>>javaWsNode"
)
!
@@ -117,24 +115,24 @@
PPCCopyVisitorTest
PPCGuardTest
PPCInliningVisitorTest
+ PPCLL1OptimizingTest
+ PPCLL1Test
+ PPCLL1VisitorTest
PPCMergingVisitorTest
PPCMockCompiler
- (PPCNodeCompilingTest autoload)
PPCNodeFirstFollowNextTests
PPCNodeTest
- PPCOptimizingTest
- PPCOptimizingVisitorTest
- PPCProtype1Test
+ PPCOptimizeChoicesTest
+ PPCPrototype1OptimizingTest
+ PPCPrototype1Test
+ PPCRecognizerComponentDetectorTest
+ PPCRecognizerComponentVisitorTest
+ PPCSpecializingVisitorTest
PPCTokenDetectorTest
- PPCTokenVisitorTest
PPCTokenizingCodeGeneratorTest
- PPCVerificationTest
+ PPCTokenizingVisitorTest
PPCompiledExpressionGrammarResource
PPCompiledExpressionGrammarTest
- PPCompiledJavaResource
- (PPCompiledJavaSyntaxTest autoload)
- PPCompiledSmalltalkGrammarResource
- (PPCompiledSmalltalkGrammarTests autoload)
PPExpressionGrammar
PPExpressionGrammarTest
#'stx_goodies_petitparser_compiler_tests'