--- a/compiler/Make.proto Fri May 01 13:44:43 2015 +0200
+++ b/compiler/Make.proto Fri May 01 14:04:37 2015 +0200
@@ -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/parsers/smalltalk -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2
+LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/analyzer -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/java -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2
# if you need any additional defines for embedded C code,
@@ -104,8 +104,14 @@
cd ../../../libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
cd ../../refactoryBrowser/parser && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
cd ../../../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../../libbasic3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
cd ../ && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
cd ../parsers/smalltalk && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../sunit && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../tests && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../parsers/java && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
@@ -125,73 +131,75 @@
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)PPCArguments.$(O) PPCArguments.$(H): PPCArguments.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCBridge.$(O) PPCBridge.$(H): PPCBridge.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)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)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)
$(OUTDIR)PPCGuard.$(O) PPCGuard.$(H): PPCGuard.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCMethod.$(O) PPCMethod.$(H): PPCMethod.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCMethodStrategy.$(O) PPCMethodStrategy.$(H): PPCMethodStrategy.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCNode.$(O) PPCNode.$(H): PPCNode.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCOptimizationResult.$(O) PPCOptimizationResult.$(H): PPCOptimizationResult.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCNodeVisitor.$(O) PPCNodeVisitor.$(H): PPCNodeVisitor.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)
$(OUTDIR)PPCAbstractLiteralNode.$(O) PPCAbstractLiteralNode.$(H): PPCAbstractLiteralNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCAbstractPredicateNode.$(O) PPCAbstractPredicateNode.$(H): PPCAbstractPredicateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCAnyNode.$(O) PPCAnyNode.$(H): PPCAnyNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)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)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)PPCUnknownNode.$(O) PPCUnknownNode.$(H): PPCUnknownNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(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)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)PPCInlineAnyNode.$(O) PPCInlineAnyNode.$(H): PPCInlineAnyNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAnyNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCInlineCharacterNode.$(O) PPCInlineCharacterNode.$(H): PPCInlineCharacterNode.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)PPCInlineNilNode.$(O) PPCInlineNilNode.$(H): PPCInlineNilNode.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)PPCInlinePluggableNode.$(O) PPCInlinePluggableNode.$(H): PPCInlinePluggableNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCPluggableNode.$(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)
$(OUTDIR)PPCNegateNode.$(O) PPCNegateNode.$(H): PPCNegateNode.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)PPCNotCharSetPredicateNode.$(O) PPCNotCharSetPredicateNode.$(H): PPCNotCharSetPredicateNode.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)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)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)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)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)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)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)PPCInlineCharSetPredicateNode.$(O) PPCInlineCharSetPredicateNode.$(H): PPCInlineCharSetPredicateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractPredicateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCCharSetPredicateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCInlineLiteralNode.$(O) PPCInlineLiteralNode.$(H): PPCInlineLiteralNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractLiteralNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCLiteralNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCInlineMessagePredicateNode.$(O) PPCInlineMessagePredicateNode.$(H): PPCInlineMessagePredicateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractPredicateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCMessagePredicateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCInlineNotCharSetPredicateNode.$(O) PPCInlineNotCharSetPredicateNode.$(H): PPCInlineNotCharSetPredicateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractPredicateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNotCharSetPredicateNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCInlineNotLiteralNode.$(O) PPCInlineNotLiteralNode.$(H): PPCInlineNotLiteralNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractLiteralNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNotLiteralNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCInlineNotMessagePredicateNode.$(O) PPCInlineNotMessagePredicateNode.$(H): PPCInlineNotMessagePredicateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractPredicateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNotMessagePredicateNode.$(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)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)PPCTokenActionNode.$(O) PPCTokenActionNode.$(H): PPCTokenActionNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCAbstractActionNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCActionNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCDelegateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenStarMessagePredicateNode.$(O) PPCTokenStarMessagePredicateNode.$(H): PPCTokenStarMessagePredicateNode.st $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCDelegateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCStarMessagePredicateNode.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/compiler/PPCStarNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCInlineTokenStarMessagePredicateNode.$(O) PPCInlineTokenStarMessagePredicateNode.$(H): PPCInlineTokenStarMessagePredicateNode.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)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)PPCInlineTokenStarSeparatorNode.$(O) PPCInlineTokenStarSeparatorNode.$(H): PPCInlineTokenStarSeparatorNode.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/goodies/petitparser/compiler/PPCTokenStarSeparatorNode.$(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/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/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 Fri May 01 13:44:43 2015 +0200
+++ b/compiler/Make.spec Fri May 01 14:04:37 2015 +0200
@@ -51,143 +51,147 @@
STCWARNINGS=-warnNonStandard
COMMON_CLASSES= \
+ PPCArguments \
PPCBridge \
PPCCompiledMethod \
PPCCompiler \
+ PPCConfiguration \
PPCContext \
PPCContextMemento \
PPCGuard \
PPCMethod \
- PPCMethodStrategy \
PPCNode \
- PPCOptimizationResult \
+ PPCNodeVisitor \
PPCompiledParser \
stx_goodies_petitparser_compiler \
PPCAbstractCharacterNode \
PPCAbstractLiteralNode \
PPCAbstractPredicateNode \
PPCAnyNode \
+ PPCCodeGenerator \
PPCDelegateNode \
+ PPCEndOfFileNode \
+ PPCFirstPrototype \
PPCInlinedMethod \
+ PPCInliningVisitor \
PPCListNode \
PPCNilNode \
+ PPCPluggableConfiguration \
PPCPluggableNode \
PPCProfilingContext \
+ PPCRewritingVisitor \
PPCUnknownNode \
PPCAbstractActionNode \
PPCAndNode \
PPCCharSetPredicateNode \
PPCCharacterNode \
PPCChoiceNode \
+ PPCCopyVisitor \
PPCForwardNode \
- PPCInlineAnyNode \
- PPCInlineCharacterNode \
- PPCInlineNilNode \
- PPCInlinePluggableNode \
PPCLiteralNode \
+ PPCMergingVisitor \
PPCMessagePredicateNode \
PPCNegateNode \
PPCNotCharSetPredicateNode \
PPCNotLiteralNode \
PPCNotMessagePredicateNode \
PPCNotNode \
+ PPCOptimizingVisitor \
PPCOptionalNode \
PPCPlusNode \
PPCPredicateNode \
PPCSentinelNode \
PPCSequenceNode \
PPCStarNode \
+ PPCTokenConsumeNode \
+ PPCTokenDetector \
PPCTokenNode \
+ PPCTokenVisitor \
+ PPCTokenizingCodeGenerator \
PPCTrimNode \
PPCTrimmingTokenNode \
PPCActionNode \
- PPCInlineCharSetPredicateNode \
- PPCInlineLiteralNode \
- PPCInlineMessagePredicateNode \
- PPCInlineNotCharSetPredicateNode \
- PPCInlineNotLiteralNode \
- PPCInlineNotMessagePredicateNode \
+ PPCLLChoiceNode \
PPCStarAnyNode \
PPCStarCharSetPredicateNode \
PPCStarMessagePredicateNode \
PPCSymbolActionNode \
PPCTokenSequenceNode \
- PPCTokenActionNode \
PPCTokenStarMessagePredicateNode \
- PPCInlineTokenStarMessagePredicateNode \
PPCTokenStarSeparatorNode \
- PPCInlineTokenStarSeparatorNode \
COMMON_OBJS= \
+ $(OUTDIR_SLASH)PPCArguments.$(O) \
$(OUTDIR_SLASH)PPCBridge.$(O) \
$(OUTDIR_SLASH)PPCCompiledMethod.$(O) \
$(OUTDIR_SLASH)PPCCompiler.$(O) \
+ $(OUTDIR_SLASH)PPCConfiguration.$(O) \
$(OUTDIR_SLASH)PPCContext.$(O) \
$(OUTDIR_SLASH)PPCContextMemento.$(O) \
$(OUTDIR_SLASH)PPCGuard.$(O) \
$(OUTDIR_SLASH)PPCMethod.$(O) \
- $(OUTDIR_SLASH)PPCMethodStrategy.$(O) \
$(OUTDIR_SLASH)PPCNode.$(O) \
- $(OUTDIR_SLASH)PPCOptimizationResult.$(O) \
+ $(OUTDIR_SLASH)PPCNodeVisitor.$(O) \
$(OUTDIR_SLASH)PPCompiledParser.$(O) \
$(OUTDIR_SLASH)stx_goodies_petitparser_compiler.$(O) \
$(OUTDIR_SLASH)PPCAbstractCharacterNode.$(O) \
$(OUTDIR_SLASH)PPCAbstractLiteralNode.$(O) \
$(OUTDIR_SLASH)PPCAbstractPredicateNode.$(O) \
$(OUTDIR_SLASH)PPCAnyNode.$(O) \
+ $(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)PPCListNode.$(O) \
$(OUTDIR_SLASH)PPCNilNode.$(O) \
+ $(OUTDIR_SLASH)PPCPluggableConfiguration.$(O) \
$(OUTDIR_SLASH)PPCPluggableNode.$(O) \
$(OUTDIR_SLASH)PPCProfilingContext.$(O) \
+ $(OUTDIR_SLASH)PPCRewritingVisitor.$(O) \
$(OUTDIR_SLASH)PPCUnknownNode.$(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)PPCForwardNode.$(O) \
- $(OUTDIR_SLASH)PPCInlineAnyNode.$(O) \
- $(OUTDIR_SLASH)PPCInlineCharacterNode.$(O) \
- $(OUTDIR_SLASH)PPCInlineNilNode.$(O) \
- $(OUTDIR_SLASH)PPCInlinePluggableNode.$(O) \
$(OUTDIR_SLASH)PPCLiteralNode.$(O) \
+ $(OUTDIR_SLASH)PPCMergingVisitor.$(O) \
$(OUTDIR_SLASH)PPCMessagePredicateNode.$(O) \
$(OUTDIR_SLASH)PPCNegateNode.$(O) \
$(OUTDIR_SLASH)PPCNotCharSetPredicateNode.$(O) \
$(OUTDIR_SLASH)PPCNotLiteralNode.$(O) \
$(OUTDIR_SLASH)PPCNotMessagePredicateNode.$(O) \
$(OUTDIR_SLASH)PPCNotNode.$(O) \
+ $(OUTDIR_SLASH)PPCOptimizingVisitor.$(O) \
$(OUTDIR_SLASH)PPCOptionalNode.$(O) \
$(OUTDIR_SLASH)PPCPlusNode.$(O) \
$(OUTDIR_SLASH)PPCPredicateNode.$(O) \
$(OUTDIR_SLASH)PPCSentinelNode.$(O) \
$(OUTDIR_SLASH)PPCSequenceNode.$(O) \
$(OUTDIR_SLASH)PPCStarNode.$(O) \
+ $(OUTDIR_SLASH)PPCTokenConsumeNode.$(O) \
+ $(OUTDIR_SLASH)PPCTokenDetector.$(O) \
$(OUTDIR_SLASH)PPCTokenNode.$(O) \
+ $(OUTDIR_SLASH)PPCTokenVisitor.$(O) \
+ $(OUTDIR_SLASH)PPCTokenizingCodeGenerator.$(O) \
$(OUTDIR_SLASH)PPCTrimNode.$(O) \
$(OUTDIR_SLASH)PPCTrimmingTokenNode.$(O) \
$(OUTDIR_SLASH)PPCActionNode.$(O) \
- $(OUTDIR_SLASH)PPCInlineCharSetPredicateNode.$(O) \
- $(OUTDIR_SLASH)PPCInlineLiteralNode.$(O) \
- $(OUTDIR_SLASH)PPCInlineMessagePredicateNode.$(O) \
- $(OUTDIR_SLASH)PPCInlineNotCharSetPredicateNode.$(O) \
- $(OUTDIR_SLASH)PPCInlineNotLiteralNode.$(O) \
- $(OUTDIR_SLASH)PPCInlineNotMessagePredicateNode.$(O) \
+ $(OUTDIR_SLASH)PPCLLChoiceNode.$(O) \
$(OUTDIR_SLASH)PPCStarAnyNode.$(O) \
$(OUTDIR_SLASH)PPCStarCharSetPredicateNode.$(O) \
$(OUTDIR_SLASH)PPCStarMessagePredicateNode.$(O) \
$(OUTDIR_SLASH)PPCSymbolActionNode.$(O) \
$(OUTDIR_SLASH)PPCTokenSequenceNode.$(O) \
- $(OUTDIR_SLASH)PPCTokenActionNode.$(O) \
$(OUTDIR_SLASH)PPCTokenStarMessagePredicateNode.$(O) \
- $(OUTDIR_SLASH)PPCInlineTokenStarMessagePredicateNode.$(O) \
$(OUTDIR_SLASH)PPCTokenStarSeparatorNode.$(O) \
- $(OUTDIR_SLASH)PPCInlineTokenStarSeparatorNode.$(O) \
$(OUTDIR_SLASH)extensions.$(O) \
--- a/compiler/PPCAbstractActionNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCAbstractActionNode.st Fri May 01 14:04:37 2015 +0200
@@ -20,9 +20,7 @@
block: anObject
block := anObject
-! !
-
-!PPCAbstractActionNode methodsFor:'as yet unclassified'!
+!
prefix
^ #action
--- a/compiler/PPCAbstractCharacterNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCAbstractCharacterNode.st Fri May 01 14:04:37 2015 +0200
@@ -12,10 +12,6 @@
!PPCAbstractCharacterNode methodsFor:'accessing'!
-acceptsEpsilon
- ^ false
-!
-
character
^ character
!
@@ -30,6 +26,10 @@
!PPCAbstractCharacterNode methodsFor:'analysis'!
+acceptsEpsilon
+ ^ false
+!
+
firstCharSet
^ PPCharSetPredicate on: [:e | e = character ]
! !
@@ -62,18 +62,6 @@
compiler add: 'ifFalse: [ self error: ''', character asInteger asString, ' expected'' at: context position ] '.
compiler add: 'ifTrue: [ context next ].'.
compiler dedent.
-!
-
-compileWith: compiler effect: effect id: id
- self start: compiler id: id.
- self body: compiler.
- ^ self stop: compiler.
-!
-
-compileWith: compiler id: id
- self start: compiler.
- self body: compiler.
- ^ compiler stopMethod.
! !
!PPCAbstractCharacterNode class methodsFor:'documentation'!
--- a/compiler/PPCAbstractLiteralNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCAbstractLiteralNode.st Fri May 01 14:04:37 2015 +0200
@@ -11,16 +11,6 @@
!PPCAbstractLiteralNode methodsFor:'accessing'!
-acceptsEpsilon
- ^ literal size = 0
-!
-
-firstCharSet
- | letter |
- letter := literal first.
- ^ PPCharSetPredicate on: [:e | e = letter ]
-!
-
literal
^ literal
@@ -35,6 +25,18 @@
^ #lit
! !
+!PPCAbstractLiteralNode methodsFor:'analysis'!
+
+acceptsEpsilon
+ ^ literal size = 0
+!
+
+firstCharSet
+ | letter |
+ letter := literal first.
+ ^ PPCharSetPredicate on: [:e | e = letter ]
+! !
+
!PPCAbstractLiteralNode methodsFor:'comparison'!
= anotherNode
--- a/compiler/PPCAbstractPredicateNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCAbstractPredicateNode.st Fri May 01 14:04:37 2015 +0200
@@ -35,7 +35,7 @@
^ PPCharSetPredicate on: predicate
! !
-!PPCAbstractPredicateNode methodsFor:'comparison'!
+!PPCAbstractPredicateNode methodsFor:'comparing'!
= anotherNode
super = anotherNode ifFalse: [ ^ false ].
@@ -48,30 +48,7 @@
!PPCAbstractPredicateNode methodsFor:'compiling'!
-bodyOfPredicate: compiler
- self subclassResponsibility
-!
-
-compileWith: compiler effect: effect id: id
- compiler startMethod: id.
- compiler add: '^'.
- self bodyOfPredicate: compiler.
- ^ compiler stopMethod.
-!
-
extendClassification: classification
^ (classification asOrderedCollection addLast: false; yourself) asArray
! !
-!PPCAbstractPredicateNode methodsFor:'initialization'!
-
-initialize
- super initialize.
-! !
-
-!PPCAbstractPredicateNode methodsFor:'optimizing'!
-
-asInlined
- ^ super asInlined
-! !
-
--- a/compiler/PPCActionNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCActionNode.st Fri May 01 14:04:37 2015 +0200
@@ -9,47 +9,9 @@
category:'PetitCompiler-Nodes'
!
-!PPCActionNode methodsFor:'as yet unclassified'!
-
-asFast
- ^ PPCTokenActionNode new
- child: child;
- properties: properties;
- name: self name;
- yourself
-!
+!PPCActionNode methodsFor:'visiting'!
-compileWith: compiler effect: effect id: id
- | |
- compiler addConstant: block as: id.
-
- compiler startMethod: id.
- compiler addVariable: 'element'.
- compiler add: 'element := '.
- compiler callOnLine: (child compileWith: compiler).
- compiler add: 'error ifFalse: [ ^ ', id, ' value: element ].'.
- compiler add: '^ failure'.
- ^ compiler stopMethod.
-!
-
-rewrite: changeStatus
- (self hasProperty: #trimmingToken) ifTrue: [
- changeStatus change.
- ^ PPCTrimmingTokenNode new
- name: name;
- child: child children second child; "Oups, what a chain"
- tokenClass: child children second tokenClass;
- whitespace: child children first;
- yourself
- ].
-
- block isSymbol ifTrue: [
- changeStatus change.
- ^ PPCSymbolActionNode new
- block: block;
- name: name;
- child: child;
- yourself
- ]
+accept: visitor
+ ^ visitor visitActionNode: self
! !
--- a/compiler/PPCAndNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCAndNode.st Fri May 01 14:04:37 2015 +0200
@@ -9,24 +9,15 @@
category:'PetitCompiler-Nodes'
!
-!PPCAndNode methodsFor:'as yet unclassified'!
-
-compileWith: compiler effect: effect id: id
-
- compiler startMethod: id.
- compiler addVariable: 'memento'.
- compiler addVariable: 'retval'.
- compiler add: (compiler smartRemember: child).
-
- compiler add: 'retval :='.
- compiler callOnLine: (child compileWith: compiler).
- compiler add: (compiler smartRestore: child).
-
- compiler add: '^ retval'.
- ^ compiler stopMethod.
-!
+!PPCAndNode methodsFor:'accessing'!
prefix
^ #and
! !
+!PPCAndNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitAndNode: self
+! !
+
--- a/compiler/PPCAnyNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCAnyNode.st Fri May 01 14:04:37 2015 +0200
@@ -10,30 +10,26 @@
!
-!PPCAnyNode methodsFor:'as yet unclassified'!
+!PPCAnyNode methodsFor:'accessing'!
+
+prefix
+ ^ #any
+! !
+
+!PPCAnyNode methodsFor:'analysis'!
acceptsEpsilon
^ false
!
-asInlined
- ^ PPCInlineAnyNode new
- name: name;
- yourself
-!
-
-compileWith: compiler effect: effect id: id
- compiler startMethod: id.
- compiler add: '^ context next ifNil: [ error := true. ].'.
- ^ compiler stopMethod.
-!
-
firstCharSet
^ PPCharSetPredicate on: [:e | true ]
-!
+! !
-prefix
- ^ #any
+!PPCAnyNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitAnyNode: self
! !
!PPCAnyNode class methodsFor:'documentation'!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCArguments.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,110 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCArguments
+ instanceVariableNames:'arguments'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Core'
+!
+
+!PPCArguments class methodsFor:'as yet unclassified'!
+
+default
+ ^ self new
+!
+
+new
+ ^ self basicNew
+ initialize;
+ yourself
+! !
+
+!PPCArguments methodsFor:'accessing'!
+
+debug
+ ^ self at: #debug ifAbsent: true
+!
+
+debug: value
+ self set: #debug to: value.
+!
+
+generate
+ ^ self at: #generate ifAbsent: true
+!
+
+guards
+ ^ self at: #guards ifAbsent: true
+!
+
+guards: value
+ self set: #guards to: value.
+!
+
+inline
+ ^ self at: #inline ifAbsent: true
+!
+
+inline: value
+ self set: #inline to: value.
+!
+
+merge
+ ^ self at: #merge ifAbsent: true
+!
+
+merge: value
+ self set: #merge to: value.
+!
+
+name
+ ^ self at: #name ifAbsent: #PPGeneratedParser
+!
+
+name: value
+ self set: #name to: value.
+!
+
+profile
+ ^ self at: #profile ifAbsent: false
+!
+
+profile: value
+ self set: #profile to: value.
+!
+
+specialize
+ ^ self at: #specialize ifAbsent: true
+!
+
+specialize: value
+ self set: #specialize to: value.
+!
+
+tokenize
+ ^ self at: #tokenize ifAbsent: true
+!
+
+tokenize: value
+ self set: #tokenize to: value.
+! !
+
+!PPCArguments methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ arguments := IdentityDictionary new
+! !
+
+!PPCArguments methodsFor:'private'!
+
+at: symbol ifAbsent: defaultValue
+ ^ arguments at: symbol ifAbsent: [ ^ defaultValue ]
+!
+
+set: symbol to: defaultValue
+ ^ arguments at: symbol put: defaultValue
+! !
+
--- a/compiler/PPCCharSetPredicateNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCCharSetPredicateNode.st Fri May 01 14:04:37 2015 +0200
@@ -11,26 +11,6 @@
!PPCCharSetPredicateNode methodsFor:'as yet unclassified'!
-asInlined
- ^ PPCInlineCharSetPredicateNode new
- predicate: predicate;
- name: name;
- yourself
-!
-
-bodyOfPredicate: compiler
- | classification classificationId |
- classification := self extendClassification: 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: [ context next ].'.
- compiler dedent.
-!
-
start: compiler id: id
compiler startMethod: id
!
@@ -39,3 +19,9 @@
^ compiler stopMethod
! !
+!PPCCharSetPredicateNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitCharSetPredicateNode: self
+! !
+
--- a/compiler/PPCCharacterNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCCharacterNode.st Fri May 01 14:04:37 2015 +0200
@@ -20,12 +20,9 @@
^ compiler stopMethod
! !
-!PPCCharacterNode methodsFor:'optimizing'!
+!PPCCharacterNode methodsFor:'visiting'!
-asInlined
- ^ PPCInlineCharacterNode new
- character: character;
- name: name;
- yourself
+accept: visitor
+ ^ visitor visitCharacterNode: self
! !
--- a/compiler/PPCChoiceNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCChoiceNode.st Fri May 01 14:04:37 2015 +0200
@@ -9,7 +9,13 @@
category:'PetitCompiler-Nodes'
!
-!PPCChoiceNode methodsFor:'as yet unclassified'!
+!PPCChoiceNode methodsFor:'accessing'!
+
+prefix
+ ^ #ch
+! !
+
+!PPCChoiceNode methodsFor:'analysis'!
acceptsEpsilon
^ self acceptsEpsilonOpenSet: IdentitySet new.
@@ -18,52 +24,11 @@
acceptsEpsilonOpenSet: set
set add: self.
^ self children anySatisfy: [:e | e acceptsEpsilonOpenSet: set ].
-!
-
-compileWith: compiler effect: effect id: id
- | firsts guard whitespaceConsumed |
-
- whitespaceConsumed := false.
- firsts := (self firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]).
-
- compiler startMethod: id.
- compiler addVariable: 'element'.
-
- "If we start with trimming token, we should invoke the whitespace parser"
- (firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [
- firsts anyOne compileWhitespace: compiler.
- whitespaceConsumed := true.
- ].
-
- (1 to: children size) do: [ :idx | |child allowGuard |
- child := children at: idx.
-" allowGuard := ((child isKindOf: PPCTrimmingTokenNode) and: [ whitespaceConsumed not ]) not.
-"
- allowGuard := whitespaceConsumed.
-
- (allowGuard and: [compiler 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 add: 'element := '.
- compiler callOnLine: (child compileWith: compiler).
- compiler add: 'error ifFalse: [ ^ element ].'.
- compiler dedent.
- compiler add: ' ].'.
- ] ifFalse: [
- compiler add: 'self clearError.'.
- compiler add: 'element := '.
- compiler callOnLine: (child compileWith: compiler).
- compiler add: 'error ifFalse: [ ^ element ].'.
- ]
- ].
- compiler add: '^ self error: ''no choice suitable'''.
- ^ compiler stopMethod.
-!
-
-prefix
- ^ #ch
! !
+!PPCChoiceNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitChoiceNode: self
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCCodeGenerator.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,680 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCNodeVisitor subclass:#PPCCodeGenerator
+ instanceVariableNames:'compiler'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Visitors'
+!
+
+!PPCCodeGenerator class methodsFor:'as yet unclassified'!
+
+on: aPPCCompiler
+ ^ self new
+ compiler: aPPCCompiler;
+ yourself
+! !
+
+!PPCCodeGenerator methodsFor:'accessing'!
+
+compiler: aPPCCompiler
+ compiler := aPPCCompiler
+! !
+
+!PPCCodeGenerator methodsFor:'hooks'!
+
+afterAccept: node retval: retval
+ "return the method from compiler"
+ ^ self stopMethodForNode: node.
+!
+
+beforeAccept: node
+ self startMethodForNode: node
+!
+
+closedDetected: node
+ ^ node isMarkedForInline ifFalse: [
+ self error: 'Should not happen!!'
+ ]
+!
+
+openDetected: 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].
+
+ id := compiler idFor: node.
+ firsts := (node 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"
+ 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 ].'
+ ].
+!
+
+compileTokenWhitespace: node
+ 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.
+!
+
+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.
+!
+
+predicateBody: node
+ | 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.
+!
+
+retvalVar
+ ^ compiler currentReturnVariable
+!
+
+startMethodForNode:node
+ node isMarkedForInline ifTrue:[
+ compiler startInline: (compiler idFor: node).
+ compiler addComment: 'BEGIN inlined code of ' , node printString.
+ compiler indent.
+ ] ifFalse:[
+ compiler startMethod: (compiler idFor: node).
+ compiler addComment: 'GENERATED by ' , node printString.
+ compiler allocateReturnVariable.
+ ].
+
+ "Created: / 23-04-2015 / 15:51:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 23-04-2015 / 19:13:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 23-04-2015 / 21:31:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+stopMethodForNode:aPPCNode
+ ^ aPPCNode isMarkedForInline ifTrue:[
+ compiler dedent.
+ compiler add: '"END inlined code of ' , aPPCNode printString , '"'.
+ compiler stopInline.
+ ] ifFalse:[
+ compiler stopMethod
+ ].
+
+ "Created: / 23-04-2015 / 15:51:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 23-04-2015 / 18:35:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCodeGenerator methodsFor:'traversing - caching'!
+
+cache: node value: retval
+ "this is compiler thing, not mine"
+!
+
+cachedDetected: node
+ ^ compiler checkCache: (compiler idFor: node)
+!
+
+isCached: node
+ ^ (compiler checkCache: (compiler idFor: node)) isNil not
+! !
+
+!PPCCodeGenerator methodsFor:'visiting'!
+
+visitActionNode: node
+ compiler addConstant: node block as: (compiler idFor: node).
+
+ compiler addVariable: 'element'.
+ compiler add: 'element := '.
+ compiler callOnLine: (self visit: node child).
+ compiler add: 'error ifFalse: [ ^ ', (compiler idFor: node), ' value: element ].'.
+ compiler add: '^ failure'.
+
+ "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).
+
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
+ compiler add: (compiler smartRestore: node child from: mementoVar).
+
+ 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. ].'.
+
+ "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.
+!
+
+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.
+!
+
+visitChild: child of: node
+ | |
+
+ (self isOpen: child) ifTrue: [
+ "already processing..."
+ ^ nil
+ ].
+
+ "TODO JK: this is is wrong,.. to tired now to fix this :("
+" (self isCached: child) ifTrue: [
+ node replace: child with: (self cachedValue: child).
+ ^ nil
+ ].
+"
+ ^ self visit: child.
+!
+
+visitChoiceNode: node
+ | firsts guard whitespaceConsumed |
+
+
+ whitespaceConsumed := false.
+ firsts := (node firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]).
+
+
+ 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.
+ ].
+
+ 1 to: node children size do: [ :idx | |child allowGuard |
+ child := node children at: idx.
+" allowGuard := ((child isKindOf: PPCTrimmingTokenNode) and: [ whitespaceConsumed not ]) not.
+"
+ 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'''.
+
+ "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!!'' ].'.
+!
+
+visitForwardNode: node
+
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
+ compiler codeReturn.
+!
+
+visitLiteralNode: node
+ | 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: '].'.
+!
+
+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: '].'.
+
+ "Modified: / 23-04-2015 / 18:39:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+visitNilNode: node
+
+ 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.
+!
+
+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.
+!
+
+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.
+!
+
+visitNotNode: node
+
+
+ compiler addVariable: 'memento'.
+ compiler add: (compiler smartRemember: node child).
+
+ compiler call: (self visit: node child).
+ compiler add: (compiler smartRestore: node child).
+
+ 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.
+!
+
+visitPluggableNode: node
+ | blockId |
+ blockId := compiler idFor: node block prefixed: #block.
+
+ compiler addConstant: node block as: blockId.
+ compiler codeReturn: blockId, ' value: context.'.
+!
+
+visitPlusNode: node
+ | elementVar |
+
+ elementVar := compiler allocateTemporaryVariableNamed: 'element'.
+
+ 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 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).
+
+ 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.
+
+ "Modified: / 23-04-2015 / 21:48:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+visitSequenceNode: node
+
+ | elementVar mementoVar |
+
+ 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.
+
+ 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
+
+ "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'.
+
+!
+
+visitStarCharSetPredicateNode: node
+ | 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: '].'.
+ 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 codeReturn: 'retval asArray'.
+!
+
+visitStarNode: node
+ | 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'.
+!
+
+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: ']'.
+!
+
+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.
+ "
+
+ 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 ].'.
+ ].
+!
+
+visitTokenStarMessagePredicateNode: node
+
+ 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.'.
+!
+
+visitTrimNode: node
+ | mementoVar |
+ "TODO: This ignores the TrimmingParser trimmer object!!"
+
+ mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
+
+ compiler add: (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: '].'.
+!
+
+visitTrimmingTokenNode: node
+ | id guard startVar endVar |
+
+ startVar := compiler allocateTemporaryVariableNamed: 'start'.
+ endVar := compiler allocateTemporaryVariableNamed: 'end'.
+
+ id := compiler idFor: node.
+" (id beginsWith: 'kw') ifTrue: [ self halt. ]."
+ "self compileFirstWhitespace: compiler."
+ self compileTokenWhitespace: node.
+
+ (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.
+ compiler add: 'error ifFalse: [ '.
+ compiler indent.
+ compiler codeAssign: 'context position.' to: endVar.
+
+" self compileSecondWhitespace: compiler."
+ self compileTokenWhitespace: node.
+
+ compiler codeReturn: node tokenClass asString, ' on: (context collection)
+ start: ', startVar, '
+ stop: ', endVar, '
+ value: nil'.
+ compiler dedent.
+ compiler add: '].'
+!
+
+visitUnknownNode: node
+ | 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.
+! !
+
--- a/compiler/PPCCompiledMethod.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCCompiledMethod.st Fri May 01 14:04:37 2015 +0200
@@ -3,12 +3,13 @@
"{ NameSpace: Smalltalk }"
Object subclass:#PPCCompiledMethod
- instanceVariableNames:'code id'
+ instanceVariableNames:'id'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Core'
!
+
!PPCCompiledMethod methodsFor:'as yet unclassified'!
call
@@ -23,3 +24,9 @@
^ id
! !
+!PPCCompiledMethod class methodsFor:'documentation'!
+
+version_MC
+ ^ 'PetitCompiler-JanVrany.stx.85 147209f0-e9c3-11e4-944c-606720e43e2c 2015-04-23T15:14:39+01 JanVrany'
+! !
+
--- a/compiler/PPCCompiler.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCCompiler.st Fri May 01 14:04:37 2015 +0200
@@ -3,8 +3,8 @@
"{ NameSpace: Smalltalk }"
Object subclass:#PPCCompiler
- instanceVariableNames:'compilerStack compiledParser cache inlining debug profile
- currentMethod guards ids tokenMode rootNode'
+ instanceVariableNames:'compilerStack compiledParser cache currentMethod ids rootNode
+ constants compiledParserName returnVariable arguments'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Core'
@@ -16,37 +16,47 @@
new
"return an initialized instance"
- ^ self basicNew initialize.
+ ^ self basicNew initializeForCompiledClassName: 'PPGeneratedParser'
+!
+
+newForCompiledClassName: aString
+ "return an initialized instance"
+ self halt: 'deprecated'.
+ ^ self basicNew initializeForCompiledClassName: aString
+!
+
+on: aPPCArguments
+ "return an initialized instance"
+
+ ^ self basicNew
+ arguments: aPPCArguments;
+ initializeForCompiledClassName: aPPCArguments name
! !
!PPCCompiler methodsFor:'accessing'!
-inlining
- ^ inlining
+arguments: args
+ arguments := args
!
-inlining: value
- inlining := value
+compiledParser
+ ^ compiledParser
!
-parameters: associations
- | key value |
- associations do: [ :ass |
- key := ass key.
- value := ass value.
-
- (key = #profile) ifTrue: [ profile := value ].
- (key = #inline) ifTrue: [ inlining := value ].
- (key = #guards) ifTrue: [ guards := value ].
- ]
+currentNonInlineMethod
+ ^ 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>"
!
-profile
- ^ profile
+currentReturnVariable
+ ^ currentMethod returnVariable
!
-profile: aBoolean
- profile := aBoolean
+ids
+ ^ ids
!
rootNode
@@ -60,7 +70,6 @@
[
" self cleanGeneratedMethods: class.
self cleanInstVars: class.
- self cleanParsers: class.
self cleanConstants: class.
" ] timeToRun asMilliSeconds asString, 'ms'."
!
@@ -101,7 +110,7 @@
!
addConstant: value as: name
- compiledParser addConstant: value as: name.
+ constants at: name put: value
!
addOnLine: string
@@ -109,7 +118,9 @@
!
addVariable: name
- currentMethod addVariable: name.
+ ^ self currentNonInlineMethod addVariable: name
+
+ "Modified: / 23-04-2015 / 17:34:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
call: anotherMethod
@@ -133,6 +144,7 @@
!
smartRemember: parser
+ self flag: 'deprecated'.
^ self smartRemember: parser to: #memento
!
@@ -144,6 +156,7 @@
!
smartRestore: parser
+ self flag: 'deprecated'.
^ self smartRestore: parser from: #memento
!
@@ -154,8 +167,86 @@
^ '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.
+ ] ifTrue: [
+ "In case code hava a side effect"
+ self add: code
+ ]
+!
+
+codeClearError
+ self add: 'self clearError.'.
+!
+
+codeError: errorMessage
+ self add: 'self error: ''', errorMessage, '''.'
+!
+
+codeHalt
+ self add: 'self halt. '
+!
+
+codeReturn
+ currentMethod isInline ifTrue: [
+ "If inlined, the return variable already holds the value"
+ ] ifFalse: [
+ self add: '^ ', currentMethod returnVariable
+ ].
+
+ "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: code
+ " - returns whatever is in code OR
+ - assigns whatever is in code into the returnVariable"
+ currentMethod isInline ifTrue:[
+ self codeAssign: code to: currentMethod returnVariable.
+ ] ifFalse: [
+ 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>"
+! !
+
!PPCCompiler methodsFor:'code generation - ids'!
+idFor: object
+ 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
!
@@ -165,27 +256,21 @@
!
idFor: object prefixed: prefix suffixed: suffix effect: effect
- | body id |
-
- "Halt if: [ (object isKindOf: PPCNode) and: [object name = #smalltalk_ws ] ]."
-
-" ((object isKindOf: PPCNode) and: [object name = #smalltalk_ws ]) ifTrue: [ Transcript crShow: 'st_ws' ].
-"
+ | name id |
^ ids at: object ifAbsentPut: [
((object isKindOf: PPCNode) and: [object name isNotNil]) ifTrue: [
- "Halt if: [ object name = #smalltalk_ws ]."
-" (object name = #smalltalk_ws) ifTrue: [Transcript crShow: 'NEW st_ws'].
-"
- id := (object name, suffix) asSymbol.
+ "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 values select: [ :e | e = id ]) isEmpty) ifTrue: [ id ]
- ifFalse: [
- body := ids size asString.
- (id, '_', body) asSymbol
+ (ids includes: id) ifTrue: [
+ (id, '_', ids size asString) asSymbol
+ ] ifFalse: [
+ id
]
] ifFalse: [
- body := ids size asString.
- (prefix asString, '_', body, suffix) asSymbol
+ (prefix, '_', (ids size asString), suffix) asSymbol
]
]
! !
@@ -203,17 +288,19 @@
checkCache: id
| method |
"Check if method is hand written"
- method := compiledParser compiledMethodAt: id ifAbsent: [ nil ].
+ method := compiledParser ifNotNil: [ compiledParser compiledMethodAt: id ifAbsent: [ nil ] ].
method ifNotNil: [ ^ PPCCompiledMethod new id: id; yourself ].
^ self cachedValue: id
!
pop
- | retval |
- retval := compilerStack pop.
- compilerStack isEmpty ifFalse: [ currentMethod := 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>"
!
@@ -226,120 +313,77 @@
!
startInline: id
- | sender |
-
+ (cache includesKey: id) ifTrue: [ self error: 'OOOUPS!!' ].
+
currentMethod := PPCInlinedMethod new.
- currentMethod id: id.
- currentMethod profile: self profile.
+ currentMethod id: id.
+ currentMethod profile: arguments profile.
+ currentMethod returnVariable: returnVariable.
self push.
-
-
- sender := thisContext sender receiver.
- self addComment: 'START inlining by ', sender asString.
+
+ "Modified: / 23-04-2015 / 18:28:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
startMethod: id
- | sender |
(cache includesKey: id) ifTrue: [ self error: 'OOOUPS!!' ].
-
+
currentMethod := PPCMethod new.
currentMethod id: id.
- currentMethod profile: self profile.
- self push.
-
+ currentMethod profile: arguments profile.
+ self push.
+
self cache: id as: currentMethod.
-
- sender := thisContext sender receiver.
- self addComment: 'START of method generated by ', sender asString.
+
+ "Modified: / 23-04-2015 / 18:36:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
stopInline
- | sender |
- sender := thisContext sender receiver.
- self addComment: 'STOP inlining by ', sender asString.
+
^ self pop.
+
+ "Modified: / 23-04-2015 / 18:28:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
stopMethod
- | sender |
- sender := thisContext sender receiver.
- self addComment: 'END of method generated by ', sender asString.
+ self cache: currentMethod methodName as: currentMethod.
+
+ arguments profile ifTrue: [ Transcript crShow: currentMethod code ].
+ ^ self pop.
- self cache: currentMethod methodName as: currentMethod.
- ^ self pop.
+ "Modified: / 23-04-2015 / 18:36:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
top
^ compilerStack top
! !
-!PPCCompiler methodsFor:'compiling'!
+!PPCCompiler methodsFor:'code generation - variables'!
-compile: aPPParser as: name
- ^ self compile: aPPParser as: name params: #()
-!
+allocateReturnVariable
+ "Return a new variable to store parsed value"
-compile: aPPParser as: name params: params
- | parser |
- parser := self copy: aPPParser.
- parser := self toCompilerTree: parser.
- parser := self optimize: parser params: params.
- parser := self compileTree: parser as: name parser: aPPParser params: params.
- ^ parser
-
+ ^ currentMethod allocateReturnVariable
+
+ "Created: / 23-04-2015 / 17:58:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 23-04-2015 / 21:12:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-compileTree: compilerTree as: name parser: parser params: params
- | |
- params do: [ :p |
- (p key = #guards) ifTrue: [ self guards: p value ].
- ].
-
-
- ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
- | rPackageOrganizer |
- rPackageOrganizer := Smalltalk at: #RPackageOrganizer.
- rPackageOrganizer notNil ifTrue:[
- rPackageOrganizer default registerPackageNamed: 'PetitCompiler-Generated'.
- ].
+allocateTemporaryVariableNamed: preferredName
+ "Allocate a new variable with (preferably) given name.
+ Returns a real variable name that should be used."
+
+ ^ self currentNonInlineMethod allocateTemporaryVariableNamed: preferredName
- compiledParser := (Smalltalk at: name ifAbsent: [ nil ]).
- compiledParser ifNil: [
- PPCompiledParser subclass: name
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Generated'.
- compiledParser := Smalltalk at: name.
- ] ifNotNil: [
- self clean: compiledParser
- ].
- ] ifFalse: [
- RPackageOrganizer default registerPackageNamed: 'PetitCompiler-Generated'.
- compiledParser := (Smalltalk at: name ifAbsent: [ nil ]).
- compiledParser ifNil: [
- PPCompiledParser subclass: name.
- compiledParser := Smalltalk at: name.
- compiledParser category: 'PetitCompiler-Generated'
- ] ifNotNil: [
- self clean: compiledParser
- ].
- ].
- compiledParser constants removeAll.
-
- rootNode := compilerTree.
- self precomputeFirstSets: rootNode.
- self precomputeFollowSets: rootNode.
- self precomputeFollowSetsWithTokens: rootNode.
-
- self startMethod: #start.
- self add: '^ '.
- self callOnLine: (compilerTree compileWith: self).
- self stopMethod.
+ "Created: / 23-04-2015 / 17:33:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCompiler methodsFor:'compiling'!
- self installVariablesAndMethods.
+compileParser
+ self installVariables.
+ self installMethods.
+ self installClassConstants.
- compiledParser referringParser: parser.
^ compiledParser
!
@@ -347,46 +391,30 @@
^ parser transform: [ :p | p copy ].
!
-installMethods: class
+installClassConstants
+ constants keysAndValuesDo: [ :key :value |
+ compiledParser constants at: key put: value
+ ]
+!
+
+installMethods
cache keysAndValuesDo: [ :key :method |
- class compileSilently: method code classified: 'generated'.
+ compiledParser compileSilently: method code classified: 'generated'.
]
!
-installMethodsAndVariables: class
- self installVariables: class.
- self installMethods: class.
-
-!
-
-installVariables: class
- | string |
- string := class constants keys inject: '' into: [:r :e | r, ' ', e ].
- PPCompiledParser subclass: class name instanceVariableNames: string classVariableNames: '' poolDictionaries: '' category: 'PetitCompiler-Generated'.
-!
-
-installVariablesAndMethods
- "Updates the class and compile generated code"
-
- | compiledParserClassName |
+installVariables
+ | varString |
+ varString := constants keys inject: '' into: [:r :e | r, ' ', e ].
- compiledParserClassName := compiledParser name.
- self installVariables: compiledParser.
- "Now we have to refetch the class again. The reason is, that
- in (at least) Smalltalk/X modyfing a layout of a class results
- in creating a new class rather than updating an old one and migrating
- instances. Therefore, to install methods in in correct class, we have
- to refetch new version from system dictionary. On Pharo it should not harm."
- compiledParser := Smalltalk at: compiledParserClassName.
+ PPCompiledParser
+ subclass: compiledParserName
+ instanceVariableNames: varString
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'PetitCompiler-Generated'.
- self installMethods: compiledParser.
-!
-
-optimize: parser params: params
- | retval |
- retval := parser optimizeTree: params.
- retval checkTree.
- ^ retval
+ compiledParser := Smalltalk at: compiledParserName.
!
precomputeFirstSets: root
@@ -423,28 +451,33 @@
^ parser asCompilerTree
! !
-!PPCCompiler methodsFor:'guard'!
-
-guards
- ^ guards
-!
-
-guards: aBoolean
- guards := aBoolean
-! !
-
!PPCCompiler methodsFor:'initialization'!
-initialize
- super initialize.
+initializeForCompiledClassName: aString
+
+ self initialize.
compilerStack := Stack new.
cache := IdentityDictionary new.
- ids := Dictionary new.
+ constants := IdentityDictionary new.
+ ids := IdentityDictionary new.
+
+
+ compiledParserName := aString asSymbol.
- tokenMode := false.
- inlining := true.
- profile := false.
- guards := true.
+ ((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.
+ ].
! !
!PPCCompiler class methodsFor:'documentation'!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCConfiguration.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,135 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCConfiguration
+ instanceVariableNames:'arguments ir history'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Core'
+!
+
+!PPCConfiguration class methodsFor:'as yet unclassified'!
+
+default
+ ^ PPCFirstPrototype new
+!
+
+new
+ ^ self basicNew
+ initialize;
+ yourself
+! !
+
+!PPCConfiguration methodsFor:'accessing'!
+
+arguments: args
+ arguments := args
+!
+
+input: whatever
+ ir := whatever.
+ self remember: #input.
+!
+
+ir
+ ^ ir
+!
+
+ir: whatever
+ ir := whatever
+! !
+
+!PPCConfiguration methodsFor:'as yet unclassified'!
+
+compile: whatever
+ self input: whatever.
+ self invokePhases.
+ ^ ir
+!
+
+compile: whatever arguments: args
+ self arguments: args.
+ ^ self compile: whatever.
+!
+
+remember: key
+ arguments debug ifTrue: [
+ history add: key -> (ir copy).
+ ]
+! !
+
+!PPCConfiguration methodsFor:'initialization'!
+
+initialize
+ history := OrderedCollection new
+! !
+
+!PPCConfiguration methodsFor:'phases'!
+
+check
+ ir checkTree
+!
+
+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.
+!
+
+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
+!
+
+specialize
+ 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
+!
+
+toPPCIr
+ ir := ir asCompilerTree.
+ self remember: #ppcNodes
+!
+
+tokenize
+ arguments tokenize ifFalse: [ ^ self ] .
+
+ ir := PPCTokenDetector new
+ arguments: arguments;
+ visit: ir.
+ self remember: #tokenize
+! !
+
--- a/compiler/PPCContext.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCContext.st Fri May 01 14:04:37 2015 +0200
@@ -137,17 +137,11 @@
!PPCContext methodsFor:'acessing'!
-hash
- ^ collection hash
-!
-
initializeFor: parser
+ rc := 0.
parser == root ifTrue: [ ^ self ].
root := parser.
- root allParsersDo: [ :p |
- p updateContext: self
- ]
!
root
@@ -164,32 +158,6 @@
readLimit := collection size.
! !
-!PPCContext methodsFor:'as yet unclassified'!
-
-atWs
- ^ position = ws
-!
-
-goUpTo: char
- [ position < readLimit ] whileTrue: [
- (collection at: position + 1) = char ifTrue: [ position := position + 1. ^ char ] .
- position := position + 1.
- ]
-
-!
-
-setWs
- ^ ws := position
-!
-
-ws
- ^ ws
-!
-
-ws: anInteger
- ws := anInteger
-! !
-
!PPCContext methodsFor:'converting'!
asCompiledParserContext
@@ -284,6 +252,32 @@
]
! !
+!PPCContext methodsFor:'whitespace'!
+
+atWs
+ ^ position = ws
+!
+
+goUpTo: char
+ [ position < readLimit ] whileTrue: [
+ (collection at: position + 1) == char ifTrue: [ position := position + 1. ^ char ] .
+ position := position + 1.
+ ]
+
+!
+
+setWs
+ ^ ws := position
+!
+
+ws
+ ^ ws
+!
+
+ws: anInteger
+ ws := anInteger
+! !
+
!PPCContext class methodsFor:'documentation'!
version_HG
--- a/compiler/PPCContextMemento.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCContextMemento.st Fri May 01 14:04:37 2015 +0200
@@ -44,16 +44,14 @@
!
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
- ifTrue: [ ^ aBlock value ]
- 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>"
!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCCopyVisitor.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,20 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCRewritingVisitor subclass:#PPCCopyVisitor
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Visitors'
+!
+
+!PPCCopyVisitor methodsFor:'as yet unclassified'!
+
+visitNode: node
+ | newNode |
+ self change.
+ newNode := node copy.
+ ^ super visitNode: newNode.
+! !
+
--- a/compiler/PPCDelegateNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCDelegateNode.st Fri May 01 14:04:37 2015 +0200
@@ -38,17 +38,6 @@
^ false
! !
-!PPCDelegateNode methodsFor:'optimizing'!
-
-inline: changeStatus
- | inlinedNode |
- inlinedNode := child asInlined.
- (inlinedNode ~= child) ifTrue: [
- changeStatus change.
- self replace: child with: inlinedNode.
- ]
-! !
-
!PPCDelegateNode methodsFor:'transformation'!
replace: node with: anotherNode
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCEndOfFileNode.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,23 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCNode subclass:#PPCEndOfFileNode
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Nodes'
+!
+
+!PPCEndOfFileNode methodsFor:'accessing'!
+
+prefix
+ ^ #eof
+! !
+
+!PPCEndOfFileNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitEndOfFileNode: self.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCFirstPrototype.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,24 @@
+"{ 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 Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCForwardNode.st Fri May 01 14:04:37 2015 +0200
@@ -9,34 +9,24 @@
category:'PetitCompiler-Nodes'
!
-!PPCForwardNode methodsFor:'compiling'!
-
-check
- ^ (child name = self name and: [child suffix = self suffix]) ifTrue: [ 'referring to itself!!' ]
-!
-
-compileWith: compiler effect: effect id: id
- compiler startMethod: id.
- compiler add: '^ '.
- "child name = 'keyword' ifTrue: [ self halt ]."
- compiler callOnLine: (child compileWith: compiler).
- ^ compiler stopMethod.
-!
+!PPCForwardNode methodsFor:'accessing'!
prefix
^ #fw
-!
-
-rewrite: changeStatus
- child name ifNil: [
- changeStatus change.
- child name: self name.
- ^ child
- ].
-
- (child name = self name) ifTrue: [
- changeStatus change.
- ^ child
- ]
! !
+!PPCForwardNode methodsFor:'analysis'!
+
+check
+ ^ (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
+! !
+
--- a/compiler/PPCGuard.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCGuard.st Fri May 01 14:04:37 2015 +0200
@@ -3,7 +3,7 @@
"{ NameSpace: Smalltalk }"
Object subclass:#PPCGuard
- instanceVariableNames:'node classification id message'
+ instanceVariableNames:'classification id message'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Core'
@@ -81,13 +81,12 @@
compiler add: '(context peek ', message, ')'
!
-initializeFor: aPPCNode
- node := aPPCNode.
+initializeFor: node
message := #unknown.
id := nil.
"No Guards for trimming parser so far"
- ((node firstSetSuchThat: [ :e | e isKindOf: PPCTrimNode ]) isEmpty not) ifTrue: [
+ ((node firstSetSuchThat: [ :e | e isKindOf: PPCTrimNode ]) isEmpty) ifFalse: [
^ self initializeForNoGuard
].
(node acceptsEpsilon) ifTrue: [
--- a/compiler/PPCInlineAnyNode.st Fri May 01 13:44:43 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,28 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCAnyNode subclass:#PPCInlineAnyNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-!PPCInlineAnyNode methodsFor:'as yet unclassified'!
-
-asInlined
- ^ self
-!
-
-compileWith: compiler effect: effect id: id
- compiler startInline: id.
- compiler add: 'context next ifNil: [ error := true. ].'.
- ^ compiler stopInline.
-!
-
-printOn: aStream
- aStream nextPutAll: #inlined.
- super printOn: aStream.
-! !
-
--- a/compiler/PPCInlineCharSetPredicateNode.st Fri May 01 13:44:43 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,24 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCCharSetPredicateNode subclass:#PPCInlineCharSetPredicateNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-!PPCInlineCharSetPredicateNode methodsFor:'as yet unclassified'!
-
-asInlined
- ^ self
-!
-
-compileWith: compiler effect: effect id: id
- compiler startInline: id.
- compiler add: ''.
- self bodyOfPredicate: compiler.
- ^ compiler stopInline.
-! !
-
--- a/compiler/PPCInlineCharacterNode.st Fri May 01 13:44:43 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,26 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCAbstractCharacterNode subclass:#PPCInlineCharacterNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-!PPCInlineCharacterNode methodsFor:'as yet unclassified'!
-
-printOn: aStream
- aStream nextPutAll: #inlined.
- super printOn: aStream.
-!
-
-start: compiler id: id
- compiler startInline: id.
-!
-
-stop: compiler
- ^ compiler stopInline
-! !
-
--- a/compiler/PPCInlineLiteralNode.st Fri May 01 13:44:43 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,37 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCLiteralNode subclass:#PPCInlineLiteralNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-!PPCInlineLiteralNode methodsFor:'compiling'!
-
-compileWith: compiler effect: effect id: id
- | encodedLiteral |
-
- encodedLiteral := self encodeQuotes: literal.
- compiler startInline: id.
- compiler add: '((context peek: ', literal size asString, ') = #''', encodedLiteral, ''')'.
- compiler indent.
- compiler add: ' ifTrue: [ context skip: ', literal size asString, '. #''', encodedLiteral, ''']'.
- compiler add: ' ifFalse: [ self error: ''', encodedLiteral, ' expected'' ].'.
- compiler dedent.
- ^ compiler stopInline.
-! !
-
-!PPCInlineLiteralNode methodsFor:'printing'!
-
-asInlined
- ^ self
-!
-
-printOn: aStream
- aStream nextPutAll: '#inline'.
- super printOn: aStream
-! !
-
--- a/compiler/PPCInlineMessagePredicateNode.st Fri May 01 13:44:43 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,24 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCMessagePredicateNode subclass:#PPCInlineMessagePredicateNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-!PPCInlineMessagePredicateNode methodsFor:'as yet unclassified'!
-
-asInlined
- ^ self
-!
-
-compileWith: compiler effect: effect id: id
- compiler startInline: id.
- compiler add: ''.
- self bodyOfPredicate: compiler.
- ^ compiler stopInline.
-! !
-
--- a/compiler/PPCInlineNilNode.st Fri May 01 13:44:43 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,23 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCNilNode subclass:#PPCInlineNilNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-!PPCInlineNilNode methodsFor:'as yet unclassified'!
-
-asInlined
- ^ self
-!
-
-compileWith: compiler effect: effect id: id
- compiler startInline: id.
- compiler add: 'nil.'.
- ^ compiler stopInline.
-! !
-
--- a/compiler/PPCInlineNotCharSetPredicateNode.st Fri May 01 13:44:43 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,24 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCNotCharSetPredicateNode subclass:#PPCInlineNotCharSetPredicateNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-!PPCInlineNotCharSetPredicateNode methodsFor:'as yet unclassified'!
-
-asInlined
- ^ self
-!
-
-compileWith: compiler effect: effect id: id
- compiler startInline: id.
- compiler add: ''.
- self bodyOfPredicate: compiler.
- ^ compiler stopInline.
-! !
-
--- a/compiler/PPCInlineNotLiteralNode.st Fri May 01 13:44:43 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,38 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCNotLiteralNode subclass:#PPCInlineNotLiteralNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-!PPCInlineNotLiteralNode methodsFor:'as yet unclassified'!
-
-compileWith: compiler effect: effect id: id
- | encodedLiteral size |
- encodedLiteral := self encodeQuotes: literal.
- size := literal size asString.
-
- compiler startInline: id.
- compiler add: '((context peek: ', size, ') =#''', encodedLiteral, ''')'.
- compiler indent.
- compiler add: ' ifTrue: [ self error: ''', encodedLiteral, ' not expected'' ]'.
- compiler add: ' ifFalse: [ nil ].'.
- compiler dedent.
- ^ compiler stopInline.
-! !
-
-!PPCInlineNotLiteralNode methodsFor:'printing'!
-
-asInlined
- ^ self
-!
-
-printOn: aStream
- aStream nextPutAll: #inlined.
- super printOn: aStream.
-! !
-
--- a/compiler/PPCInlineNotMessagePredicateNode.st Fri May 01 13:44:43 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,24 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCNotMessagePredicateNode subclass:#PPCInlineNotMessagePredicateNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-!PPCInlineNotMessagePredicateNode methodsFor:'as yet unclassified'!
-
-asInlined
- ^ self
-!
-
-compileWith: compiler effect: effect id: id
- compiler startInline: id.
- compiler add: ''.
- self bodyOfPredicate: compiler.
- ^ compiler stopInline.
-! !
-
--- a/compiler/PPCInlinePluggableNode.st Fri May 01 13:44:43 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,23 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCPluggableNode subclass:#PPCInlinePluggableNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-!PPCInlinePluggableNode methodsFor:'as yet unclassified'!
-
-asInlined
- ^ self
-!
-
-compileWith: compiler effect: effect id: id
- compiler startInline: id.
- compiler add: block asString, ' value: context.'.
- ^ compiler stopInline.
-! !
-
--- a/compiler/PPCInlineTokenStarMessagePredicateNode.st Fri May 01 13:44:43 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,28 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCTokenStarMessagePredicateNode subclass:#PPCInlineTokenStarMessagePredicateNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-!PPCInlineTokenStarMessagePredicateNode methodsFor:'as yet unclassified'!
-
-asInlined
- ^ self
-!
-
-compileWith: compiler effect: effect id: id
- compiler startInline: id.
- compiler add: '[ context peek ', message,' ] whileTrue: ['.
- compiler indent.
- compiler add: 'context next'.
- compiler indent.
- compiler dedent.
- compiler add: '].'.
- ^ compiler stopInline.
-! !
-
--- a/compiler/PPCInlineTokenStarSeparatorNode.st Fri May 01 13:44:43 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,23 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCTokenStarSeparatorNode subclass:#PPCInlineTokenStarSeparatorNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-!PPCInlineTokenStarSeparatorNode methodsFor:'as yet unclassified'!
-
-asInlined
- ^ self
-!
-
-compileWith: compiler effect: effect id: id
- compiler startInline: id.
- compiler add: 'context skipSeparators.'.
- ^ compiler stopInline.
-! !
-
--- a/compiler/PPCInlinedMethod.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCInlinedMethod.st Fri May 01 14:04:37 2015 +0200
@@ -3,7 +3,7 @@
"{ NameSpace: Smalltalk }"
PPCMethod subclass:#PPCInlinedMethod
- instanceVariableNames:'code'
+ instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Core'
@@ -16,6 +16,24 @@
!
code
- ^ buffer contents trim
+ ^ buffer contents trimRight
+!
+
+isInline
+ ^ true
! !
+!PPCInlinedMethod methodsFor:'code generation - variables'!
+
+allocateReturnVariable
+ 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....'
+
+ "Created: / 23-04-2015 / 21:06:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCInliningVisitor.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,91 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCNodeVisitor subclass:#PPCInliningVisitor
+ instanceVariableNames:'acceptedNodes'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Visitors'
+!
+
+!PPCInliningVisitor methodsFor:'initialization'!
+
+initialize
+ super initialize.
+
+ acceptedNodes := 0
+! !
+
+!PPCInliningVisitor methodsFor:'testing'!
+
+canInline
+ ^ acceptedNodes > 1
+! !
+
+!PPCInliningVisitor methodsFor:'visiting'!
+
+beforeAccept: node
+ acceptedNodes := acceptedNodes + 1.
+ super beforeAccept: node
+!
+
+markForInline: node
+ self canInline ifTrue: [
+ node markForInline.
+ ].
+ ^ node
+!
+
+visitCharSetPredicateNode: node
+ ^ self markForInline: node
+!
+
+visitCharacterNode: node
+ ^ self markForInline: node
+!
+
+visitLiteralNode: node
+ ^ self markForInline: node
+!
+
+visitMessagePredicateNode: node
+ ^ self markForInline: node
+!
+
+visitNilNode: node
+ ^ self markForInline: node
+!
+
+visitNotCharSetPredicateNode: node
+ ^ self markForInline: node
+!
+
+visitNotLiteralNode: node
+ ^ self markForInline: node
+!
+
+visitNotMessagePredicateNode: node
+ ^ self markForInline: node
+!
+
+visitPluggableNode: node
+ "Sadly, on Smalltalk/X blocks cannot be inlined because
+ the VM does not provide enough information to map
+ it back to source code. Very bad indeed!!"
+ ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifFalse:[
+ ^ self markForInline: node
+ ].
+ ^ super visitPluggableNode: node.
+
+ "Modified: / 23-04-2015 / 12:15:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+visitTokenStarMessagePredicateNode: node
+ ^ self markForInline: node
+!
+
+visitTokenStarSeparatorNode: node
+ ^ self markForInline: node
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCLLChoiceNode.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,17 @@
+"{ 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 Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCListNode.st Fri May 01 14:04:37 2015 +0200
@@ -25,6 +25,14 @@
children: anObject
children := anObject
+!
+
+firstChild
+ ^ self children first
+!
+
+secondChild
+ ^ self children second
! !
!PPCListNode methodsFor:'analysis'!
@@ -35,12 +43,6 @@
acceptsEpsilonOpenSet: set
self subclassResponsibility
-!
-
-replace: node with: anotherNode
- children keysAndValuesDo: [ :index :child |
- child == node ifTrue: [ children at: index put: anotherNode ]
- ]
! !
!PPCListNode methodsFor:'copying'!
@@ -50,16 +52,11 @@
children := children copy
! !
-!PPCListNode methodsFor:'optimizing'!
+!PPCListNode methodsFor:'transformation'!
-inline: changeStatus
- | inlinedNode |
- self children do: [ :child |
- inlinedNode := child asInlined.
- (inlinedNode ~= child) ifTrue: [
- changeStatus change.
- ^ self replace: child with: inlinedNode.
- ]
+replace: node with: anotherNode
+ children keysAndValuesDo: [ :index :child |
+ child == node ifTrue: [ children at: index put: anotherNode ]
]
! !
--- a/compiler/PPCLiteralNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCLiteralNode.st Fri May 01 14:04:37 2015 +0200
@@ -9,30 +9,9 @@
category:'PetitCompiler-Nodes'
!
-!PPCLiteralNode methodsFor:'compiling'!
+!PPCLiteralNode methodsFor:'visiting'!
-compileWith: compiler effect: effect id: id
- | encodedLiteral |
-
- encodedLiteral := self encodeQuotes: literal.
- compiler startMethod: id.
- compiler addVariable: 'retval'.
- compiler addVariable: 'position'.
- compiler add: 'position := context position.'.
-
- compiler add: 'retval := context next: ', literal size asString, '.'.
- compiler add: 'retval = #''', encodedLiteral, ''' ifTrue: [ ^ #''', encodedLiteral, '''].'.
- compiler add: 'context position: position.'.
- compiler add: '^ self error: ''', encodedLiteral, ' expected'' at: position'.
- ^ compiler stopMethod.
+accept: visitor
+ ^ visitor visitLiteralNode: self
! !
-!PPCLiteralNode methodsFor:'optimizing'!
-
-asInlined
- ^ PPCInlineLiteralNode new
- literal: literal;
- name: name;
- yourself
-! !
-
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCMergingVisitor.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,45 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCRewritingVisitor subclass:#PPCMergingVisitor
+ instanceVariableNames:'nodeSet'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Visitors'
+!
+
+!PPCMergingVisitor methodsFor:'as yet unclassified'!
+
+equivalentNode: node
+ ^ nodeSet detect: [ :e | e = node ]
+!
+
+hasEquivalentNode: node
+ ^ nodeSet includes: node
+!
+
+initialize
+ super initialize.
+
+ nodeSet := Set new
+!
+
+store: 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
+ ].
+
+ ^ node
+! !
+
--- a/compiler/PPCMessagePredicateNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCMessagePredicateNode.st Fri May 01 14:04:37 2015 +0200
@@ -11,14 +11,6 @@
!PPCMessagePredicateNode methodsFor:'accessing'!
-asInlined
- ^ PPCInlineMessagePredicateNode new
- message: message;
- predicate: predicate;
- name: name;
- yourself
-!
-
message
^ message
@@ -29,14 +21,12 @@
message := anObject
! !
-!PPCMessagePredicateNode methodsFor:'as yet unclassified'!
+!PPCMessagePredicateNode methodsFor:'analysis'!
-bodyOfPredicate: compiler
- compiler addOnLine: '(context peek ', self message, ')'.
- compiler indent.
- compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'.
- compiler add: 'ifTrue: [ context next ].'.
- compiler dedent.
+firstCharSet
+ ^ PPCharSetPredicate on: [:e | e perform: message ]
+
+ "Modified: / 23-04-2015 / 22:13:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCMessagePredicateNode methodsFor:'comparing'!
@@ -50,3 +40,9 @@
^ super hash bitXor: message hash
! !
+!PPCMessagePredicateNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitMessagePredicateNode: self
+! !
+
--- a/compiler/PPCMethod.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCMethod.st Fri May 01 14:04:37 2015 +0200
@@ -3,7 +3,7 @@
"{ NameSpace: Smalltalk }"
Object subclass:#PPCMethod
- instanceVariableNames:'buffer variables indentation id profile canInline'
+ instanceVariableNames:'buffer variables indentation id profile variableForReturn'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Core'
@@ -22,7 +22,7 @@
add: string
self nl.
- indentation timesRepeat: [ buffer nextPutAll: ' ' ].
+ indentation timesRepeat: [ buffer nextPut: Character tab ].
self addOnLine: string.
!
@@ -31,11 +31,12 @@
!
addVariable: name
+ (variables includes: name) ifTrue:[
+ self error:'Duplicate variable name, must rename'.
+ ].
variables add: name.
-!
-allowInline
- canInline := true
+ "Modified: / 23-04-2015 / 12:29:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
body
@@ -51,11 +52,13 @@
!
code
- ^ self methodName, String cr,
- self variables, String cr,
- self profilingBegin, String cr,
- self body, String cr
-" self profilingEnd"
+ ^ 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
@@ -70,6 +73,10 @@
indentation := indentation + 1
!
+isInline
+ ^ false
+!
+
isMethod
^ true
!
@@ -104,17 +111,72 @@
^ ''
!
+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'!
+
+allocateReturnVariable
+
+ ^ variableForReturn isNil ifTrue:[
+ variableForReturn := self allocateTemporaryVariableNamed: 'retval'
+ ] ifFalse:[
+ variableForReturn
+ ].
+
+ "Created: / 23-04-2015 / 18:03:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+allocateTemporaryVariableNamed:preferredName
+ "Allocate a new variable with (preferably) given name.
+ Returns a real variable name that should be used."
+
+ (variables includes:preferredName) ifFalse:[
+ variables add:preferredName.
+ ^ preferredName
+ ] ifTrue:[
+ | name |
+
+ name := preferredName , '_' , (variables size + 1) printString.
+ variables add:name.
+ ^ name
+ ].
+
+ "Created: / 23-04-2015 / 17:37:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!PPCMethod methodsFor:'initialization'!
initialize
buffer := WriteStream on: ''.
indentation := 1.
variables := OrderedCollection new.
- canInline := false
+! !
+
+!PPCMethod methodsFor:'printing & storing'!
+
+printOn:aStream
+ "append a printed representation if the receiver to the argument, aStream"
+
+ super printOn:aStream.
+ aStream nextPutAll:' id: '.
+ id printOn:aStream.
+
+ "Modified: / 23-04-2015 / 12:32:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCMethod class methodsFor:'documentation'!
--- a/compiler/PPCMethodStrategy.st Fri May 01 13:44:43 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,45 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-Object subclass:#PPCMethodStrategy
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-PPCMethodStrategy class instanceVariableNames:'Instance'
-
-"
- No other class instance variables are inherited by this class.
-"
-!
-
-!PPCMethodStrategy class methodsFor:'as yet unclassified'!
-
-instance
- ^ Instance ifNil: [
- Instance := self basicNew initialize.
- ]
-!
-
-new
- ^ self instance
-! !
-
-!PPCMethodStrategy methodsFor:'as yet unclassified'!
-
-return: compiler
- compiler add: '^'.
-!
-
-start: compiler id: id
- self halt: 'deprecated?'.
- ^ compiler startMethod: id
-!
-
-stop: compiler
- ^ compiler stopMethod
-! !
-
--- a/compiler/PPCNegateNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCNegateNode.st Fri May 01 14:04:37 2015 +0200
@@ -9,11 +9,7 @@
category:'PetitCompiler-Nodes'
!
-!PPCNegateNode methodsFor:'as yet unclassified'!
-
-compileWith: compiler effect: effect id: id
- "TODO"
-!
+!PPCNegateNode methodsFor:'accessing'!
prefix
^ #negate
--- a/compiler/PPCNilNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCNilNode.st Fri May 01 14:04:37 2015 +0200
@@ -9,33 +9,29 @@
category:'PetitCompiler-Nodes'
!
-!PPCNilNode methodsFor:'analyzing'!
+!PPCNilNode methodsFor:'accessing'!
-isNullable
- ^ true
+prefix
+ ^ #nil
! !
-!PPCNilNode methodsFor:'as yet unclassified'!
+!PPCNilNode methodsFor:'analysis'!
acceptsEpsilon
^ true
!
-asInlined
- ^ PPCInlineNilNode new
-!
-
-compileWith: compiler effect: effect id: id
- compiler startMethod: id.
- compiler add: '^ nil.'.
- ^ compiler stopMethod.
-!
-
firstCharSet
^ PPCharSetPredicate on: [:e | false ]
!
-prefix
- ^ #nil
+isNullable
+ ^ true
! !
+!PPCNilNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitNilNode: self
+! !
+
--- a/compiler/PPCNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCNode.st Fri May 01 14:04:37 2015 +0200
@@ -21,17 +21,36 @@
^ #()
!
+markForInline
+ "Marks receiver for inlining, i.e., it's parsing code
+ should be inlined into parent's code"
+ self propertyAt: #inlined put: true
+
+ "Created: / 23-04-2015 / 15:39:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+name
+ ^ name
+!
+
name: anObject
name := anObject
!
prefix
- self subclassResponsibility
+ ^ 'anode'
!
suffix
^ ''
+!
+
+unmarkForInline
+ "Forbids inlining of receiver's parsing code"
+ self propertyAt: #inlined put: false
+
+ "Created: / 23-04-2015 / 15:39:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCNode methodsFor:'accessing-properties'!
@@ -42,16 +61,31 @@
^ properties notNil and: [ properties includesKey: aKey ]
!
+properties
+ ^ properties
+!
+
properties: aDictionary
properties := aDictionary
!
+propertyAt: aKey
+ ^ 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 ]
+!
+
+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."
+
+ ^ (properties ifNil: [ properties := Dictionary new: 1 ])
+ at: aKey put: anObject
! !
!PPCNode methodsFor:'analysis'!
@@ -145,13 +179,7 @@
^ self children isEmpty
! !
-!PPCNode methodsFor:'as yet unclassified'!
-
-name
- ^ name
-! !
-
-!PPCNode methodsFor:'comparison'!
+!PPCNode methodsFor:'comparing'!
= anotherNode
(self == anotherNode) ifTrue: [ ^ true ].
@@ -168,30 +196,6 @@
^ self class hash bitXor: (name hash bitXor: self children size hash)
! !
-!PPCNode methodsFor:'compiling'!
-
-compileWith: compiler
- | |
- ^ self compileWith: compiler effect: #none
-!
-
-compileWith: compiler effect: effect
- | id method |
- id := (compiler idFor: self prefixed: (self prefix) suffixed: (self suffix) effect: effect).
- (method := compiler checkCache: id) ifNotNil: [ ^ method ].
-
- ^ self compileWith: compiler effect: effect id: id.
-!
-
-compileWith: compiler effect: effect id: id
- self subclassResponsibility
-!
-
-initialize
- super initialize.
- firstFollowCache := IdentityDictionary new.
-! !
-
!PPCNode methodsFor:'first follow next'!
firstSet
@@ -342,114 +346,57 @@
composite tree
title: 'Tree';
children: [:n | n children ];
- format: [:n| n name ifNil: [ n asString ] ifNotNil: [n name] ];
+ 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'!
-asFast
- ^ self
-!
-
-asInlined
- ^ self
-!
-
checkTree
| message |
self allNodes do: [ :node | (message := node check) ifNotNil: [ self error: message ] ].
!
-defaultOptimizationParameters
- | parameters |
- parameters := IdentityDictionary new.
- parameters at: #inline put: true.
- parameters at: #rewrite put: true.
-
- ^ parameters
-!
-
-doOptimizationLoop: params status: changeStatus
- | mapping optimized root |
- mapping := IdentityDictionary new.
- self allNodes do: [ :node |
- optimized := (node optimize: params status: changeStatus).
- (optimized ~= node) ifTrue: [
- mapping at: node put: optimized.
- ].
- ].
-
- root := mapping at: self ifAbsent: [ self ].
- [ | changed |
- changed := false.
- root allNodes do: [ :node |
- node children do: [ :child |
- mapping at: child ifPresent: [:newChild |
- node replace: child with: newChild.
- changed := true ]
- ]].
- changed
- ] whileTrue.
- ^ root
-!
-
-inline: changeStatus
- "nothing to do"
-!
-
-inline: params status: changeStatus
- (params at: #inline) ifTrue: [
- ^ self inline: changeStatus
- ]
-!
-
-optimize: params status: changeStatus
- | retval |
- retval := self.
-
- retval := retval rewrite: params status: changeStatus.
- retval := retval inline: params status: changeStatus.
-
- ^ retval
-!
-
optimizeTree
- ^ self optimizeTree: #()
+ ^ self optimizeTree: #(#token #inline #rewrite #merge)
!
optimizeTree: params
- | node newNode parameters status |
-
- parameters := self defaultOptimizationParameters.
-
- params do: [ :p | parameters at: p key put: p value ].
+ | retval |
+
+ "Default optimization sequence"
+ retval := self.
- node := self.
- [
- status := PPCOptimizationResult new.
- newNode := node doOptimizationLoop: parameters status: status.
- status isChange.
- ] whileTrue: [ node := newNode ].
- ^ node
-!
-
-rewrite: changeStatus
- "nothing to do"
-!
-
-rewrite: params status: changeStatus
- (params at: #rewrite) ifTrue: [
- ^ self rewrite: changeStatus.
- ].
+ (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
! !
!PPCNode methodsFor:'printing'!
+printHashOn: aStream
+ aStream print: 'Hash:', self hash asString
+!
+
+printIdOn: aStream
+ aStream print: 'ID:', self identityHash asString
+!
+
printNameOn: aStream
self name isNil
- ifTrue: [ aStream print: self hash ]
- ifFalse: [ aStream nextPutAll: self name. aStream nextPut: $-. aStream print: self hash. ]
+ ifFalse: [ aStream nextPutAll: self name. aStream nextPut: $-. ].
+
+ aStream print: self identityHash
!
printOn: aStream
@@ -459,6 +406,14 @@
aStream nextPut: $)
! !
+!PPCNode methodsFor:'testing'!
+
+isMarkedForInline
+ ^ self propertyAt: #inlined ifAbsent: [ false ].
+
+ "Created: / 23-04-2015 / 15:40:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!PPCNode methodsFor:'todel'!
allParsersDo: aBlock
@@ -489,8 +444,8 @@
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
@@ -508,3 +463,9 @@
^ root
! !
+!PPCNode methodsFor:'visiting'!
+
+accept: visitor
+ visitor visitNode: self
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCNodeVisitor.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,318 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCNodeVisitor
+ instanceVariableNames:'openSet closeSet cache arguments'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Visitors'
+!
+
+!PPCNodeVisitor class methodsFor:'instance creation'!
+
+new
+ ^ self basicNew initialize
+! !
+
+!PPCNodeVisitor methodsFor:'accessing'!
+
+arguments: args
+ arguments := args
+! !
+
+!PPCNodeVisitor methodsFor:'hooks'!
+
+afterAccept: node retval: retval
+ "nothing to do"
+ ^ retval
+!
+
+beforeAccept: node
+ "nothing to do"
+!
+
+closedDetected: node
+ ^ #closed
+!
+
+openDetected: node
+ ^ #open
+! !
+
+!PPCNodeVisitor methodsFor:'initialization'!
+
+initialize
+ 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
+!
+
+isClosed: child
+ ^ closeSet includes: child
+!
+
+isOpen: child
+ ^ openSet includes: child
+!
+
+open: node
+ self assert: (self isOpen: node) not description: 'already opened!!'.
+ openSet add: node
+!
+
+visit: node
+ | retval |
+ (self isOpen: node) ifTrue: [
+ ^ self openDetected: node
+ ].
+
+ (self isCached: node) ifTrue: [
+ ^ self cachedDetected: 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
+!
+
+visitChildren: node
+ 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
+!
+
+cachedDetected: node
+ ^ self cachedValue: node
+!
+
+cachedValue: node
+ ^ cache at: node
+!
+
+isCached: node
+ ^ cache includesKey: node
+! !
+
+!PPCNodeVisitor methodsFor:'visiting'!
+
+visitActionNode: node
+ ^ self visitNode: node
+!
+
+visitAndNode: node
+ ^ self visitNode: node
+!
+
+visitAnyNode: node
+ ^ self visitNode: node
+!
+
+visitCharSetPredicateNode: node
+ ^ self visitNode: node
+!
+
+visitCharacterNode: node
+ ^ self visitNode: node
+!
+
+visitChoiceNode: node
+ ^ self visitNode: node
+!
+
+visitEndOfFileNode: 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
+!
+
+visitLiteralNode: node
+ "default implementation"
+ ^ self visitNode: node.
+!
+
+visitMessagePredicateNode: node
+ ^ self visitNode: node
+!
+
+visitNilNode: node
+ ^ self visitNode: node
+!
+
+visitNode: node
+ self visitChildren: node.
+ ^ node
+!
+
+visitNotCharSetPredicateNode: node
+ ^ self visitNode: node
+!
+
+visitNotLiteralNode: node
+ ^ self visitNode: node
+!
+
+visitNotMessagePredicateNode: node
+ ^ self visitNode: node
+!
+
+visitNotNode: node
+ ^ self visitNode: node
+!
+
+visitOptionalNode: node
+ ^ self visitNode: node
+!
+
+visitPluggableNode: node
+ ^ self visitNode: node
+!
+
+visitPlusNode: node
+ ^ self visitNode: node
+!
+
+visitPredicateNode: node
+ ^ self visitNode: node
+!
+
+visitSequenceNode: node
+ ^ self visitNode: node
+!
+
+visitStarAnyNode: node
+ ^ self visitNode: node
+!
+
+visitStarCharSetPredicateNode: node
+ ^ self visitNode: node
+!
+
+visitStarMessagePredicateNode: node
+ ^ self visitNode: node
+!
+
+visitStarNode: node
+ ^ self visitNode: node
+!
+
+visitSymbolActionNode: node
+ ^ self visitNode: node
+!
+
+visitTokenActionNode: node
+ ^ self visitNode: node
+!
+
+visitTokenConsumeNode: node
+ ^ self visitNode: node
+!
+
+visitTokenNode: node
+ ^ self visitNode: node
+!
+
+visitTokenSequenceNode: node
+ ^ self visitNode: node
+!
+
+visitTokenStarMessagePredicateNode: node
+ ^ self visitNode: node
+!
+
+visitTokenStarSeparatorNode: node
+ ^ self visitNode: node
+!
+
+visitTrimNode: node
+ ^ self visitNode: node
+!
+
+visitTrimmingTokenNode: node
+ ^ self visitNode: node
+!
+
+visitUnknownNode: node
+ ^ self visitNode: node
+! !
+
--- a/compiler/PPCNotCharSetPredicateNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCNotCharSetPredicateNode.st Fri May 01 14:04:37 2015 +0200
@@ -10,33 +10,19 @@
!
-!PPCNotCharSetPredicateNode methodsFor:'as yet unclassified'!
-
-asInlined
- ^ PPCInlineNotCharSetPredicateNode new
- predicate: predicate;
- name: name;
- yourself
-!
-
-bodyOfPredicate: compiler
- | classificationId classification |
- classification := self extendClassification: 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.
-!
+!PPCNotCharSetPredicateNode methodsFor:'analysis'!
firstCharSet
^ firstCharSet := PPCharSetPredicate on: [:e | (predicate value:e) not ]
! !
+!PPCNotCharSetPredicateNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitNotCharSetPredicateNode: self
+! !
+
!PPCNotCharSetPredicateNode class methodsFor:'documentation'!
version_HG
--- a/compiler/PPCNotLiteralNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCNotLiteralNode.st Fri May 01 14:04:37 2015 +0200
@@ -11,44 +11,17 @@
!PPCNotLiteralNode methodsFor:'accessing'!
-asInlined
- ^ PPCInlineNotLiteralNode new
- name: name;
- literal: literal;
- yourself
-!
-
firstCharSet
^ PPCharSetPredicate on: [:e | true ]
!
-literal
-
- ^ literal
-!
-
-literal: anObject
-
- literal := anObject
-!
-
prefix
^ #notLit
! !
-!PPCNotLiteralNode methodsFor:'as yet unclassified'!
+!PPCNotLiteralNode methodsFor:'visiting'!
-compileWith: compiler effect: effect id: id
- | encodedLiteral size |
- encodedLiteral := self encodeQuotes: literal.
- size := literal size asString.
-
- compiler startMethod: id.
- compiler add: '((context peek: ', size, ') =#''', encodedLiteral, ''')'.
- compiler indent.
- compiler add: ' ifTrue: [ self error: ''', encodedLiteral, ' not expected'' ]'.
- compiler add: ' ifFalse: [ nil ].'.
- compiler dedent.
- ^ compiler stopMethod.
+accept: visitor
+ ^ visitor visitNotLiteralNode: self
! !
--- a/compiler/PPCNotMessagePredicateNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCNotMessagePredicateNode.st Fri May 01 14:04:37 2015 +0200
@@ -11,18 +11,6 @@
!PPCNotMessagePredicateNode methodsFor:'accessing'!
-asInlined
- ^ PPCInlineNotMessagePredicateNode new
- predicate: predicate;
- message: message;
- name: name;
- yourself
-!
-
-firstCharSet
- PPCharSetPredicate on: [:e | (predicate value:e) not ]
-!
-
message
^ message
@@ -33,14 +21,12 @@
message := anObject
! !
-!PPCNotMessagePredicateNode methodsFor:'as yet unclassified'!
+!PPCNotMessagePredicateNode methodsFor:'analysis'!
-bodyOfPredicate: compiler
- compiler addOnLine: '(context peek ', message, ')'.
- compiler indent.
- compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.
- compiler add: ' ifFalse: [ nil ].'.
- compiler dedent.
+firstCharSet
+ ^ PPCharSetPredicate on: [:e | (predicate value:e) not ]
+
+ "Modified: / 23-04-2015 / 22:11:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCNotMessagePredicateNode methodsFor:'comparison'!
@@ -54,3 +40,9 @@
^ super hash bitXor: message hash
! !
+!PPCNotMessagePredicateNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitNotMessagePredicateNode: self
+! !
+
--- a/compiler/PPCNotNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCNotNode.st Fri May 01 14:04:37 2015 +0200
@@ -25,59 +25,9 @@
^ true
! !
-!PPCNotNode methodsFor:'compiling'!
-
-compileWith: compiler effect: effect id: id
+!PPCNotNode methodsFor:'visiting'!
- compiler startMethod: id.
- compiler addVariable: 'memento'.
- compiler add: (compiler smartRemember: child).
-
- compiler call: (child compileWith: compiler).
- compiler add: (compiler smartRestore: child).
-
- compiler add: '^ error ifFalse: [ self error ] ifTrue: [ self clearError. nil ]'.
- ^ compiler stopMethod.
+accept: visitor
+ ^ visitor visitNotNode: self
! !
-!PPCNotNode methodsFor:'optimizing'!
-
-optimize: params
- (self rewrite: params) ifTrue: [
- ^ true.
- ].
- ^ super optimize: params.
-!
-
-rewrite: changeStatus
- (child isKindOf: PPCAbstractLiteralNode) ifTrue: [
- changeStatus change.
- ^ PPCNotLiteralNode new
- name: self name;
- literal: self child literal;
- yourself
- ].
-
- (child isKindOf: PPCMessagePredicateNode) ifTrue: [
- changeStatus change.
- ^ PPCNotMessagePredicateNode new
- name: self name;
- message: child message;
- yourself
- ].
-
- (child isKindOf: PPCCharSetPredicateNode) ifTrue: [
- changeStatus change.
- ^ PPCNotCharSetPredicateNode new
- name: self name;
- predicate: child predicate;
- yourself
- ].
-
- "Can do the fast version, because we throw away the result and return nil"
- (self allNodes anySatisfy: [ :node | node asFast ~= node ]) ifTrue: [
- changeStatus change.
- self replace: child with: (child transform: [:node | node asFast]).
- ]
-! !
-
--- a/compiler/PPCOptimizationResult.st Fri May 01 13:44:43 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,41 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-Object subclass:#PPCOptimizationResult
- instanceVariableNames:'change'
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-!PPCOptimizationResult class methodsFor:'as yet unclassified'!
-
-new
- "return an initialized instance"
-
- ^ self basicNew initialize.
-!
-
-nothing
- ^ PPCOptimizationResult new
- change: false;
- yourself
-! !
-
-!PPCOptimizationResult methodsFor:'accessing'!
-
-change
- change := true.
-!
-
-isChange
- ^ change
-! !
-
-!PPCOptimizationResult methodsFor:'initialization'!
-
-initialize
- change := false
-! !
-
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCOptimizingVisitor.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,189 @@
+"{ 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 Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCOptionalNode.st Fri May 01 14:04:37 2015 +0200
@@ -9,13 +9,13 @@
category:'PetitCompiler-Nodes'
!
-!PPCOptionalNode methodsFor:'analyzing'!
+!PPCOptionalNode methodsFor:'accessing'!
-isNullable
- ^ true
+prefix
+ ^ #opt
! !
-!PPCOptionalNode methodsFor:'as yet unclassified'!
+!PPCOptionalNode methodsFor:'analysis'!
acceptsEpsilon
^ true
@@ -25,17 +25,13 @@
^ true
!
-compileWith: compiler effect: effect id: id
- compiler startMethod: id.
- compiler addVariable: 'retval'.
-
- compiler add: 'retval := '.
- compiler callOnLine: (child compileWith: compiler ).
- compiler add: '^ error ifFalse: [ retval ] ifTrue: [ self clearError. nil ]'.
- ^ compiler stopMethod.
-!
-
-prefix
- ^ #opt
+isNullable
+ ^ true
! !
+!PPCOptionalNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitOptionalNode: self
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCPluggableConfiguration.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,29 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCConfiguration subclass:#PPCPluggableConfiguration
+ instanceVariableNames:'block'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Core'
+!
+
+!PPCPluggableConfiguration class methodsFor:'as yet unclassified'!
+
+on: aBlock
+ ^ self new
+ block: aBlock;
+ yourself
+! !
+
+!PPCPluggableConfiguration methodsFor:'as yet unclassified'!
+
+block: aBlock
+ block := aBlock
+!
+
+invokePhases
+ ^ block value: self
+! !
+
--- a/compiler/PPCPluggableNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCPluggableNode.st Fri May 01 14:04:37 2015 +0200
@@ -19,9 +19,13 @@
block: anObject
block := anObject
+!
+
+prefix
+ ^ #plug
! !
-!PPCPluggableNode methodsFor:'as yet unclassified'!
+!PPCPluggableNode methodsFor:'analysis'!
acceptsEpsilon
^ true
@@ -31,38 +35,8 @@
^ true
!
-asInlined
- "Sadly, on Smalltalk/X blocks cannot be inlined because
- the VM does not provide enough information to map
- it back to source code. Very bad indeed!!"
-
- ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
- ^ super asInlined
- ] ifFalse:[
- ^ PPCInlinePluggableNode new
- name: name;
- block: block;
- yourself
- ]
-
-!
-
-compileWith: compiler effect: effect id: id
- | blockId |
- blockId := compiler idFor: block prefixed: #block.
-
- compiler startMethod: id.
- compiler addConstant: block as: blockId.
- compiler add: '^ ', blockId, ' value: context.'.
- ^ compiler stopMethod.
-!
-
firstCharSet
^ PPCharSetPredicate on: [:char | (block asParser parse: char asString) isPetitFailure not ]
-!
-
-prefix
- ^ #plug
! !
!PPCPluggableNode methodsFor:'comparing'!
@@ -76,3 +50,9 @@
^ super hash bitXor: block hash
! !
+!PPCPluggableNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitPluggableNode: self
+! !
+
--- a/compiler/PPCPlusNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCPlusNode.st Fri May 01 14:04:37 2015 +0200
@@ -12,32 +12,6 @@
!PPCPlusNode methodsFor:'as yet unclassified'!
-compileWith: compiler effect: effect id: id
-
- compiler startMethod: id.
- compiler addVariable: 'retval'.
- compiler addVariable: 'element'.
-
- compiler add: 'retval := OrderedCollection new.'.
- compiler add: 'element := '.
- compiler callOnLine: (child compileWith: compiler).
- compiler add: 'error ifTrue: [ ^ self error: ''at least one occurence expected'' ].'.
- compiler add: 'retval add: element.'.
-
- compiler add: 'element := '.
- compiler callOnLine: (child compileWith: compiler).
- compiler add: '[ error ] whileFalse: ['.
- compiler indent.
- compiler add: 'retval add: element.'.
- compiler add: 'element := '.
- compiler callOnLine: (child compileWith: compiler).
- compiler dedent.
- compiler add: '].'.
- compiler add: 'self clearError.'.
- compiler add: '^ retval asArray'.
- ^ compiler stopMethod.
-!
-
followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet suchThat: aBlock
| first |
super followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet suchThat: aBlock.
@@ -50,6 +24,12 @@
^ #plus
! !
+!PPCPlusNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitPlusNode: self
+! !
+
!PPCPlusNode class methodsFor:'documentation'!
version_HG
--- a/compiler/PPCPredicateNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCPredicateNode.st Fri May 01 14:04:37 2015 +0200
@@ -9,76 +9,9 @@
category:'PetitCompiler-Nodes'
!
-!PPCPredicateNode methodsFor:'as yet unclassified'!
-
-bodyOfPredicate: compiler
- | id |
- id := (compiler idFor: predicate prefixed: #predicate).
- compiler addConstant: predicate as: id.
-
- compiler addOnLine: '(context atEnd not and: [ ', id , ' value: context uncheckedPeek])'.
- compiler indent.
- compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'.
- compiler add: 'ifTrue: [ context next ].'.
- compiler dedent.
-!
-
-rewrite: changeStatus
- | charSet |
-
- (predicate class == PPCharSetPredicate) ifTrue: [
- charSet := predicate.
- ].
- charSet := PPCharSetPredicate on: predicate.
-
- (charSet equals: (PPCharSetPredicate on: [ :char | char isLetter])) ifTrue: [
- changeStatus change.
- ^ PPCMessagePredicateNode new
- name: name;
- message: #isLetter;
- predicate: predicate;
- yourself
- ].
+!PPCPredicateNode methodsFor:'visiting'!
- (charSet equals: (PPCharSetPredicate on: [ :char | char isDigit])) ifTrue: [
- changeStatus change.
- ^ PPCMessagePredicateNode new
- name: name;
- message: #isDigit;
- predicate: predicate;
- yourself
- ].
-
- (charSet equals: (PPCharSetPredicate on: [ :char | char isAlphaNumeric])) ifTrue: [
- changeStatus change.
- ^ PPCMessagePredicateNode new
- name: name;
- message: #isAlphaNumeric;
- predicate: predicate;
- yourself
- ].
-
- (charSet equals: (PPCharSetPredicate on: [ :char | char isSeparator])) ifTrue: [
- changeStatus change.
- ^ PPCMessagePredicateNode new
- name: name;
- message: #isSeparator;
- predicate: predicate;
- yourself
- ].
-
-
- (charSet equals: (PPCharSetPredicate on: [ :char | true ])) ifTrue: [
- changeStatus change.
- ^ PPCAnyNode new
- name: name;
- yourself
- ].
-
- changeStatus change.
- ^ PPCCharSetPredicateNode new
- name: name;
- predicate: charSet;
- yourself.
+accept: visitor
+ ^ visitor visitPredicateNode: self
! !
--- a/compiler/PPCProfilingContext.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCProfilingContext.st Fri May 01 14:04:37 2015 +0200
@@ -73,10 +73,10 @@
| sender selector |
sender := thisContext sender.
- (sender receiver isKindOf: PPCompiledParser) ifTrue: [
- selector := sender selector.
+ selector := (sender receiver isKindOf: PPCompiledParser) ifTrue: [
+ sender selector.
] ifFalse: [
- selector := sender receiver class.
+ sender receiver class.
].
remembers add: selector.
^ super remember
@@ -86,10 +86,10 @@
| selector sender |
sender := thisContext sender.
- (sender receiver isKindOf: PPCompiledParser) ifTrue: [
- selector := sender selector.
+ selector := (sender receiver isKindOf: PPCompiledParser) ifTrue: [
+ sender selector.
] ifFalse: [
- selector := sender receiver class.
+ sender receiver class.
].
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCRewritingVisitor.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,46 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCNodeVisitor subclass:#PPCRewritingVisitor
+ instanceVariableNames:'change'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Visitors'
+!
+
+!PPCRewritingVisitor methodsFor:'as yet unclassified'!
+
+change
+ self flag: 'JK: Do we need this?'.
+ change := true.
+!
+
+visitChild: child of: node
+ | newChild |
+
+ (self isOpen: child) ifTrue: [
+ "already processing..."
+ ^ 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.
+ ].
+!
+
+visitChildren: node
+ node children do: [ :child |
+ self visitChild: child of: node
+ ]
+! !
+
--- a/compiler/PPCSequenceNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCSequenceNode.st Fri May 01 14:04:37 2015 +0200
@@ -79,29 +79,6 @@
guard compileGuard: compiler.
compiler addOnLine: 'ifFalse: [ ^ self error ].'
].
-!
-
-compileWith: compiler effect: effect id: id
- compiler startMethod: id.
- compiler addVariable: 'retval'.
- compiler addVariable: 'element'.
- compiler addVariable: 'memento'.
- compiler add: (compiler smartRemember: self).
- compiler add: 'retval := Array new: ', children size asString, '.'.
- self addGuard: compiler id: id.
-
-" Halt if: [ self name = #qualifiedName ]."
-
- (1 to: children size) do: [ :idx | |child|
- child := children at: idx.
- compiler add: 'element := '.
- compiler callOnLine: (child compileWith: compiler).
-
- compiler add: 'error ifTrue: [ ', (compiler smartRestore: self) ,' ^ failure ].'.
- compiler add: 'retval at: ', idx asString, ' put: element.'.
- ].
- compiler add: '^ retval'.
- ^ compiler stopMethod.
! !
!PPCSequenceNode methodsFor:'first follow next'!
@@ -124,13 +101,9 @@
reject: [ :each | each isNullable ]) ] ]
! !
-!PPCSequenceNode methodsFor:'optimizing'!
+!PPCSequenceNode methodsFor:'visiting'!
-asFast
- ^ PPCTokenSequenceNode new
- children: children;
- name: self name;
- properties: properties;
- yourself
+accept: visitor
+ ^ visitor visitSequenceNode: self
! !
--- a/compiler/PPCStarAnyNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCStarAnyNode.st Fri May 01 14:04:37 2015 +0200
@@ -11,21 +11,13 @@
!PPCStarAnyNode methodsFor:'as yet unclassified'!
-compileWith: compiler effect: effect id: id
- compiler startMethod: id.
- 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 stopMethod.
-!
-
prefix
^ #starAny
-!
-
-rewrite: changeStatus
- "Nothing TODO"
! !
+!PPCStarAnyNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitStarAnyNode: self
+! !
+
--- a/compiler/PPCStarCharSetPredicateNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCStarCharSetPredicateNode.st Fri May 01 14:04:37 2015 +0200
@@ -11,25 +11,6 @@
!PPCStarCharSetPredicateNode methodsFor:'accessing'!
-compileWith: compiler effect: effect id: id
- | classification classificationId |
-
- compiler startMethod: id.
- classification := self extendClassification: predicate classification.
- classificationId := compiler idFor: classification prefixed: #classification.
- compiler addConstant: classification as: classificationId.
-
- compiler addVariable: 'retval'.
- compiler add: 'retval := OrderedCollection new.'.
- compiler add: '[ ', classificationId, ' at: context peek asInteger ] whileTrue: ['.
- compiler indent.
- compiler add: ' retval add: context next.'.
- compiler dedent.
- compiler add: '].'.
- compiler add: '^ retval asArray'.
- ^ compiler stopMethod.
-!
-
extendClassification: classification
^ (classification asOrderedCollection addLast: false; yourself) asArray
!
@@ -50,10 +31,6 @@
prefix
^ #starPredicate
-!
-
-rewrite: changeStatus
- "Nothing TODO"
! !
!PPCStarCharSetPredicateNode methodsFor:'comparing'!
@@ -67,3 +44,9 @@
^ super hash bitXor: predicate hash
! !
+!PPCStarCharSetPredicateNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitStarCharSetPredicateNode: self
+! !
+
--- a/compiler/PPCStarMessagePredicateNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCStarMessagePredicateNode.st Fri May 01 14:04:37 2015 +0200
@@ -11,6 +11,10 @@
!PPCStarMessagePredicateNode methodsFor:'accessing'!
+children
+ ^ #()
+!
+
firstCharSet
^ PPCharSetPredicate on: [:char | char perform: message ]
!
@@ -27,25 +31,6 @@
prefix
^ #starPredicate
-!
-
-rewrite: changeStatus
- "Nothing TODO"
-! !
-
-!PPCStarMessagePredicateNode methodsFor:'as yet unclassified'!
-
-compileWith: compiler effect: effect id: id
- compiler startMethod: id.
- compiler addVariable: 'retval'.
- compiler add: 'retval := OrderedCollection new.'.
- compiler add: '[ context peek ', message, ' ] whileTrue: ['.
- compiler indent.
- compiler add: ' retval add: context next'.
- compiler dedent.
- compiler add: '].'.
- compiler add: '^ retval asArray'.
- ^ compiler stopMethod.
! !
!PPCStarMessagePredicateNode methodsFor:'comparing'!
@@ -59,13 +44,9 @@
^ super hash bitXor: message hash
! !
-!PPCStarMessagePredicateNode methodsFor:'optimizing'!
+!PPCStarMessagePredicateNode methodsFor:'visiting'!
-asFast
- ^ PPCTokenStarMessagePredicateNode new
- name: name;
- message: message;
- child: child;
- yourself
+accept: visitor
+ ^ visitor visitStarMessagePredicateNode: self
! !
--- a/compiler/PPCStarNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCStarNode.st Fri May 01 14:04:37 2015 +0200
@@ -21,34 +21,6 @@
prefix
^ #star
-!
-
-rewrite: changeStatus
- (child isKindOf: PPCMessagePredicateNode) ifTrue: [
- changeStatus change.
- ^ PPCStarMessagePredicateNode new
- name: name;
- child: child;
- message: child message;
- yourself
- ].
-
- (child isKindOf: PPCAnyNode) ifTrue: [
- changeStatus change.
- ^ PPCStarAnyNode new
- name: name;
- child: child;
- yourself
- ].
-
- (child isKindOf: PPCCharSetPredicateNode) ifTrue: [
- changeStatus change.
- ^ PPCStarCharSetPredicateNode new
- name: name;
- predicate: child predicate;
- child: child;
- yourself
- ]
! !
!PPCStarNode methodsFor:'analyzing'!
@@ -57,28 +29,6 @@
^ true
! !
-!PPCStarNode methodsFor:'as yet unclassified'!
-
-compileWith: compiler effect: effect id: id
- compiler startMethod: id.
- compiler addVariable: 'retval'.
- compiler addVariable: 'element'.
-
- compiler add: 'retval := OrderedCollection new.'.
- compiler add: 'element := '.
- compiler callOnLine: (child compileWith: compiler).
- compiler add: '[ error ] whileFalse: ['.
- compiler indent.
- compiler add: 'retval add: element.'.
- compiler add: 'element := '.
- compiler callOnLine: (child compileWith: compiler).
- compiler dedent.
- compiler add: '].'.
- compiler add: 'self clearError.'.
- compiler add: '^ retval asArray'.
- ^ compiler stopMethod.
-! !
-
!PPCStarNode methodsFor:'first follow next'!
followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet suchThat: aBlock
@@ -86,6 +36,15 @@
super followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet suchThat: aBlock.
first := aFirstDictionary at: self.
- (aFollowDictionary at: child) 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
+! !
+
--- a/compiler/PPCSymbolActionNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCSymbolActionNode.st Fri May 01 14:04:37 2015 +0200
@@ -10,23 +10,20 @@
!
-!PPCSymbolActionNode methodsFor:'as yet unclassified'!
+!PPCSymbolActionNode methodsFor:'accessing'!
-asFast
- ^ PPCTokenActionNode new
- child: child;
- name: self name;
- yourself
+symbol
+ ^ self block
!
-compileWith: compiler effect: effect id: id
- compiler startMethod: id.
- compiler addVariable: 'element'.
- compiler add: 'element := '.
- compiler callOnLine: (child compileWith: compiler).
- compiler add: 'error ifFalse: [ ^ element ', block asString, ' ].'.
- compiler add: '^ failure'.
- ^ compiler stopMethod.
+symbol: aSymbol
+ self block: aSymbol
+! !
+
+!PPCSymbolActionNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitSymbolActionNode: self
! !
!PPCSymbolActionNode class methodsFor:'documentation'!
--- a/compiler/PPCTokenActionNode.st Fri May 01 13:44:43 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,58 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-"{ NameSpace: Smalltalk }"
-
-PPCActionNode subclass:#PPCTokenActionNode
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Nodes'
-!
-
-!PPCTokenActionNode methodsFor:'as yet unclassified'!
-
-asFast
- ^ self
-!
-
-compileWith: compiler effect: effect id: id
- | |
- compiler addConstant: block as: id.
-
- "
- Actually, do nothing, we are in Token mode and the
- child does not return any result and token takes only
- the input value.
- "
- compiler startMethod: id.
- compiler add: '^ '.
- compiler callOnLine: (child compileWith: compiler).
- ^ compiler stopMethod.
-!
-
-rewrite: changeStatus
- (self hasProperty: #trimmingToken) ifTrue: [
- | retval |
- changeStatus change.
- "Get rid of action and sequence with whitespace"
- retval := child children second child. "JK: oups, what a chain!!"
- retval name ifNil: [ retval name: self name ].
- ^ retval
- ].
-
- child name ifNil: [
- changeStatus change.
- child name: self name.
- ^ child
- ].
-
- (child name = self name) ifTrue: [
- changeStatus change.
- ^ child
- ]
-!
-
-suffix
- ^ '_fast'
-! !
-
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCTokenConsumeNode.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,21 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCDelegateNode subclass:#PPCTokenConsumeNode
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Nodes'
+!
+
+!PPCTokenConsumeNode methodsFor:'as yet unclassified'!
+
+accept: visitor
+ ^ visitor visitTokenConsumeNode: self
+!
+
+prefix
+ ^ #consume
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCTokenDetector.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,67 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCRewritingVisitor subclass:#PPCTokenDetector
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Visitors'
+!
+
+!PPCTokenDetector methodsFor:'visiting'!
+
+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.
+
+ ^ PPCTrimmingTokenNode new
+ name: node name;
+ child: newChild;
+ tokenClass: node child children second tokenClass;
+ whitespace: newWs;
+ yourself.
+ ].
+
+ ^ 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: child.
+ node replace: child with: newChild.
+
+ ^ node
+!
+
+visitWithTokenVisitor: node
+ | 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
+! !
+
--- a/compiler/PPCTokenNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCTokenNode.st Fri May 01 14:04:37 2015 +0200
@@ -11,18 +11,8 @@
!PPCTokenNode methodsFor:'accessing'!
-initialize
- super initialize.
-!
-
-rewrite: changeStatus
- | |
- super rewrite: changeStatus.
-
- (self allNodes anySatisfy: [ :node | node asFast ~= node ]) ifTrue: [
- changeStatus change.
- self replace: child with: (child transform: [:node | node asFast]).
- ]
+prefix
+ ^ #token
!
tokenClass
@@ -33,31 +23,10 @@
tokenClass: anObject
tokenClass := anObject
-! !
-
-!PPCTokenNode methodsFor:'as yet unclassified'!
-
-compileWith: compiler effect: effect id: id
- | |
-
- compiler startMethod: id.
- compiler addVariable: 'start'.
- compiler addVariable: 'end'.
-
- compiler add: 'start := context position + 1.'.
- compiler call: (self child compileWith: compiler).
- compiler add: 'error ifTrue: [ ^ self ].'.
- compiler add: 'end := context position.'.
-
- compiler add: '^ ', tokenClass asString, ' on: (context collection)
- start: start
- stop: end
- value: nil'.
- ^ compiler stopMethod.
!
-prefix
- ^ #token
+tokenType
+ ^ self identityHash printString
! !
!PPCTokenNode methodsFor:'comparing'!
@@ -71,3 +40,9 @@
^ super hash bitXor: tokenClass hash
! !
+!PPCTokenNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitTokenNode: self
+! !
+
--- a/compiler/PPCTokenSequenceNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCTokenSequenceNode.st Fri May 01 14:04:37 2015 +0200
@@ -10,35 +10,18 @@
!
-!PPCTokenSequenceNode methodsFor:'as yet unclassified'!
-
-asFast
- ^ self
-!
-
-compileWith: compiler effect: effect id: id
-
- compiler startMethod: id.
- compiler addVariable: 'memento'.
- compiler add: (compiler smartRemember: self).
-
-" self addGuard: compiler."
-
- compiler call: ((children at: 1) compileWith: compiler).
- compiler add: 'error ifTrue: [ ^ failure ].'.
-
- (2 to: children size) do: [ :idx | |child|
- child := children at: idx.
- compiler call: (child compileWith: compiler).
- compiler add: 'error ifTrue: [ ', (compiler smartRestore: self) ,' ^ failure ].'.
- ].
- ^ compiler stopMethod.
-!
+!PPCTokenSequenceNode methodsFor:'accessing'!
suffix
^ #'_fast'
! !
+!PPCTokenSequenceNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitTokenSequenceNode: self
+! !
+
!PPCTokenSequenceNode class methodsFor:'documentation'!
version_HG
--- a/compiler/PPCTokenStarMessagePredicateNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCTokenStarMessagePredicateNode.st Fri May 01 14:04:37 2015 +0200
@@ -9,40 +9,9 @@
category:'PetitCompiler-Nodes'
!
-!PPCTokenStarMessagePredicateNode methodsFor:'as yet unclassified'!
-
-asFast
- ^ self
-!
-
-asInlined
- ^ PPCInlineTokenStarMessagePredicateNode new
- name: name;
- message: message;
- child: child;
- yourself
-!
+!PPCTokenStarMessagePredicateNode methodsFor:'visiting'!
-compileWith: compiler effect: effect id: id
- compiler startMethod: id.
- compiler add: '[ context peek ', message,' ] whileTrue: ['.
- compiler indent.
- compiler add: 'context next'.
- compiler indent.
- compiler dedent.
- compiler add: '].'.
- ^ compiler stopMethod.
-!
-
-rewrite: changeStatus
-
- (message = #isSeparator) ifTrue: [
- changeStatus change.
- ^ PPCTokenStarSeparatorNode new
- name: name;
- child: child;
- message: message;
- yourself.
- ]
+accept: visitor
+ ^ visitor visitTokenStarMessagePredicateNode: self
! !
--- a/compiler/PPCTokenStarSeparatorNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCTokenStarSeparatorNode.st Fri May 01 14:04:37 2015 +0200
@@ -9,23 +9,9 @@
category:'PetitCompiler-Nodes'
!
-!PPCTokenStarSeparatorNode methodsFor:'as yet unclassified'!
+!PPCTokenStarSeparatorNode methodsFor:'visiting'!
-asInlined
- ^ PPCInlineTokenStarSeparatorNode new
- message: message;
- name: name;
- child: child;
- yourself
-!
-
-compileWith: compiler effect: effect id: id
- compiler startMethod: id.
- compiler add: 'context skipSeparators.'.
- ^ compiler stopMethod.
-!
-
-rewrite: changeStatus
- "Nothing to do"
+accept: visitor
+ ^ visitor visitTokenStarSeparatorNode: self
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCTokenVisitor.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,94 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCRewritingVisitor subclass:#PPCTokenVisitor
+ instanceVariableNames:'forbiddenNodes'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Visitors'
+!
+
+!PPCTokenVisitor methodsFor:'accessing'!
+
+forbiddenNodes: nodeSet
+ forbiddenNodes := nodeSet.
+! !
+
+!PPCTokenVisitor methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ forbiddenNodes := IdentitySet new.
+! !
+
+!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.
+
+ (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
+!
+
+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
+!
+
+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>"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCTokenizingCodeGenerator.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,62 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCCodeGenerator subclass:#PPCTokenizingCodeGenerator
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Visitors'
+!
+
+!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: '].'
+ ].
+
+ compiler codeError: 'no choice found'.
+!
+
+visitTokenConsumeNode: node
+ compiler codeReturn: 'self consume: ', (compiler idFor: node child) storeString, '.'
+!
+
+visitTokenNode: node
+ | tokenType |
+ self assert: node isMarkedForInline.
+
+ super visitTokenNode: node.
+
+ tokenType := compiler idFor: node.
+
+ compiler codeAssign: tokenType storeString, '.' to: 'currentTokenType'.
+ compiler codeAssign: self retvalVar, '.' to: 'currentTokenValue'.
+! !
+
--- a/compiler/PPCTrimNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCTrimNode.st Fri May 01 14:04:37 2015 +0200
@@ -15,29 +15,9 @@
^ #trim
! !
-!PPCTrimNode methodsFor:'compiling'!
-
-compileWith: compiler effect: effect id: id
- "TODO: This ignores the TrimmingParser trimmer object!!"
- compiler startMethod: id.
- compiler addVariable: 'result'.
+!PPCTrimNode methodsFor:'visiting'!
- compiler add: '[context atEnd not and: [ context uncheckedPeek isSeparator ]] whileTrue: ['.
- compiler indent.
- compiler add: 'context next'.
- compiler dedent.
- compiler add: '].'.
-
- compiler add: 'result := '.
- compiler callOnLine: (child compileWith: compiler).
-
- compiler add: '[context atEnd not and: [ context uncheckedPeek isSeparator ]] whileTrue: ['.
- compiler indent.
- compiler add: 'context next'.
- compiler dedent.
- compiler add: '].'.
-
- compiler add: '^ result'.
- ^ compiler stopMethod.
+accept: visitor
+ ^ visitor visitTrimNode: self
! !
--- a/compiler/PPCTrimmingTokenNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCTrimmingTokenNode.st Fri May 01 14:04:37 2015 +0200
@@ -21,47 +21,8 @@
children at: 2 put: anObject
!
-compileFirstWhitespace: compiler
- compiler call: (self whitespace compileWith: compiler).
-!
-
-compileSecondWhitespace: compiler
- | root follow |
- root := compiler rootNode.
-
- follow := self followSetWithTokens.
-
- (follow allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [
- compiler add: '"second water skipped because there are only trimming tokens in the follow"'
- ] ifFalse: [
- compiler add: '"second water compiled because some of the follow parsers are not trimming toknes"'.
- compiler call: (self whitespace compileWith: compiler).
- ]
-!
-
-compileWhitespace: compiler
- compiler add: 'context atWs ifFalse: ['.
- compiler indent.
- compiler call: (self whitespace compileWith: compiler).
- compiler add: 'context setWs.'.
- compiler dedent.
- compiler add: '].'.
-!
-
-initialize
- super initialize.
- children := Array new: 2
-!
-
-rewrite: changeStatus
- | |
- super rewrite: changeStatus.
-
- (self allNodes anySatisfy: [ :node | node asFast ~= node ]) ifTrue: [
- changeStatus change.
- self replace: self whitespace with: (self whitespace transform: [ :node | node asFast ]).
- self replace: self child with: (self child transform: [:node | node asFast]).
- ]
+prefix
+ ^ #token
!
tokenClass
@@ -117,44 +78,6 @@
]
! !
-!PPCTrimmingTokenNode methodsFor:'as yet unclassified'!
-
-compileWith: compiler effect: effect id: id
- | guard |
-
- compiler startMethod: id.
- compiler addVariable: 'start'.
- compiler addVariable: 'end'.
-
- "self compileFirstWhitespace: compiler."
- self compileWhitespace: compiler.
-
- (compiler guards and: [(guard := PPCGuard on: self) makesSense]) ifTrue: [
- compiler add: 'context atEnd ifTrue: [ ^ self error ].'.
- guard id: id, '_guard'.
- guard compileGuard: compiler.
- compiler addOnLine: 'ifFalse: [ ^ self error ].'
- ].
-
- compiler add: 'start := context position + 1.'.
- compiler call: (self child compileWith: compiler).
- compiler add: 'error ifTrue: [ ^ self ].'.
- compiler add: 'end := context position.'.
-
-" self compileSecondWhitespace: compiler."
- self compileWhitespace: compiler.
-
- compiler add: '^ ', tokenClass asString, ' on: (context collection)
- start: start
- stop: end
- value: nil'.
- ^ compiler stopMethod.
-!
-
-prefix
- ^ #token
-! !
-
!PPCTrimmingTokenNode methodsFor:'comparing'!
= anotherNode
@@ -166,3 +89,16 @@
^ super hash bitXor: tokenClass hash
! !
+!PPCTrimmingTokenNode methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ children := Array new: 2
+! !
+
+!PPCTrimmingTokenNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitTrimmingTokenNode: self
+! !
+
--- a/compiler/PPCUnknownNode.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCUnknownNode.st Fri May 01 14:04:37 2015 +0200
@@ -52,7 +52,7 @@
^ #parser
! !
-!PPCUnknownNode methodsFor:'as yet unclassified'!
+!PPCUnknownNode methodsFor:'analysis'!
firstCharSet
^ parser firstCharSet
@@ -69,38 +69,18 @@
^ super hash bitXor: parser hash
! !
-!PPCUnknownNode methodsFor:'compiling'!
-
-compileWith: compiler effect: effect id: id
- | compiledChild compiledParser |
- compiler startMethod: id.
-
- compiledParser := parser copy.
- "Compile all the children and call compiled version of them instead of the original one"
- compiledParser children do: [ :child |
- compiledChild := child compileWith: compiler.
- compiledParser replace: child with: compiledChild bridge.
- ].
-
- compiler addConstant: compiledParser as: id.
-
- compiler addVariable: 'retval'.
- compiler add: 'self clearError.'.
- compiler add: '(retval := ', id, ' parseOn: context) isPetitFailure'.
- compiler indent.
- compiler add: ' ifTrue: [self error: retval message at: retval position ].'.
- compiler dedent.
- compiler add: 'error := retval isPetitFailure.'.
- compiler add: '^ retval'.
- ^ compiler stopMethod.
-! !
-
!PPCUnknownNode methodsFor:'transformation'!
replace: node with: anotherNode
parser replace: node with: anotherNode
! !
+!PPCUnknownNode methodsFor:'visiting'!
+
+accept: visitor
+ ^ visitor visitUnknownNode: self
+! !
+
!PPCUnknownNode class methodsFor:'documentation'!
version_HG
--- a/compiler/PPCompiledParser.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/PPCompiledParser.st Fri May 01 14:04:37 2015 +0200
@@ -3,13 +3,14 @@
"{ NameSpace: Smalltalk }"
PPParser subclass:#PPCompiledParser
- instanceVariableNames:'startSymbol context failure error'
+ instanceVariableNames:'startSymbol context failure error currentTokenValue
+ currentTokenType'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Core'
!
-PPCompiledParser class instanceVariableNames:'parsers constants referringParser'
+PPCompiledParser class instanceVariableNames:'parsers constants referringParser startSymbol'
"
No other class instance variables are inherited by this class.
@@ -19,18 +20,12 @@
!PPCompiledParser class methodsFor:'as yet unclassified'!
addConstant: value as: id
- self constants at: id ifPresent: [:ignored |
+ self constants at: id ifPresent: [
((self constants at: id) = value) ifFalse: [self error: 'ooups']].
self constants at: id put: value.
!
-addParser: aPPParser as: id
-
- "(self parsers includesKey: id) ifTrue: [self error: 'Ooups' ]."
- self parsers at: id put: aPPParser.
-!
-
constants
constants ifNil: [ constants := IdentityDictionary new ].
^ constants
@@ -40,17 +35,20 @@
^ self new parse: input
!
-parsers
- parsers ifNil: [ parsers := IdentityDictionary new ].
- ^ parsers
-!
-
referringParser
- ^ referringParser
+ ^ referringParser ifNil: [ ^ PPSentinel new ]
!
referringParser: aPPParser
referringParser := aPPParser
+!
+
+startSymbol
+ ^ startSymbol ifNil: [ ^ #start ]
+!
+
+startSymbol: symbol
+ startSymbol := symbol
! !
!PPCompiledParser methodsFor:'as yet unclassified'!
@@ -91,10 +89,9 @@
self instVarNamed: key put: value.
].
- startSymbol := #start.
+ startSymbol := self class startSymbol.
-
!
isCompiled
@@ -116,10 +113,6 @@
startSymbol: aSymbol
startSymbol := aSymbol
-!
-
-updateContext: aPPContext
- self class referringParser allParsersDo: [ :p | p updateContext: aPPContext ].
! !
!PPCompiledParser methodsFor:'parsing'!
@@ -141,3 +134,30 @@
^ 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
+! !
+
--- a/compiler/abbrev.stc Fri May 01 13:44:43 2015 +0200
+++ b/compiler/abbrev.stc Fri May 01 14:04:37 2015 +0200
@@ -1,69 +1,71 @@
# 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.
+PPCArguments PPCArguments stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
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
+PPCConfiguration PPCConfiguration stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCContext PPCContext stx:goodies/petitparser/compiler 'PetitCompiler-Context' 0
PPCContextMemento PPCContextMemento stx:goodies/petitparser/compiler 'PetitCompiler-Context' 0
PPCGuard PPCGuard stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCMethod PPCMethod stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
-PPCMethodStrategy PPCMethodStrategy stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 1
PPCNode PPCNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCOptimizationResult PPCOptimizationResult stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCompiledParser PPCompiledParser stx:goodies/petitparser/compiler 'PetitCompiler-Core' 3
+PPCNodeVisitor PPCNodeVisitor stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
+PPCompiledParser PPCompiledParser stx:goodies/petitparser/compiler 'PetitCompiler-Core' 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
PPCAbstractPredicateNode PPCAbstractPredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCAnyNode PPCAnyNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
+PPCCodeGenerator PPCCodeGenerator stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
PPCDelegateNode PPCDelegateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
+PPCEndOfFileNode PPCEndOfFileNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
+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
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
PPCUnknownNode PPCUnknownNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCAbstractActionNode PPCAbstractActionNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCAndNode PPCAndNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCCharSetPredicateNode PPCCharSetPredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
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
PPCForwardNode PPCForwardNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCInlineAnyNode PPCInlineAnyNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCInlineCharacterNode PPCInlineCharacterNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCInlineNilNode PPCInlineNilNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCInlinePluggableNode PPCInlinePluggableNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 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
PPCNegateNode PPCNegateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCNotCharSetPredicateNode PPCNotCharSetPredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
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
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
PPCSentinelNode PPCSentinelNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 1
PPCSequenceNode PPCSequenceNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 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
+PPCTokenizingCodeGenerator PPCTokenizingCodeGenerator stx:goodies/petitparser/compiler 'PetitCompiler-Visitors' 0
PPCTrimNode PPCTrimNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCTrimmingTokenNode PPCTrimmingTokenNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCActionNode PPCActionNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCInlineCharSetPredicateNode PPCInlineCharSetPredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCInlineLiteralNode PPCInlineLiteralNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCInlineMessagePredicateNode PPCInlineMessagePredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCInlineNotCharSetPredicateNode PPCInlineNotCharSetPredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCInlineNotLiteralNode PPCInlineNotLiteralNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCInlineNotMessagePredicateNode PPCInlineNotMessagePredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
+PPCLLChoiceNode PPCLLChoiceNode 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
-PPCTokenActionNode PPCTokenActionNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCTokenStarMessagePredicateNode PPCTokenStarMessagePredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCInlineTokenStarMessagePredicateNode PPCInlineTokenStarMessagePredicateNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
PPCTokenStarSeparatorNode PPCTokenStarSeparatorNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
-PPCInlineTokenStarSeparatorNode PPCInlineTokenStarSeparatorNode stx:goodies/petitparser/compiler 'PetitCompiler-Nodes' 0
--- a/compiler/bc.mak Fri May 01 13:44:43 2015 +0200
+++ b/compiler/bc.mak Fri May 01 14:04:37 2015 +0200
@@ -35,7 +35,7 @@
-LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\analyzer -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\java -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2
LOCALDEFINES=
STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
@@ -54,8 +54,14 @@
pushd ..\..\..\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
pushd ..\..\refactoryBrowser\parser & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
pushd ..\..\..\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\..\libbasic3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\..\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
pushd .. & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
pushd ..\parsers\smalltalk & $(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) "
@@ -72,73 +78,75 @@
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)PPCArguments.$(O) PPCArguments.$(H): PPCArguments.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCBridge.$(O) PPCBridge.$(H): PPCBridge.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)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)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)
$(OUTDIR)PPCGuard.$(O) PPCGuard.$(H): PPCGuard.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCMethod.$(O) PPCMethod.$(H): PPCMethod.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCMethodStrategy.$(O) PPCMethodStrategy.$(H): PPCMethodStrategy.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCNode.$(O) PPCNode.$(H): PPCNode.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCOptimizationResult.$(O) PPCOptimizationResult.$(H): PPCOptimizationResult.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCNodeVisitor.$(O) PPCNodeVisitor.$(H): PPCNodeVisitor.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)
$(OUTDIR)PPCAbstractLiteralNode.$(O) PPCAbstractLiteralNode.$(H): PPCAbstractLiteralNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCAbstractPredicateNode.$(O) PPCAbstractPredicateNode.$(H): PPCAbstractPredicateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCAnyNode.$(O) PPCAnyNode.$(H): PPCAnyNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)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)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)PPCUnknownNode.$(O) PPCUnknownNode.$(H): PPCUnknownNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(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)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)PPCInlineAnyNode.$(O) PPCInlineAnyNode.$(H): PPCInlineAnyNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAnyNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCInlineCharacterNode.$(O) PPCInlineCharacterNode.$(H): PPCInlineCharacterNode.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)PPCInlineNilNode.$(O) PPCInlineNilNode.$(H): PPCInlineNilNode.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)PPCInlinePluggableNode.$(O) PPCInlinePluggableNode.$(H): PPCInlinePluggableNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCPluggableNode.$(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)
$(OUTDIR)PPCNegateNode.$(O) PPCNegateNode.$(H): PPCNegateNode.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)PPCNotCharSetPredicateNode.$(O) PPCNotCharSetPredicateNode.$(H): PPCNotCharSetPredicateNode.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)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)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)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)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)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)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)PPCInlineCharSetPredicateNode.$(O) PPCInlineCharSetPredicateNode.$(H): PPCInlineCharSetPredicateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractPredicateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCCharSetPredicateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCInlineLiteralNode.$(O) PPCInlineLiteralNode.$(H): PPCInlineLiteralNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractLiteralNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCLiteralNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCInlineMessagePredicateNode.$(O) PPCInlineMessagePredicateNode.$(H): PPCInlineMessagePredicateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractPredicateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCMessagePredicateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCInlineNotCharSetPredicateNode.$(O) PPCInlineNotCharSetPredicateNode.$(H): PPCInlineNotCharSetPredicateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractPredicateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNotCharSetPredicateNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCInlineNotLiteralNode.$(O) PPCInlineNotLiteralNode.$(H): PPCInlineNotLiteralNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractLiteralNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNotLiteralNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCInlineNotMessagePredicateNode.$(O) PPCInlineNotMessagePredicateNode.$(H): PPCInlineNotMessagePredicateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractPredicateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNotMessagePredicateNode.$(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)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)PPCTokenActionNode.$(O) PPCTokenActionNode.$(H): PPCTokenActionNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCAbstractActionNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCActionNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCDelegateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCTokenStarMessagePredicateNode.$(O) PPCTokenStarMessagePredicateNode.$(H): PPCTokenStarMessagePredicateNode.st $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCDelegateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCStarMessagePredicateNode.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\compiler\PPCStarNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCInlineTokenStarMessagePredicateNode.$(O) PPCInlineTokenStarMessagePredicateNode.$(H): PPCInlineTokenStarMessagePredicateNode.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)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)PPCInlineTokenStarSeparatorNode.$(O) PPCInlineTokenStarSeparatorNode.$(H): PPCInlineTokenStarSeparatorNode.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\goodies\petitparser\compiler\PPCTokenStarSeparatorNode.$(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\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\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 Fri May 01 13:44:43 2015 +0200
+++ b/compiler/benchmarks/Make.proto Fri May 01 14:04:37 2015 +0200
@@ -34,7 +34,7 @@
# add the path(es) here:,
# ********** OPTIONAL: MODIFY the next lines ***
# LOCALINCLUDES=-Ifoo -Ibar
-LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/compiler -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk -I$(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser -I$(INCLUDE_TOP)/stx/libbasic
+LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/compiler -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/java -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk -I$(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser -I$(INCLUDE_TOP)/stx/libbasic
# if you need any additional defines for embedded C code,
--- a/compiler/benchmarks/PPCBenchmark.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/benchmarks/PPCBenchmark.st Fri May 01 14:04:37 2015 +0200
@@ -50,13 +50,14 @@
!PPCBenchmark methodsFor:'benchmark support'!
+compile: value
+ compile := value
+!
+
createContext
^ contextClass new
!
-endSuite
-!
-
initialize
super initialize.
sources := PPCBenchmarkResources new.
@@ -64,19 +65,15 @@
compile := false.
!
-measure: parser on: input
- self measure: parser on: input name: #unknown
-!
-
measure: aParser on: anInput name: aString
| time result p |
context := self createContext.
- compile ifTrue: [
- p := (aParser end compile: #TmpBenchmark)
- ] ifFalse: [
- p := aParser end.
- ].
+ p := compile ifTrue: [
+ aParser end compile
+ ] ifFalse: [
+ aParser end
+ ].
time := Time millisecondsToRun: [ result := p parse: anInput withContext: context ].
@@ -85,32 +82,6 @@
self reportFor: aParser context: context input: anInput time: time name: aString.
!
-measure: parser onSources: inputs name: aString
- | time result context p totalInput |
-
- compile ifTrue: [
- p := (parser end compile: #TmpBenchmark)
- ] ifFalse: [
- p := parser end.
- ].
-
- totalInput := ''.
- time := 0.
- inputs do: [:input |
- context := self createContext.
- time := time + (Time millisecondsToRun: [ result := p parse: input withContext: context ]).
- totalInput := totalInput, input.
- self assert: result isPetitFailure not.
- ].
-
-
- self reportFor: parser context: context input: totalInput time: time name: aString.
-!
-
-reportFor: parser context: context input: input time: time
- self reportFor: parser context: context input: input time: time name: #unknown
-!
-
reportFor: aParser context: aContext input: anInput time: time name: name
Transcript crShow: (self getMetaInfo: name).
Transcript crShow: ' Compile: ', compile asString.
@@ -131,66 +102,16 @@
"
!
-startSuite
- Transcript crShow: Date current asString, ' ', Time current asString.
+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'.
! !
!PPCBenchmark methodsFor:'benchmarks'!
-benchmarkAnyStar
-"
- self measure: self anyStar on: sources petitParserPackage.
-"
- self measure: self anyStar on: (sources changesSized: 1000*1000) name: #anyStar.
-!
-
-benchmarkAnyStarBlock
-"
- self measure: self anyStar on: sources petitParserPackage.
-"
- self measure: self anyStarBlock on: (sources changesSized: 1000*1000) name: #anyStarBlock.
-!
-
-benchmarkAttributes
- | string text allStyles |
- string := (self changesSized: 60000).
- text := string asText.
- allStyles := {
- 'Announcement' -> TextColor green.
- 'Collections' -> TextColor blue.
- 'File' -> TextColor blue.
- 'Metacello' -> TextColor red.
- 'Monticello' -> TextColor magenta.
- 'Morphic' -> TextColor orange.
- 'Mooose' -> TextColor green.
- 'FAMIX' -> TextColor green.
- 'Roassal' -> TextColor green.
- }.
-
- allStyles do: [ :assoc | | parser result time |
- parser := (assoc key asParser, #newline asParser negate star).
- time := Time millisecondsToRun: [
- result := parser matchingRangesIn: string.
- ].
- self reportFor: parser input: string time: time.
- ].
-!
-
-benchmarkBacktrack
-"
- self measure: self anyStar on: sources petitParserPackage.
-"
- | parser |
- parser := ((#any asParser, 'foo' asParser) / self tokenParser / #any asParser) plus.
- self measure: parser on: (self changesSized: 100*1000) name: #backtrack.
-!
-
-benchmarkJava
- | parser |
- parser := PPJavaParser new.
- self measure: parser on: sources javaLangMath name: #java.
-!
-
benchmarkJavaSyntax
| time |
@@ -221,15 +142,6 @@
self reportInput: input time: time name: 'Java Syntax Compiled'.
!
-benchmarkNegate
-"
- self measure: self anyStar on: sources petitParserPackage.
-"
- | parser |
- parser := ('a' asParser negate star, 'a' asParser) star, #any asParser star.
- self measure: parser on: (self changesSized: 1000*1000) name: #negate.
-!
-
benchmarkOpalCompiler
| parser time input |
parser := OpalCompiler new.
@@ -270,12 +182,6 @@
"
!
-benchmarkSmalltalkObject
- | parser |
- parser := PPSmalltalkGrammar new.
- self measure: parser onSources: sources smalltalkObjectMethods name: #smalltalkObject.
-!
-
benchmarkSmalltalkParser
| time |
parser := PPSmalltalkParser new.
@@ -298,23 +204,30 @@
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 changesSized: 1000*1000) name: #anyStar.
+!
+
+benchmarkAnyStarBlock
+"
+ self measure: self anyStar on: sources petitParserPackage.
+"
+ self measure: self anyStarBlock on: (sources changesSized: 1000*1000) name: #anyStarBlock.
!
benchmarkToken
"
self measure: self anyStar on: sources petitParserPackage.
"
- | parser |
parser := (self tokenParser / #any asParser) star.
- self measure: parser on: (self changesSized: 1000*1000) name: #token.
-!
-
-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'.
+ self measure: parser on: (sources changesSized: 1000*1000) name: #token.
! !
!PPCBenchmark methodsFor:'benchmarks-CalipeL'!
@@ -374,79 +287,27 @@
! !
-!PPCBenchmark methodsFor:'meta'!
-
-getMetaInfo: key
- | info |
- info := self metaInfo select: [ :each | each key = key ].
- info isEmpty ifTrue: [ ^ 'unknown benchmark' ].
- ^ info anyOne value
-!
-
-metaInfo
- ^ {
- #anyStar -> '.* Parser'.
- #token -> 'Token Parser'.
- #anyStarBlock -> 'context next in loop'.
- }
-! !
-
-!PPCBenchmark methodsFor:'parsers'!
-
-anyStar
- ^ #any asParser star
-!
-
-anyStarBlock
- ^ [ :ctx | [ctx atEnd] whileFalse: [ ctx next ] ] asParser
-!
-
-tokenParser
- ^ #letter asParser, (#letter asParser / #digit asParser) star trim
-! !
-
-!PPCBenchmark methodsFor:'settings'!
-
-compile: aBoolean
- compile := aBoolean
-!
-
-contextClass: aClass
- contextClass := aClass
-! !
-
-!PPCBenchmark methodsFor:'setup & teardown-CalipeL'!
+!PPCBenchmark methodsFor:'benchmarks-CalipeL- setup & teardown'!
setupJavaSyntaxC
-
- ((Smalltalk respondsTo:#isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifTrue:[
- BenchmarkSkipRequest signal.
- ].
-
- parser := PPJavaSyntax new.
- context := PPCContext new.
- context initializeFor: parser.
- input := sources javaSourcesBig.
-
- "Modified: / 20-04-2015 / 12:55:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+
+ parser := PPJavaSyntax new.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources javaSourcesBig.
!
setupJavaSyntaxCompiledC
- ((Smalltalk respondsTo:#isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifTrue:[
- BenchmarkSkipRequest signal.
- ].
- 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.
-"
- 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'.
"
-
- "Modified: / 20-04-2015 / 12:55:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setupRBParserC
@@ -497,9 +358,7 @@
!
teardownJavaSyntaxCompiledC
- parser notNil ifTrue:[
- parser class removeFromSystem.
- ].
+ parser class removeFromSystem.
"
size := input inject: 0 into: [:r :e | r + e size ].
Transcript crShow: 'Compiled Grammar time: ', time asString.
@@ -508,9 +367,7 @@
!
teardownSmalltalkGrammarCompiledC
- parser notNil ifTrue:[
- parser class removeFromSystem.
- ].
+ parser class removeFromSystem.
"
size := input inject: 0 into: [:r :e | r + e size ].
Transcript crShow: 'Compiled Grammar time: ', time asString.
@@ -527,28 +384,36 @@
"
! !
-!PPCBenchmark methodsFor:'sources'!
+!PPCBenchmark methodsFor:'meta'!
-changesSized: size
- | string changes |
- changes := PharoFilesOpener default changesFileOrNil contents.
- string := changes copyFrom: 1 to: size.
- ^ string
-
+getMetaInfo: key
+ | 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'.
+ }
! !
-!PPCBenchmark methodsFor:'suites'!
+!PPCBenchmark methodsFor:'parsers'!
+
+anyStar
+ ^ #any asParser star
+!
-suite1
- self startSuite.
-
- self benchmarkNegate.
- self benchmarkBacktrack.
- self benchmarkToken.
- self benchmarkAnyStar.
- self benchmarkJava.
-
- self endSuite.
+anyStarBlock
+ ^ [ :ctx | [ctx atEnd] whileFalse: [ ctx next ] ] asParser
+!
+
+tokenParser
+ ^ #letter asParser, (#letter asParser / #digit asParser) star trim
! !
!PPCBenchmark class methodsFor:'documentation'!
--- a/compiler/benchmarks/PPCBenchmarkResources.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/benchmarks/PPCBenchmarkResources.st Fri May 01 14:04:37 2015 +0200
@@ -25,14 +25,11 @@
files := self readDirectory: directory.
files := self files: files withExtension: 'java'.
- ^ files collect: [ :f | (FileStream fileNamed: f) contents asString ]
-!
-
-javaLangClass
+ ^ files collect: [ :f | (FileStream fileNamed: f) contents ]
!
javaLangMath
- ^ (FileStream fileNamed: '../java-src/java/lang/Math.java') contents asString
+ ^ (FileStream fileNamed: '../java-src/java/lang/Math.java') contents
!
javaSourcesBig
@@ -40,3931 +37,12 @@
"^ self workingJavaInDirectory: '../java-src/java/util'"
!
-petitParserPackage
-^ '
-Object subclass: #PPCharSetPredicate
- instanceVariableNames: ''block classification''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Tools''!!
-!!PPCharSetPredicate commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPCharSetPredicate methodsFor: ''initialization'' stamp: ''lr 8/30/2010 12:19''!!
-initializeOn: aBlock
- block := aBlock.
- classification := Array new: 255.
- 1 to: classification size do: [ :index |
- classification at: index put: (block
- value: (Character value: index)) ]!! !!
-
-
-!!PPCharSetPredicate methodsFor: ''evaluating'' stamp: ''lr 8/30/2010 12:19''!!
-value: aCharacter
- | index |
- index := aCharacter asInteger.
- index == 0
- ifTrue: [ ^ block value: aCharacter ].
- index > 255
- ifTrue: [ ^ block value: aCharacter ].
- ^ classification at: index!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPCharSetPredicate class
- instanceVariableNames: ''''!!
-!!PPCharSetPredicate class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPCharSetPredicate class methodsFor: ''instance creation'' stamp: ''lr 8/25/2010 11:05''!!
-on: aBlock
- ^ self basicNew initializeOn: aBlock!! !!
-
-
-PPDelegateParser subclass: #PPExpressionParser
- instanceVariableNames: ''operators''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Tools''!!
-!!PPExpressionParser commentStamp: ''<historical>'' prior: 0!!
-A PPExpressionParser is a parser to conveniently define an expression grammar with prefix, postfix, and left- and right-associative infix operators.
-
-The following code initializes a parser for arithmetic expressions. First we instantiate an expression parser, a simple parser for expressions in parenthesis and a simple parser for integer numbers.
-
- expression := PPExpressionParser new.
- parens := $( asParser token trim , expression , $) asParser token trim
- ==> [ :nodes | nodes second ].
- integer := #digit asParser plus token trim
- ==> [ :token | token value asInteger ].
-
-Then we define on what term the expression grammar is built on:
-
- expression term: parens / integer.
-
-Finally we define the operator-groups in descending precedence. Note, that the action blocks receive both, the terms and the parsed operator in the order they appear in the parsed input.
-
- expression
- group: [ :g |
- g prefix: $- asParser token trim do: [ :op :a | a negated ] ];
- group: [ :g |
- g postfix: ''++'' asParser token trim do: [ :a :op | a + 1 ].
- g postfix: ''--'' asParser token trim do: [ :a :op | a - 1 ] ];
- group: [ :g |
- g right: $^ asParser token trim do: [ :a :op :b | a raisedTo: b ] ];
- group: [ :g |
- g left: $* asParser token trim do: [ :a :op :b | a * b ].
- g left: $/ asParser token trim do: [ :a :op :b | a / b ] ];
- group: [ :g |
- g left: $+ asParser token trim do: [ :a :op :b | a + b ].
- g left: $- asParser token trim do: [ :a :op :b | a - b ] ].
-
-After evaluating the above code the ''expression'' is an efficient parser that evaluates examples like:
-
- expression parse: ''-8++''.
- expression parse: ''1+2*3''.
- expression parse: ''1*2+3''.
- expression parse: ''(1+2)*3''.
- expression parse: ''8/4/2''.
- expression parse: ''8/(4/2)''.
- expression parse: ''2^2^3''.
- expression parse: ''(2^2)^3''.
-
-Instance Variables:
- operators <Dictionary> The operators defined in the current group.!!
-
-
-!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!!
-build: aParser right: aChoiceParser
- ^ (aParser separatedBy: aChoiceParser) foldRight: [ :a :op :b | op first value: a value: op second value: b ]!! !!
-
-!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!!
-build: aParser left: aChoiceParser
- ^ (aParser separatedBy: aChoiceParser) foldLeft: [ :a :op :b | op first value: a value: op second value: b ]!! !!
-
-!!PPExpressionParser methodsFor: ''private'' stamp: ''lr 12/4/2009 17:38''!!
-build: aParser postfix: aChoiceParser
- ^ aParser , aChoiceParser star map: [ :term :ops | ops inject: term into: [ :result :operator | operator first value: result value: operator second ] ]!! !!
-
-!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 21:15''!!
-buildOn: aParser
- ^ self buildSelectors inject: aParser into: [ :term :selector |
- | list |
- list := operators at: selector ifAbsent: [ #() ].
- list isEmpty
- ifTrue: [ term ]
- ifFalse: [
- self
- perform: selector with: term
- with: (list size = 1
- ifTrue: [ list first first ==> [ :operator | Array with: list first second with: operator ] ]
- ifFalse: [
- list
- inject: PPChoiceParser new
- into: [ :choice :each | choice / (each first ==> [ :operator | Array with: each second with: operator ]) ] ]) ] ]!! !!
-
-!!PPExpressionParser methodsFor: ''private'' stamp: ''lr 12/4/2009 17:39''!!
-build: aParser prefix: aChoiceParser
- ^ aChoiceParser star , aParser map: [ :ops :term | ops reversed inject: term into: [ :result :operator | operator first value: operator second value: result ] ]!! !!
-
-!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!!
-buildSelectors
- ^ #(build:prefix: build:postfix: build:right: build:left:)!! !!
-
-!!PPExpressionParser methodsFor: ''private'' stamp: ''lr 2/7/2010 23:23''!!
-operator: aSymbol parser: aParser do: aBlock
- parser isNil
- ifTrue: [ ^ self error: ''You did not specify a term when creating the receiver.'' ].
- operators isNil
- ifTrue: [ ^ self error: ''Use #group: to define precedence groups in descending order.'' ].
- (operators at: aSymbol ifAbsentPut: [ OrderedCollection new ])
- addLast: (Array with: aParser asParser with: aBlock)!! !!
-
-
-!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 21:26''!!
-term: aParser
- "Defines the initial term aParser of the receiver."
-
- parser isNil
- ifTrue: [ parser := aParser ]
- ifFalse: [ self error: ''Unable to redefine the term.'' ]!! !!
-
-!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!
-postfix: aParser do: aTwoArgumentBlock
- "Define a postfix operator aParser. Evaluate aTwoArgumentBlock with the term and the operator."
-
- self operator: #build:postfix: parser: aParser do: aTwoArgumentBlock!! !!
-
-!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!
-left: aParser do: aThreeArgumentBlock
- "Define an operator aParser that is left-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term."
-
- self operator: #build:left: parser: aParser do: aThreeArgumentBlock!! !!
-
-!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!
-prefix: aParser do: aTwoArgumentBlock
- "Define a prefix operator aParser. Evaluate aTwoArgumentBlock with the operator and the term."
-
- self operator: #build:prefix: parser: aParser do: aTwoArgumentBlock!! !!
-
-!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!
-right: aParser do: aThreeArgumentBlock
- "Define an operator aParser that is right-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term."
-
- self operator: #build:right: parser: aParser do: aThreeArgumentBlock!! !!
-
-!!PPExpressionParser methodsFor: ''specifying'' stamp: ''lr 2/7/2010 23:20''!!
-group: aOneArgumentBlock
- "Defines a priority group by evaluating aOneArgumentBlock."
-
- operators := Dictionary new.
- parser := [
- aOneArgumentBlock value: self.
- self buildOn: parser ]
- ensure: [ operators := nil ]!! !!
-
-
-PPDelegateParser subclass: #PPCompositeParser
- instanceVariableNames: ''dependencies''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Tools''!!
-!!PPCompositeParser commentStamp: ''lr 12/4/2009 18:38'' prior: 0!!
-A PPCompositeParser is composed parser built from various primitive parsers.
-
-Every production in the receiver is specified as a method that returns its parser. Note that every production requires an instance variable of the same name, otherwise the production is not cached and cannot be used in recursive grammars. Productions should refer to each other by reading the respective inst-var. Note: these inst-vars are typically not written, as the assignment happens in the initialize method using reflection.
-
-The start production is defined in the method start. It is aliased to the inst-var parser defined in the superclass of PPCompositeParser.!!
-
-
-!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 6/4/2010 13:37''!!
-productionAt: aSymbol ifAbsent: aBlock
- "Answer the production named aSymbol, if there is no such production answer the result of evaluating aBlock."
-
- (self class ignoredNames includes: aSymbol asString)
- ifTrue: [ ^ aBlock value ].
- (self class startSymbol = aSymbol)
- ifTrue: [ ^ parser ].
- ^ self instVarAt: (self class allInstVarNames
- indexOf: aSymbol asString
- ifAbsent: [ ^ aBlock value ])!! !!
-
-!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 5/8/2011 15:45''!!
-productionNames
- "Answer a dictionary of slot indexes and production names."
-
- | productionNames ignoredNames |
- productionNames := Dictionary new.
- ignoredNames := self class ignoredNames
- collect: [ :each | each asSymbol ].
- self class allInstVarNames keysAndValuesDo: [ :key :value |
- (ignoredNames includes: value asSymbol)
- ifFalse: [ productionNames at: key put: value asSymbol ] ].
- ^ productionNames!! !!
-
-!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 3/16/2013 21:41''!!
-dependencyAt: aClass
- "Answer the dependent parser aClass. Throws an error if this parser class is not declared in the method #dependencies on the class-side of the receiver."
-
- ^ dependencies at: aClass ifAbsent: [ self error: ''Undeclared dependency in '' , self class name , '' to '' , aClass name ]!! !!
-
-!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 12/4/2009 18:39''!!
-productionAt: aSymbol
- "Answer the production named aSymbol."
-
- ^ self productionAt: aSymbol ifAbsent: [ nil ]!! !!
-
-
-!!PPCompositeParser methodsFor: ''initialization'' stamp: ''lr 3/16/2013 17:15''!!
-initializeStartingAt: aSymbol dependencies: aDictionary
- self initialize.
- parser := PPDelegateParser named: aSymbol.
- self productionNames keysAndValuesDo: [ :key :value |
- self instVarAt: key put: (PPDelegateParser named: value) ].
- dependencies := aDictionary!! !!
-
-
-!!PPCompositeParser methodsFor: ''accessing'' stamp: ''lr 5/16/2008 17:32''!!
-start
- "Answer the production to start this parser with."
-
- self subclassResponsibility!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPCompositeParser class
- instanceVariableNames: ''''!!
-!!PPCompositeParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 1/29/2010 11:35''!!
-ignoredNames
- "Answer a collection of instance-variables that should not be automatically initialized with productions, but that are used internal to the composite parser."
-
- ^ PPCompositeParser allInstVarNames!! !!
-
-!!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 12/7/2009 08:20''!!
-startSymbol
- "Answer the method that represents the default start symbol."
-
- ^ #start!! !!
-
-!!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 3/16/2013 21:42''!!
-dependencies
- "Answer a collection of PPCompositeParser classes that this parser directly dependends on. Override this method in subclasses to declare dependent parsers. The default implementation does not depend on other PPCompositeParser."
-
- ^ #()!! !!
-
-
-!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:40''!!
-debug: anObject startingAt: aSymbol onError: aBlock
- ^ (self newStartingAt: aSymbol) debug: anObject onError: aBlock!! !!
-
-!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:39''!!
-debug: anObject startingAt: aSymbol
- ^ (self newStartingAt: aSymbol) debug: anObject!! !!
-
-!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:40''!!
-debug: anObject onError: aBlock
- ^ self debug: anObject startingAt: self startSymbol onError: aBlock!! !!
-
-!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:39''!!
-debug: anObject
- ^ self debug: anObject startingAt: self startSymbol!! !!
-
-
-!!PPCompositeParser class methodsFor: ''instance creation'' stamp: ''lr 3/16/2013 21:21''!!
-newStartingAt: aSymbol
- "Answer a new parser starting at aSymbol. The code makes sure to resolve all dependent parsers correctly."
-
- | parsers remaining |
- parsers := IdentityDictionary new.
- remaining := OrderedCollection with: self.
- [ remaining isEmpty ] whileFalse: [
- | dependency |
- dependency := remaining removeLast.
- (parsers includesKey: dependency) ifFalse: [
- parsers at: dependency put: dependency basicNew.
- remaining addAll: dependency dependencies ] ].
- parsers keysAndValuesDo: [ :class :parser |
- | dependencies |
- dependencies := IdentityDictionary new.
- class dependencies
- do: [ :dependency | dependencies at: dependency put: (parsers at: dependency) ].
- parser
- initializeStartingAt: (class == self
- ifTrue: [ aSymbol ]
- ifFalse: [ class startSymbol ])
- dependencies: dependencies ].
- parsers keysAndValuesDo: [ :class :parser |
- parser setParser: (parser perform: parser children first name).
- parser productionNames keysAndValuesDo: [ :key :value |
- (parser instVarAt: key) setParser: (parser perform: value) ] ].
- ^ parsers at: self!! !!
-
-!!PPCompositeParser class methodsFor: ''instance creation'' stamp: ''lr 12/7/2009 08:24''!!
-new
- "Answer a new parser starting at the default start symbol."
-
- ^ self newStartingAt: self startSymbol!! !!
-
-
-!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 21:02''!!
-parse: anObject onError: aBlock
- ^ self parse: anObject startingAt: self startSymbol onError: aBlock!! !!
-
-!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 21:02''!!
-parse: anObject startingAt: aSymbol onError: aBlock
- ^ (self newStartingAt: aSymbol) parse: anObject onError: aBlock!! !!
-
-!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:57''!!
-parse: anObject startingAt: aSymbol
- ^ (self newStartingAt: aSymbol) parse: anObject!! !!
-
-!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:57''!!
-parse: anObject
- ^ self parse: anObject startingAt: self startSymbol!! !!
-
-
-PPParser subclass: #PPUnresolvedParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Tools''!!
-!!PPUnresolvedParser commentStamp: ''lr 11/28/2009 18:50'' prior: 0!!
-This is a temporary placeholder or forward reference to a parser that has not been defined yet. If everything goes well it will eventually be replaced with the real parser instance.!!
-
-
-!!PPUnresolvedParser methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:51''!!
-parseOn: aStream
- self error: self printString , '' need to be resolved before execution.''!! !!
-
-
-!!PPUnresolvedParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:15''!!
-displayColor
- ^ Color red!! !!
-
-
-!!PPUnresolvedParser methodsFor: ''testing'' stamp: ''lr 10/27/2008 11:29''!!
-isUnresolved
- ^ true!! !!
-Object subclass: #PPParser
- instanceVariableNames: ''properties''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPParser commentStamp: ''<historical>'' prior: 0!!
-An abstract parser for all parsers in PetitParser. Subclasses implement #parseOn: to perform the actual recursive-descent parsing. All parsers support a variety of methods to perform an actual parse, see the methods in the #parsing protocol. Parsers are combined with a series of operators that can be found in the #operations protocol.
-
-Instance Variables:
- properties <Dictionary> Stores additional state in the parser object.!!
-
-
-!!PPParser methodsFor: ''*petitjava-operations'' stamp: ''sback 9/2/2010 23:01''!!
-javaToken
- ^ PPJavaTokenParser on: self!! !!
-
-
-!!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 12/18/2013 06:41''!!
-gtInspectorParserInspectorIn: composite
- <gtInspectorPresentationOrder: 30>
- composite custom: (
- PPVerticalParserInspector new
- title: ''Sampler'';
- startOn: self)!! !!
-
-!!PPParser methodsFor: ''*petitgui'' stamp: ''AlexandreBergel 12/18/2013 16:40''!!
-gtGraphViewIn: composite
- <gtInspectorPresentationOrder: 50>
-
- composite roassal
- title: ''Graph'';
- painting: [ :view |
- self visualizeStructureInGraphOn: view.
- ].!! !!
-
-!!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 6/24/2013 23:44''!!
-gtNamedTreeViewIn: composite
- <gtInspectorPresentationOrder: 40>
-
- composite tree
- title: ''Named Tree'';
- children: [:n | n namedChildren ];
- format: [:n| n name ifNil: [ n asString ] ];
- shouldExpandToLevel: 3!! !!
-
-!!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 6/24/2013 23:44''!!
-gtTreeViewIn: composite
- <gtInspectorPresentationOrder: 40>
-
- composite tree
- title: ''Tree'';
- children: [:n | n children ];
- format: [:n| n name ifNil: [ n asString ] ifNotNil: [n name] ];
- shouldExpandToLevel: 6!! !!
-
-
-!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 1/30/2013 19:35''!!
-morphicShapeDefault
- ^ self newRowMorph
- addMorphBack: (self newColumnMorph
- addMorphBack: (self newSpacerMorph);
- addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)
- makeForwardArrow;
- yourself);
- addMorphBack: (self newRowMorph
- borderWidth: 1;
- layoutInset: 3;
- color: Color white;
- addMorphBack: (StringMorph new
- contents: self displayName;
- color: self displayColor;
- yourself);
- yourself);
- yourself!! !!
-
-!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 10:56''!!
-morphicProduction
- ^ self newRowMorph
- layoutInset: 4;
- addMorphBack: (self newRowMorph
- layoutInset: 4;
- addMorphBack: (StringMorph new
- contents: self displayName;
- emphasis: TextEmphasis bold emphasisCode;
- yourself);
- yourself);
- addMorphBack: (self morphicShapeSeen: IdentitySet new depth: 0);
- addMorphBack: (self newColumnMorph
- addMorphBack: (self newSpacerMorph);
- addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)
- makeForwardArrow;
- yourself);
- yourself!! !!
-
-!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/13/2009 13:24''!!
-morphicShapeSeen: aSet depth: anInteger
- ^ self morphicShapeDefault!! !!
-
-!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/13/2009 13:43''!!
-morphicShapeSeen: aSet depth: anInteger do: aBlock
- " avoid recursion "
- (aSet includes: self)
- ifTrue: [ ^ self morphicShapeDefault ].
- " display nice name when possible "
- (anInteger > 0 and: [ self name notNil ])
- ifTrue: [ ^ self morphicShapeDefault ].
- " don''t do it too deep "
- (anInteger > 10)
- ifTrue: [ ^ self morphicShapeDefault ].
- aSet add: self.
- ^ aBlock value: [ :parser |
- parser
- morphicShapeSeen: aSet
- depth: anInteger + 1 ]!! !!
-
-
-!!PPParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 10/30/2010 11:54''!!
-transform: aBlock
- "Answer a copy of all parsers reachable from the receiver transformed using aBlock."
-
- | mapping root |
- 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!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 4/13/2010 09:38''!!
-replace: aParser with: anotherParser
- "Replace the references of the receiver pointing to aParser with anotherParser."!! !!
-
-
-!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:55''!!
-namedChildrenDo: aBlock
- "Iterate over the named children of the receiver."
-
- self namedChildrenDo: aBlock seen: IdentitySet new!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:01''!!
-allNamedParsers
- "Answer all the named parse nodes of the receiver."
-
- | result |
- result := OrderedCollection new.
- self allNamedParsersDo: [ :parser | result addLast: parser ].
- ^ result!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:55''!!
-namedChildrenDo: aBlock seen: aSet
- "Iterate over the named children of the receiver."
-
- self children do: [ :each |
- (aSet includes: each)
- ifTrue: [ ^ self ].
- aSet add: each.
- each name isNil
- ifTrue: [ each namedChildrenDo: aBlock seen: aSet ]
- ifFalse: [ aBlock value: each ] ]!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 12/3/2010 16:45''!!
-innerChildren
- "Answer the inner children of the receiver."
-
- | result |
- result := OrderedCollection new.
- self innerChildrenDo: [ :parser | result addLast: parser ].
- ^ result!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 12/3/2010 16:51''!!
-innerChildrenDo: aBlock seen: aSet
- "Iterate over the inner children of the receiver."
-
- self children do: [ :each |
- (aSet includes: each)
- ifTrue: [ ^ self ].
- aSet add: each.
- each name isNil ifTrue: [
- aBlock value: each.
- each innerChildrenDo: aBlock seen: aSet ] ]!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 12/3/2010 16:48''!!
-innerChildrenDo: aBlock
- "Iterate over the inner children of the receiver."
-
- self innerChildrenDo: aBlock seen: IdentitySet new!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:12''!!
-allNamedParsersDo: aBlock
- "Iterate over all the named parse nodes of the receiver."
-
- self allParsersDo: [ :each |
- each name notNil
- ifTrue: [ aBlock value: each ] ]!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:55''!!
-namedChildren
- "Answer the named children of the receiver."
-
- | result |
- result := OrderedCollection new.
- self namedChildrenDo: [ :parser | result addLast: parser ].
- ^ result!! !!
-
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/11/2011 11:03''!!
-trimBlanks
- "Answer a new parser that consumes blanks before and after the receiving parser."
-
- ^ self trim: #blank asParser!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 2/19/2010 07:42''!!
-answer: anObject
- "Answer a new parser that always returns anObject from a successful parse."
-
- ^ self ==> [ :nodes | anObject ]!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/11/2011 11:03''!!
-trim: aParser
- "Answer a new parser that consumes and ignores aParser repeatedly before and after the receiving parser."
-
- ^ PPTrimmingParser on: self trimmer: aParser!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 5/6/2011 20:28''!!
-map: aBlock
- "Answer a new parser that works on the receiving sequence an passes in each element as a block argument."
-
- ^ aBlock numArgs = 1
- ifTrue: [ self ==> aBlock ]
- ifFalse: [ self error: aBlock numArgs asString , '' arguments expected.'' ]
-!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 6/29/2010 14:25''!!
-token
- "Answer a new parser that transforms the input to a token."
-
- ^ PPTokenParser on: self!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 4/3/2011 14:59''!!
-foldRight: aBlock
- "Answer a new parser that that folds the result of the receiver from right-to-left into aBlock. The argument aBlock must take two or more arguments."
-
- | size args |
- size := aBlock numArgs.
- args := Array new: size.
- ^ self ==> [ :nodes |
- args at: size put: nodes last.
- nodes size - size + 1 to: 1 by: 1 - size do: [ :index |
- args
- replaceFrom: 1 to: size - 1 with: nodes startingAt: index;
- at: size put: (aBlock valueWithArguments: args) ].
- args at: size ]!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/11/2011 11:03''!!
-trimSpaces
- "Answer a new parser that consumes spaces before and after the receiving parser."
-
- ^ self trim: #space asParser!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 5/15/2008 16:08''!!
-flatten
- "Answer a new parser that flattens the underlying collection."
-
- ^ PPFlattenParser on: self!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/31/2010 12:06''!!
-trim
- "Answer a new parser that consumes spaces before and after the receiving parser."
-
- ^ self trimSpaces!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 6/12/2010 10:20''!!
->=> aBlock
- "Answer a new parser that wraps the receiving parser with a two argument block. The first argument is the parsed stream, the second argument a continuation block on the delegate parser."
-
- ^ PPWrappingParser on: self block: aBlock!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 5/12/2010 20:32''!!
-==> aBlock
- "Answer a new parser that performs aBlock as action handler on success."
-
- ^ PPActionParser on: self block: aBlock!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 4/3/2011 15:00''!!
-foldLeft: aBlock
- "Answer a new parser that that folds the result of the receiver from left-to-right into aBlock. The argument aBlock must take two or more arguments."
-
- | size args |
- size := aBlock numArgs.
- args := Array new: size.
- ^ self ==> [ :nodes |
- args at: 1 put: nodes first.
- 2 to: nodes size by: size - 1 do: [ :index |
- args
- replaceFrom: 2 to: size with: nodes startingAt: index;
- at: 1 put: (aBlock valueWithArguments: args) ].
- args first ]!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 4/6/2010 19:26''!!
-token: aTokenClass
- "Answer a new parser that transforms the input to a token of class aTokenClass."
-
- ^ self token tokenClass: aTokenClass!! !!
-
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:57''!!
-max: anInteger lazy: aParser
- "Answer a new parser that parses the receiver at most anInteger times until it reaches aParser. This is a lazy non-blind implementation. aParser is not consumed."
-
- ^ (self starLazy: aParser) setMax: anInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/2/2011 10:01''!!
-starLazy: aParser
- "Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed."
-
- ^ PPLazyRepeatingParser on: self limit: aParser!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 9/15/2010 09:34''!!
-times: anInteger
- "Answer a new parser that parses the receiver exactly anInteger times."
-
- ^ self min: anInteger max: anInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:56''!!
-min: aMinInteger max: aMaxInteger greedy: aParser
- "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
-
- ^ (self starGreedy: aParser) setMin: aMinInteger; setMax: aMaxInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/2/2011 10:02''!!
-star
- "Answer a new parser that parses the receiver zero or more times. This is a greedy and blind implementation that tries to consume as much input as possible and it does not consider what comes afterwards."
-
- ^ PPPossessiveRepeatingParser on: self!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:02''!!
-min: anInteger
- "Answer a new parser that parses the receiver at least anInteger times."
-
- ^ self star setMin: anInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:03''!!
-min: aMinInteger max: aMaxInteger
- "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times."
-
- ^ self star setMin: aMinInteger; setMax: aMaxInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/2/2011 10:01''!!
-starGreedy: aParser
- "Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed."
-
- ^ PPGreedyRepeatingParser on: self limit: aParser!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:57''!!
-min: aMinInteger max: aMaxInteger lazy: aParser
- "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
-
- ^ (self starLazy: aParser) setMin: aMinInteger; setMax: aMaxInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:57''!!
-min: anInteger lazy: aParser
- "Answer a new parser that parses the receiver at least anInteger times until it reaches aParser. This is a lazy non-blind implementation. aParser is not consumed."
-
- ^ (self starLazy: aParser) setMin: anInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:56''!!
-max: anInteger greedy: aParser
- "Answer a new parser that parses the receiver at most anInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
-
- ^ (self starGreedy: aParser) setMax: anInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:03''!!
-plus
- "Answer a new parser that parses the receiver one or more times."
-
- ^ self star setMin: 1!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:56''!!
-min: anInteger greedy: aParser
- "Answer a new parser that parses the receiver at least anInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
-
- ^ (self starGreedy: aParser) setMin: anInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:03''!!
-max: anInteger
- "Answer a new parser that parses the receiver at most anInteger times."
-
- ^ self star setMax: anInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:04''!!
-plusGreedy: aParser
- "Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed."
-
- ^ (self starGreedy: aParser) setMin: 1!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:04''!!
-plusLazy: aParser
- "Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed."
-
- ^ (self starLazy: aParser) setMin: 1!! !!
-
-
-!!PPParser methodsFor: ''*petitsmalltalk-operations'' stamp: ''lr 6/29/2010 14:27''!!
-smalltalkToken
- ^ PPSmalltalkTokenParser on: self!! !!
-
-
-!!PPParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 5/22/2010 10:45''!!
-isTerminal
- "Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser."
-
- ^ self children isEmpty!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-testing'' stamp: ''JanKurs 5/31/2013 11:49''!!
-isFirstSetTerminal
- "Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser."
-
- ^ self children isEmpty!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 11/12/2009 17:25''!!
-isNullable
- "Answer true if the receiver is a nullable parser, e.g. it can successfully parse nothing."
-
- ^ false!! !!
-
-
-!!PPParser methodsFor: ''converting'' stamp: ''lr 11/29/2011 20:48''!!
-asParser
- "Answer the receiving parser."
-
- ^ self!! !!
-
-
-!!PPParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 16:36''!!
-printNameOn: aStream
- self name isNil
- ifTrue: [ aStream print: self hash ]
- ifFalse: [ aStream nextPutAll: self name ]!! !!
-
-!!PPParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 16:36''!!
-printOn: aStream
- super printOn: aStream.
- aStream nextPut: $(.
- self printNameOn: aStream.
- aStream nextPut: $)!! !!
-
-
-!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:37''!!
-example
- ^ String streamContents: [ :stream | self exampleOn: stream ] limitedTo: 1024!! !!
-
-!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:20''!!
-exampleOn: aStream!! !!
-
-!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 9/12/2011 18:34''!!
-displayColor
- ^ self isTerminal
- ifTrue: [ Color r: 0.5 g: 0.0 b: 0.5 ]
- ifFalse: [ Color blue ]!! !!
-
-!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/6/2009 18:31''!!
-displayName
- ^ self name isNil
- ifFalse: [ self name asString ]
- ifTrue: [ self class name asString ]!! !!
-
-!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:11''!!
-backgroundForDepth: anInteger
- ^ Color gray: 1.0 - (anInteger / 20.0)!! !!
-
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 10/29/2010 17:05''!!
-parse: anObject onError: aBlock
- "Parse anObject with the receiving parser and answer the parse-result or answer the result of evaluating aBlock. Depending on the number of arguments of the block it is simply evaluated, evaluated with the failure object, or evaluated with the error message and position."
-
- | result |
- result := self parse: anObject.
- result isPetitFailure
- ifFalse: [ ^ result ].
- aBlock numArgs = 0
- ifTrue: [ ^ aBlock value ].
- aBlock numArgs = 1
- ifTrue: [ ^ aBlock value: result ].
- ^ aBlock value: result message value: result position!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 6/4/2011 18:12''!!
-matchesIn: anObject
- "Search anObject repeatedly for the matches of the receiver. Answered an OrderedCollection of the matched parse-trees."
-
- | result |
- result := OrderedCollection new.
- self
- matchesIn: anObject
- do: [ :each | result addLast: each ].
- ^ result!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 8/16/2011 07:26''!!
-matchesSkipIn: anObject
- "Search anObject repeatedly for the matches of the receiver. Answer an OrderedCollection of the matched parse-trees. Skip over matches."
-
- | result |
- result := OrderedCollection new.
- self
- matchesSkipIn: anObject
- do: [ :each | result addLast: each ].
- ^ result!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 2/25/2013 23:42''!!
-matchingSkipRangesIn: anObject do: aBlock
- "Search anObject repeatedly for the matches of the receiver. Skip over matches. Evaluate aBlock with the range of each match (index of first character to: index of last character)."
-
- self token
- matchesSkipIn: anObject
- do: [ :token | aBlock value: (token start to: token stop) ]!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''DamienCassou 10/29/2011 19:18''!!
-matchingSkipRangesIn: anObject
- "Search anObject repeatedly for the matches of the receiver. Skip over matches. Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)."
-
- | result |
- result := OrderedCollection new.
- self
- matchingSkipRangesIn: anObject
- do: [ :value | result addLast: value ].
- ^ result!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 6/4/2011 18:12''!!
-matchingRangesIn: anObject
- "Search anObject repeatedly for the matches of the receiver. Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)."
-
- | result |
- result := OrderedCollection new.
- self
- matchingRangesIn: anObject
- do: [ :value | result addLast: value ].
- ^ result!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 8/16/2011 07:26''!!
-matchesSkipIn: anObject do: aBlock
- "Search anObject repeatedly for the matches of the receiver. Evaluate aBlock for each match with the matched parse-tree as the argument. Skip over matches."
-
- (self ==> aBlock / #any asParser) star parse: anObject!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 2/25/2013 23:41''!!
-matchingRangesIn: anObject do: aBlock
- "Search anObject repeatedly for the matches of the receiver. Evaluate aBlock with the range of each match (index of first character to: index of last character)."
-
- self token
- matchesIn: anObject
- do: [ :token | aBlock value: (token start to: token stop) ]!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 2/8/2010 00:30''!!
-matches: anObject
- "Answer if anObject can be parsed by the receiver."
-
- ^ (self parse: anObject) isPetitFailure not!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 3/1/2010 21:51''!!
-matchesIn: anObject do: aBlock
- "Search anObject repeatedly for the matches of the receiver. Evaluate aBlock for each match with the matched parse-tree as the argument. Make sure to always consume exactly one character with each step, to not miss any match."
-
- ((self and ==> aBlock , #any asParser) / #any asParser) star parse: anObject!! !!
-
-
-!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 5/31/2010 18:37''!!
-matchList: matchList index: matchIndex against: parserList index: parserIndex inContext: aDictionary seen: aSet
- | parser currentIndex currentDictionary currentSeen parsers |
- matchList size < matchIndex
- ifTrue: [ ^ parserList size < parserIndex ].
- parser := matchList at: matchIndex.
- parser class = PPListPattern ifTrue: [
- currentIndex := parserIndex - 1.
- [ currentDictionary := aDictionary copy.
- currentSeen := aSet copy.
- parserList size < currentIndex or: [
- parsers := parserList copyFrom: parserIndex to: currentIndex.
- (currentDictionary at: parser ifAbsentPut: [ parsers ]) = parsers and: [
- (self
- matchList: matchList
- index: matchIndex + 1
- against: parserList
- index: currentIndex + 1
- inContext: currentDictionary
- seen: currentSeen)
- ifTrue: [
- currentDictionary keysAndValuesDo: [ :key :value | aDictionary at: key put: value ].
- ^ true ].
- false ] ] ] whileFalse: [ currentIndex := currentIndex + 1 ].
- ^ false ].
- parserList size < parserIndex
- ifTrue: [ ^ false ].
- (parser match: (parserList at: parserIndex) inContext: aDictionary seen: aSet)
- ifFalse: [ ^ false ].
- ^ self
- matchList: matchList
- index: matchIndex + 1
- against: parserList
- index: parserIndex + 1
- inContext: aDictionary
- seen: aSet!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 7/17/2011 11:53''!!
-copyInContext: aDictionary seen: aSeenDictionary
- | copy |
- aSeenDictionary
- at: self
- ifPresent: [ :value | ^ value ].
- copy := aSeenDictionary
- at: self
- put: self copy.
- copy children do: [ :each |
- copy
- replace: each
- with: (each copyInContext: aDictionary seen: aSeenDictionary) ].
- ^ copy!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/30/2010 07:49''!!
-copyInContext: aDictionary
- ^ self copyInContext: aDictionary seen: IdentityDictionary new!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/29/2010 23:07''!!
-matchList: matchList against: parserList inContext: aDictionary seen: aSet
- ^ self matchList: matchList index: 1 against: parserList index: 1 inContext: aDictionary seen: aSet!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- "This is the default implementation to match two parsers. This code can properly handle recursion. This is code is supposed to be overridden in subclasses that add new state."
-
- (self == aParser or: [ anIdentitySet includes: self ])
- ifTrue: [ ^ true ].
- anIdentitySet add: self.
- ^ self class = aParser class and: [ self matchList: self children against: aParser children inContext: aDictionary seen: anIdentitySet ]!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/29/2010 23:14''!!
-match: aParser inContext: aDictionary
- ^ self match: aParser inContext: aDictionary seen: IdentitySet new!! !!
-
-
-!!PPParser methodsFor: ''testing'' stamp: ''lr 10/27/2008 11:28''!!
-isUnresolved
- ^ false!! !!
-
-!!PPParser methodsFor: ''testing'' stamp: ''lr 8/6/2010 16:44''!!
-isPetitParser
- ^ true!! !!
-
-
-!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!!
-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 ]!! !!
-
-!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:33''!!
-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!! !!
-
-!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!!
-propertyAt: aKey
- "Answer the property value associated with aKey."
-
- ^ self propertyAt: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
-
-!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!!
-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 ]!! !!
-
-!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:33''!!
-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."
-
- ^ (properties ifNil: [ properties := Dictionary new: 1 ])
- at: aKey put: anObject!! !!
-
-!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!!
-hasProperty: aKey
- "Test if the property aKey is present."
-
- ^ properties notNil and: [ properties includesKey: aKey ]!! !!
-
-!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:33''!!
-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'' ]!! !!
-
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:41''!!
-visualizationGraphType
- ^ nil!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 17:26''!!
-visualizeStructureInGraphOn: view
- view shape rectangle
- borderWidth: 1;
- if: [ :p | p name isNil ] fillColor: Color lightGray.
-
- view interaction
- item: ''Explore'' action: #explore;
- highlightWhenOver: [ :p |
- self allParsers select: [ :ch | ch children includes: p ]
- ] color: Color orange muchLighter;
- highlightWhenOver: [ :p | |children|
- children := p namedChildren.
- ] color: Color orange muchDarker;
- highlightWhenOver: [ :p | Array with: p ] color: Color orange;
- popupText: [:p | p class name asString ].
-
- view
- nodes: self allParsers
- forEach: [ :aParser | |labels|
- labels := OrderedCollection new.
- aParser name notNil ifTrue: [ labels add: aParser name ].
- aParser visualizationGraphType notNil ifTrue: [ labels add: aParser visualizationGraphType ].
- labels isEmpty ifFalse: [
- view shape label.
- view interaction forwarder.
- view nodes: labels asArray ].
- ].
-
- view shape: (ROLine new add: (ROArrow new size: 4) offset: 0.1).
- view edgesToAll: #children.
- view treeLayout
- layered;
- on: ROLayoutEnd do: [ :evt | ROFocusView on: (view raw elementFromModel: self) ].
-
- view zoomInButton.
- view zoomOutButton.!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''tg 8/25/2010 00:32''!!
-namedParsersDo: aBlock
- self namedParsersDo: aBlock seen: IdentitySet new!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''VincentBlondeau 2/14/2014 17:06''!!
-viewAllNamedParsersWithSelection: aCollectionOfNames previewing: aBlock on: view
- view shape label
- color: [ :each |
- (aCollectionOfNames includes: each name)
- ifFalse: [ Color black ]
- ifTrue: [ Color red ] ];
- text: [ :each | each displayName ].
- view interaction popupText: aBlock.
- view interaction item: ''Explore'' action: #explore.
- view nodes: (self allParsers reject: [ :each | each name isEmptyOrNil ]).
- view edges: (self allParsers reject: [ :each | each name isEmptyOrNil ]) from: #yourself toAll: #namedParsers.
- view horizontalDominanceTreeLayout
- verticalGap: 10;
- layered!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 17:21''!!
-visualizeStructureInGraph
-
- "
- PPSmalltalkParser new visualize
-
-
- "
- | view |
-
- view := ROMondrianViewBuilder new.
- self visualizeStructureInGraphOn: view.
- view open.
- ^ view!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''VincentBlondeau 2/14/2014 17:06''!!
-viewAllNamedParsersOn: view
- view shape
- rectangleWithoutBorder;
- withText: #displayName.
- view nodes: (self allParsers reject: [ :each | each name isEmptyOrNil ]).
- view edgesToAll: #namedParsers.
- view horizontalDominanceTreeLayout layered!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''TudorGirba 12/6/2011 07:43''!!
-viewAllNamedParsersWithSelection: aCollectionOfNames on: view
- self viewAllNamedParsersWithSelection: aCollectionOfNames previewing: [ :each | each name ] on: view!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''TudorGirba 12/14/2011 12:40''!!
-namedParsersDo: aBlock seen: aSet
- self children do: [ :each |
- (aSet includes: each)
- ifFalse: [
- aSet add: each.
- each name isEmptyOrNil
- ifFalse: [ aBlock value: each ]
- ifTrue: [ each namedParsersDo: aBlock seen: aSet ] ] ]!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''TudorGirba 6/5/2013 23:01''!!
-viewAllNamedParsers
- | view |
- view := ROMondrianViewBuilder new.
- self viewAllNamedParsersOn: view.
- ^ view open setLabel: ''All named parsers''!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''tg 8/25/2010 00:31''!!
-namedParsers
- | result |
- result := OrderedCollection new.
- self namedParsersDo: [ :parser | result addLast: parser ].
- ^ result!! !!
-
-
-!!PPParser methodsFor: ''*petitanalyzer-enumerating'' stamp: ''lr 4/13/2010 08:36''!!
-allParsers
- "Answer all the parse nodes of the receiver."
-
- | result |
- result := OrderedCollection new.
- self allParsersDo: [ :parser | result addLast: parser ].
- ^ result!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-enumerating'' stamp: ''lr 4/13/2010 08:36''!!
-allParsersDo: aBlock
- "Iterate over all the parse nodes of the receiver."
-
- self allParsersDo: aBlock seen: IdentitySet new!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-enumerating'' stamp: ''lr 4/13/2010 08:35''!!
-allParsersDo: 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 allParsersDo: aBlock seen: aSet ]!! !!
-
-
-!!PPParser methodsFor: ''operators-convenience'' stamp: ''lr 2/19/2010 07:56''!!
-separatedBy: aParser
- "Answer a new parser that parses the receiver one or more times, separated by aParser."
-
- ^ (PPSequenceParser with: self with: (PPSequenceParser with: aParser with: self) star) ==> [ :nodes |
- | result |
- result := Array new: 2 * nodes second size + 1.
- result at: 1 put: nodes first.
- nodes second
- keysAndValuesDo: [ :index :pair | result replaceFrom: 2 * index to: 2 * index + 1 with: pair startingAt: 1 ].
- result ]!! !!
-
-!!PPParser methodsFor: ''operators-convenience'' stamp: ''lr 2/19/2010 07:42''!!
-delimitedBy: aParser
- "Answer a new parser that parses the receiver one or more times, separated and possibly ended by aParser."
-
- ^ (self separatedBy: aParser) , (aParser optional) ==> [ :node |
- node second isNil
- ifTrue: [ node first ]
- ifFalse: [ node first copyWith: node second ] ]!! !!
-
-!!PPParser methodsFor: ''operators-convenience'' stamp: ''lr 2/25/2012 16:54''!!
-withoutSeparators
- "Filters out the separators from a parse result produced by one of the productions #delimitedBy: or #separatedBy:."
-
- ^ self ==> [ :items |
- | result |
- result := Array new: items size + 1 // 2.
- 1 to: result size do: [ :index | result at: index put: (items at: 2 * index - 1) ].
- result ]!! !!
-
-
-!!PPParser methodsFor: ''copying'' stamp: ''lr 4/19/2010 10:33''!!
-postCopy
- super postCopy.
- properties := properties copy!! !!
-
-
-!!PPParser methodsFor: ''initialization'' stamp: ''lr 4/24/2008 10:33''!!
-initialize!! !!
-
-
-!!PPParser methodsFor: ''*petitgui-morphic-creational'' stamp: ''lr 11/17/2009 21:58''!!
-newColumnMorph
- ^ AlignmentMorph newColumn
- cellPositioning: #topLeft;
- color: Color transparent;
- listCentering: #topLeft;
- vResizing: #shrinkWrap;
- hResizing: #shrinkWrap;
- layoutInset: 0;
- yourself!! !!
-
-!!PPParser methodsFor: ''*petitgui-morphic-creational'' stamp: ''lr 11/17/2009 21:57''!!
-newRowMorph
- ^ AlignmentMorph newRow
- cellPositioning: #topLeft;
- color: Color transparent;
- listCentering: #topLeft;
- vResizing: #shrinkWrap;
- hResizing: #shrinkWrap;
- layoutInset: 0;
- yourself!! !!
-
-!!PPParser methodsFor: ''*petitgui-morphic-creational'' stamp: ''lr 11/17/2009 22:03''!!
-newSpacerMorph
- ^ Morph new
- color: Color transparent;
- borderWidth: 0;
- extent: 7 @ 7;
- yourself!! !!
-
-
-!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 9/16/2010 17:55''!!
-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 firstSets.
- followSets := IdentityDictionary new.
- self allParsersDo: [ :each | followSets at: each put: IdentitySet new ].
- (followSets at: self) add: PPSentinel instance.
- [ followSets keysAndValuesDo: [ :parser :follow |
- parser
- followSets: followSets
- firstSets: firstSets
- into: follow ].
- current := followSets
- inject: 0
- into: [ :result :each | result + each size ].
- continue := previous < current.
- previous := current.
- continue ] whileTrue.
- ^ followSets!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 10/22/2009 19:59''!!
-firstSet
- "Answer the first-set of the receiver. Note, this implementation is inefficient when called on different receivers of the same grammar, instead use #firstSets to calculate the first-sets at once."
-
- ^ self firstSets at: self!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 11/19/2009 23:49''!!
-cycleSet
- "Answer a set of all nodes that are within one or more cycles of left-recursion. This is generally not a problem if at least one of the nodes is memoized, but it might make the grammar very inefficient and should be avoided if possible."
-
- | cycles |
- cycles := IdentitySet new.
- self cycleSet: OrderedCollection new firstSets: self firstSets into: cycles.
- ^ cycles!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''JanKurs 5/31/2013 11:49''!!
-firstSets
- "Answer a dictionary with all the parsers reachable from the receiver as key and their first-set as value. The first-set of a parser is the list of terminal parsers that begin the parser derivable from that parser."
-
- | firstSets |
- firstSets := IdentityDictionary new.
- self allParsersDo: [ :each |
- firstSets at: each put: (each isFirstSetTerminal
- ifTrue: [ IdentitySet with: each ]
- ifFalse: [ IdentitySet new ]).
- each isNullable
- ifTrue: [ (firstSets at: each) add: PPSentinel instance ] ].
- [ | changed tally |
- changed := false.
- firstSets keysAndValuesDo: [ :parser :first |
- tally := first size.
- parser firstSets: firstSets into: first.
- changed := changed or: [ tally ~= first size ] ].
- changed ] whileTrue.
- ^ firstSets!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 11/12/2009 21:13''!!
-followSet
- "Answer the follow-set of the receiver starting at the receiver. Note, this implementation is inefficient when called on different receivers of the same grammar, instead use #followSets to calculate the follow-sets at once."
-
- ^ self followSets at: self!! !!
-
-
-!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:30''!!
-parseOn: aPPContext
- "Parse aStream with the receiving parser and answer the parse-result or an instance of PPFailure. Override this method in subclasses to specify custom parse behavior. Do not call this method from outside, instead use #parse:."
-
- self subclassResponsibility!! !!
-
-!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/17/2014 13:15''!!
-debugWithContext: aPPContext
-
- ^ self enableDebug parseWithContext: aPPContext !! !!
-
-!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/11/2014 13:33''!!
-updateContext: aPPContext
- "nothing to do"!! !!
-
-!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 13:26''!!
-parse: anObject withContext: aPPContext
- "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure."
-
- aPPContext stream: anObject asPetitStream.
- ^ self parseWithContext: aPPContext.
-!! !!
-
-!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 13:25''!!
-parse: anObject
- "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure."
-
- ^ self parse: anObject withContext: PPContext new!! !!
-
-!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/19/2014 16:34''!!
-parseWithContext: context
- context root: self.
- self updateContext: context.
- ^ self parseOn: context!! !!
-
-
-!!PPParser methodsFor: ''accessing'' stamp: ''lr 10/21/2009 16:38''!!
-children
- "Answer a set of child parsers that could follow the receiver."
-
- ^ #()!! !!
-
-!!PPParser methodsFor: ''accessing'' stamp: ''lr 4/19/2010 10:38''!!
-name: aString
- self propertyAt: #name put: aString!! !!
-
-!!PPParser methodsFor: ''accessing'' stamp: ''lr 4/19/2010 10:35''!!
-name
- "Answer the production name of the receiver."
-
- ^ self propertyAt: #name ifAbsent: [ nil ]!! !!
-
-
-!!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 11/19/2009 23:47''!!
-cycleSet: aDictionary
- "PRIVATE: Answer the children that could be part of a cycle-set with the receiver, subclasses might restrict the number of children returned. aDictionary is pre-calcualted first-sets."
-
- ^ self children!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 5/22/2010 10:45''!!
-cycleSet: aStack firstSets: aDictionary into: aSet
- "PRIVATE: Try to find a cycle, where aStack contains the previously visited parsers. The method returns quickly when the receiver is a terminal, terminals cannot be part of a cycle. If aStack already contains the receiver, then we are in a cycle. In this case we don''t process the children further and add the nodes to aSet."
-
- | index |
- self isTerminal
- ifTrue: [ ^ self ].
- (index := aStack indexOf: self) > 0
- ifTrue: [ ^ aSet addAll: (aStack copyFrom: index to: aStack size) ].
- aStack addLast: self.
- (self cycleSet: aDictionary)
- do: [ :each | each cycleSet: aStack firstSets: aDictionary into: aSet ].
- aStack removeLast!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 11/12/2009 21:25''!!
-firstSets: aFirstDictionary into: aSet
- "PRIVATE: Try to add additional elements to the first-set aSet of the receiver, use the incomplete aFirstDictionary."
-
- self children do: [ :parser | aSet addAll: (aFirstDictionary at: parser) ]!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 11/12/2009 21:25''!!
-followSets: aFollowDictionary firstSets: aFirstDictionary into: 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: [ :parser | (aFollowDictionary at: parser) addAll: aSet ]!! !!
-
-
-!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 1/16/2014 15:41''!!
-debug: anObject
- "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure."
-
- ^ self enableDebug parse: anObject asPetitStream!! !!
-
-!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 3/18/2014 12:21''!!
-enableDebuggerOutput
- self debuggerOutput: true.!! !!
-
-!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 4/22/2013 18:04''!!
-debuggerOutput: aBoolean
- self propertyAt: #debuggerOutput put: aBoolean!! !!
-
-!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 3/18/2014 12:21''!!
-disableDebuggerOutput
- self debuggerOutput: false. !! !!
-
-!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 3/18/2014 17:01''!!
-enableDebug
- | root newParser |
- root := PPParserDebuggerResult new.
-
- newParser := self transform: [:each |
- each >=> [:stream :continuation |
- | result child |
- child := PPParserDebuggerResult new
- parser: each;
- parent: root.
- root := root children add: child.
- child start: stream position + 1.
- child showChildren: each debuggerOutput.
- result := continuation value.
- child end: stream position.
- root result: result.
- root := root parent.
- result
- ]
- ].
-
- ^ PPDebugParser on: newParser root: root.
-!! !!
-
-!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 4/22/2013 18:04''!!
-debuggerOutput
- ^ self propertyAt: #debuggerOutput ifAbsentPut: true.!! !!
-
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 2/19/2010 07:36''!!
-negate
- "Answer a new parser consumes any input token but the receiver."
-
- ^ self not , #any asParser ==> #second!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 9/1/2010 22:03''!!
-optional
- "Answer a new parser that parses the receiver, if possible."
-
- ^ PPOptionalParser on: self!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 12/3/2010 11:34''!!
-def: aParser
- "Redefine the receiver as the argument aParser. This method is useful when defining recursive parsers: instantiate a PPUnresolvedParser and later redefine it with another one."
-
- ^ self becomeForward: (aParser name: self name)!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 10/23/2008 14:05''!!
-wrapped
- "Answer a new parser that is simply wrapped."
-
- ^ PPDelegateParser on: self!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 5/31/2010 16:34''!!
-memoized
- "Answer a new memoized parser, for refraining redundant computations. This ensures polynomial time O(n^4) for left-recursive grammars and O(n^3) for non left-recursive grammars in the worst case. Not necessary for most grammars that are carefully written and in O(n) anyway."
-
- ^ PPMemoizedParser on: self!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 5/31/2010 15:12''!!
-and
- "Answer a new parser (logical and-predicate) that succeeds whenever the receiver does, but never consumes input."
-
- ^ PPAndParser on: self!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 4/14/2010 11:46''!!
-/ aParser
- "Answer a new parser that parses the receiver, if the receiver fails try with aParser (ordered-choice)."
-
- ^ PPChoiceParser with: self with: aParser!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 4/30/2010 12:13''!!
-end
- "Answer a new parser that succeeds at the end of the input and return the result of the receiver."
-
- ^ PPEndOfInputParser on: self!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 5/31/2010 15:12''!!
-not
- "Answer a new parser (logical not-predicate) that succeeds whenever the receiver fails, but never consumes input."
-
- ^ PPNotParser on: self!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 4/14/2010 11:53''!!
-| aParser
- "Answer a new parser that either parses the receiver or aParser. Fail if both pass or fail (exclusive choice, unordered choice)."
-
- ^ (self not , aParser) / (aParser not , self) ==> #second!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 9/23/2008 18:32''!!
-, aParser
- "Answer a new parser that parses the receiver followed by aParser."
-
- ^ PPSequenceParser with: self with: aParser!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPParser class
- instanceVariableNames: ''''!!
-!!PPParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPParser class methodsFor: ''instance creation'' stamp: ''lr 10/27/2008 11:17''!!
-named: aString
- ^ self new name: aString!! !!
-
-!!PPParser class methodsFor: ''instance creation'' stamp: ''lr 4/18/2008 14:00''!!
-new
- ^ self basicNew initialize!! !!
-
-
-PPParser subclass: #PPPluggableParser
- instanceVariableNames: ''block''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPPluggableParser commentStamp: ''<historical>'' prior: 0!!
-A pluggable parser that passes the parser stream into a block. This enables users to perform manual parsing or to embed other parser frameworks into PetitParser.
-
-Instance Variables:
- block <BlockClosure> The pluggable one-argument block.
-!!
-
-
-!!PPPluggableParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ]!! !!
-
-
-!!PPPluggableParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 16:52''!!
-initializeOn: aBlock
- block := aBlock!! !!
-
-
-!!PPPluggableParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:42''!!
-parseOn: aPPContext
- | position result |
- position := aPPContext remember.
- result := block value: aPPContext.
- result isPetitFailure
- ifTrue: [ aPPContext restore: position ].
- ^ result!! !!
-
-
-!!PPPluggableParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:41''!!
-displayName
- ^ String streamContents: [ :stream | block decompile shortPrintOn: stream ]!! !!
-
-
-!!PPPluggableParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:10''!!
-block
- "Answer the pluggable block."
-
- ^ block!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPPluggableParser class
- instanceVariableNames: ''''!!
-!!PPPluggableParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPPluggableParser class methodsFor: ''instance creation'' stamp: ''lr 5/2/2010 16:52''!!
-on: aBlock
- ^ self new initializeOn: aBlock!! !!
-
-
-PPParser subclass: #PPFailingParser
- instanceVariableNames: ''message''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPFailingParser commentStamp: ''<historical>'' prior: 0!!
-A parser that consumes nothing and always fails.
-
-Instance Variables:
- message <String> The failure message.!!
-
-
-!!PPFailingParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 19:16''!!
-setMessage: aString
- message := aString!! !!
-
-
-!!PPFailingParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:59''!!
-parseOn: aPPContext
- ^ PPFailure message: message context: aPPContext!! !!
-
-
-!!PPFailingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/6/2009 18:43''!!
-displayName
- ^ message!! !!
-
-!!PPFailingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:16''!!
-displayColor
- ^ Color red!! !!
-
-
-!!PPFailingParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 21:27''!!
-printNameOn: aStream
- super printNameOn: aStream.
- aStream nextPutAll: '', ''; print: message!! !!
-
-
-!!PPFailingParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/30/2010 12:01''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self message = aParser message ]!! !!
-
-
-!!PPFailingParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:10''!!
-message
- "Answer the error message of the receiving parser."
-
- ^ message!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPFailingParser class
- instanceVariableNames: ''''!!
-!!PPFailingParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPFailingParser class methodsFor: ''instance creation'' stamp: ''lr 5/2/2010 19:16''!!
-message: aString
- ^ self new setMessage: aString!! !!
-
-
-PPParser subclass: #PPLiteralParser
- instanceVariableNames: ''literal message''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPLiteralParser commentStamp: ''<historical>'' prior: 0!!
-Abstract literal parser that parses some kind of literal type (to be specified by subclasses).
-
-Instance Variables:
- literal <Object> The literal object to be parsed.
- message <String> The error message to be generated.
-!!
-
-
-!!PPLiteralParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 9/15/2010 12:08''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self literal = aParser literal and: [ self message = aParser message ] ]!! !!
-
-
-!!PPLiteralParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 17:25''!!
-visualizationGraphType
- ^ literal printString!! !!
-
-
-!!PPLiteralParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:19''!!
-displayName
- ^ literal printString!! !!
-
-
-!!PPLiteralParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:26''!!
-message
- "Answer the failure message."
-
- ^ message!! !!
-
-!!PPLiteralParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:26''!!
-literal
- "Answer the parsed literal."
-
- ^ literal!! !!
-
-
-!!PPLiteralParser methodsFor: ''operators'' stamp: ''lr 6/1/2010 22:24''!!
-caseInsensitive
- "Answer a parser that can parse the receiver case-insensitive."
-
- self subclassResponsibility!! !!
-
-
-!!PPLiteralParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 13:25''!!
-initializeOn: anObject message: aString
- literal := anObject.
- message := aString!! !!
-
-
-!!PPLiteralParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 16:38''!!
-printNameOn: aStream
- super printNameOn: aStream.
- aStream nextPutAll: '', ''; print: literal!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPLiteralParser class
- instanceVariableNames: ''''!!
-!!PPLiteralParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPLiteralParser class methodsFor: ''instance creation'' stamp: ''lr 1/7/2010 15:29''!!
-on: anObject message: aString
- ^ self new initializeOn: anObject message: aString!! !!
-
-!!PPLiteralParser class methodsFor: ''instance creation'' stamp: ''lr 1/7/2010 15:30''!!
-on: anObject
- ^ self on: anObject message: anObject printString , '' expected''!! !!
-
-
-PPLiteralParser subclass: #PPLiteralObjectParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPLiteralObjectParser commentStamp: ''<historical>'' prior: 0!!
-A parser that accepts a single literal object, such as a character. This is the same as the predicate parser ''PPPredicateParser expect: literal'' but slightly more efficient.!!
-
-
-!!PPLiteralObjectParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:25''!!
-exampleOn: aStream
- aStream nextPut: literal!! !!
-
-
-!!PPLiteralObjectParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:00''!!
-parseOn: aPPContext
- ^ (aPPContext stream atEnd not and: [ literal = aPPContext stream uncheckedPeek ])
- ifFalse: [ PPFailure message: message context: aPPContext ]
- ifTrue: [ aPPContext stream next ]!! !!
-
-
-!!PPLiteralObjectParser methodsFor: ''operators'' stamp: ''lr 8/18/2010 20:16''!!
-caseInsensitive
- "Answer a parser that can parse the receiver case-insensitive."
-
- literal asUppercase = literal asLowercase ifTrue: [ ^ self ].
- ^ PPPredicateObjectParser on: [ :value | literal sameAs: value ] message: message!! !!
-
-!!PPLiteralObjectParser methodsFor: ''operators'' stamp: ''lr 4/28/2011 20:02''!!
-negate
- ^ (PPPredicateObjectParser expect: literal message: message) negate!! !!
-
-
-PPParser subclass: #PPPredicateParser
- instanceVariableNames: ''predicate predicateMessage negated negatedMessage''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPPredicateParser commentStamp: ''<historical>'' prior: 0!!
-An abstract parser that accepts if a given predicate holds.
-
-Instance Variables:
- predicate <BlockClosure> The block testing for the predicate.
- predicateMessage <String> The error message of the predicate.
- negated <BlockClosure> The block testing for the negation of the predicate.
- negatedMessage <String> The error message of the negated predicate.!!
-
-
-!!PPPredicateParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 9/15/2010 11:56''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block and: [ self message = aParser message ] ]!! !!
-
-
-!!PPPredicateParser methodsFor: ''printing'' stamp: ''lr 5/2/2010 13:37''!!
-printNameOn: aStream
- super printNameOn: aStream.
- aStream nextPutAll: '', ''; print: predicateMessage!! !!
-
-
-!!PPPredicateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 5/1/2010 17:05''!!
-exampleOn: aStream
- "Produce a random character that is valid. If there are characters in the alpha-numeric range prefer those over all others."
-
- | valid normal |
- valid := Character allCharacters
- select: [ :char | self matches: (String with: char) ].
- normal := valid
- select: [ :char | char asInteger < 127 and: [ char isAlphaNumeric ] ].
- aStream nextPut: (normal isEmpty
- ifTrue: [ valid atRandom ]
- ifFalse: [ normal atRandom ])!! !!
-
-!!PPPredicateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 5/2/2010 19:35''!!
-displayName
- ^ predicateMessage!! !!
-
-
-!!PPPredicateParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:36''!!
-message
- "Answer the failure message."
-
- ^ predicateMessage!! !!
-
-!!PPPredicateParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:36''!!
-block
- "Answer the predicate block of the receiver."
-
- ^ predicate!! !!
-
-
-PPPredicateParser subclass: #PPPredicateObjectParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPPredicateObjectParser commentStamp: ''<historical>'' prior: 0!!
-A parser that accepts if a given predicate on one element of the input sequence holds.!!
-
-
-!!PPPredicateObjectParser methodsFor: ''operators'' stamp: ''lr 6/12/2010 09:12''!!
-negate
- "Answer a parser that is the negation of the receiving predicate parser."
-
- ^ self class
- on: negated message: negatedMessage
- negated: predicate message: predicateMessage!! !!
-
-
-!!PPPredicateObjectParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:03''!!
-parseOn: aPPContext
- ^ (aPPContext stream atEnd not and: [ predicate value: aPPContext stream uncheckedPeek ])
- ifFalse: [ PPFailure message: predicateMessage context: aPPContext ]
- ifTrue: [ aPPContext stream next ]!! !!
-
-
-!!PPPredicateObjectParser methodsFor: ''initialization'' stamp: ''lr 6/12/2010 09:12''!!
-initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString
- predicate := aBlock.
- predicateMessage := aString.
- negated := aNegatedBlock.
- negatedMessage := aNegatedString!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPPredicateObjectParser class
- instanceVariableNames: ''''!!
-!!PPPredicateObjectParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPPredicateObjectParser class methodsFor: ''*petitregex-chars'' stamp: ''lr 8/30/2010 14:48''!!
-control
- ^ self chars: ((0 to: 31) collect: [ :each | Character value: each ]) message: ''control character expected''!! !!
-
-
-!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 8/25/2010 10:57''!!
-expect: anObject
- ^ self expect: anObject message: anObject printString , '' expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 4/1/2011 20:05''!!
-anyExceptAnyOf: aCollection
- ^ self
- on: [ :each | (aCollection includes: each) not ] message: ''any except '' , aCollection printString , '' expected''
- negated: [ :each | aCollection includes: each ] message: aCollection printString , '' not expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 4/1/2011 20:05''!!
-anyOf: aCollection
- ^ self
- on: [ :each | aCollection includes: each ] message: ''any of '' , aCollection printString , '' expected''
- negated: [ :each | (aCollection includes: each) not ] message: ''none of '' , aCollection printString , ''expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 6/12/2010 09:10''!!
-any
- ^ self
- on: [ :each | true ] message: ''input expected''
- negated: [ :each | false ] message: ''no input expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 6/12/2010 09:10''!!
-between: min and: max
- ^ self
- on: [ :each | each >= min and: [ each <= max ] ] message: min printString , ''..'' , max printString , '' expected''
- negated: [ :each | each < min or: [ each > max ] ] message: min printString , ''..'' , max printString , '' not expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 8/25/2010 10:57''!!
-expect: anObject message: aString
- ^ self
- on: [ :each | each = anObject ] message: aString
- negated: [ :each | each ~= anObject ] message: ''no '' , aString!! !!
-
-
-!!PPPredicateObjectParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:10''!!
-on: aBlock message: aString
- ^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: ''no '' , aString!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:10''!!
-on: aBlock message: aString negated: aNegatedBlock message: aNegatedString
- ^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString!! !!
-
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:02''!!
-char: aCharacter
- ^ self expect: aCharacter message: (String with: $" with: aCharacter with: $") , '' expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:04''!!
-punctuation
- ^ self chars: ''.,"''''?!!!!;:#$%&()*+-/<>=@[]\^_{}|~'' message: ''punctuation expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:02''!!
-blank
- ^ self chars: (String with: Character space with: Character tab) message: ''blank expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
-hex
- ^ self
- on: (PPCharSetPredicate on: [ :char |
- (char between: $0 and: $9)
- or: [ (char between: $a and: $f)
- or: [ (char between: $A and: $F) ] ] ])
- message: ''hex digit expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:04''!!
-newline
- ^ self chars: (String with: Character cr with: Character lf) message: ''newline expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
-word
- ^ self on: (PPCharSetPredicate on: [ :char | char isAlphaNumeric ]) message: ''letter or digit expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 6/12/2010 09:10''!!
-lf
- ^ self char: Character lf!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
-digit
- ^ self on: (PPCharSetPredicate on: [ :char | char isDigit ]) message: ''digit expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:05''!!
-letter
- ^ self on: (PPCharSetPredicate on: [ :char | char isLetter ]) message: ''letter expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
-uppercase
- ^ self on: (PPCharSetPredicate on: [ :char | char isUppercase ]) message: ''uppercase letter expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:02''!!
-cr
- ^ self char: Character cr message: ''carriage return expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
-space
- ^ self on: (PPCharSetPredicate on: [ :char | char isSeparator ]) message: ''separator expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
-lowercase
- ^ self on: (PPCharSetPredicate on: [ :char | char isLowercase ]) message: ''lowercase letter expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:04''!!
-tab
- ^ self char: Character tab message: ''tab expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
-chars: aCollection message: aString
- ^ self on: (PPCharSetPredicate on: [ :char | aCollection includes: char ]) message: aString!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 10:57''!!
-char: aCharacter message: aString
- ^ self expect: aCharacter message: aString!! !!
-
-
-PPPredicateParser subclass: #PPPredicateSequenceParser
- instanceVariableNames: ''size''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPPredicateSequenceParser commentStamp: ''<historical>'' prior: 0!!
-A parser that accepts if a given predicate on an arbitrary number of elements of the input sequence holds.
-
-Instance Variables:
- size <Integer> The number of elements to consume.!!
-
-
-!!PPPredicateSequenceParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self size = aParser size ]!! !!
-
-
-!!PPPredicateSequenceParser methodsFor: ''operators'' stamp: ''lr 6/12/2010 09:14''!!
-negate
- "Answer a parser that is the negation of the receiving predicate parser."
-
- ^ self class
- on: negated message: negatedMessage
- negated: predicate message: predicateMessage
- size: size!! !!
-
-
-!!PPPredicateSequenceParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:03''!!
-parseOn: aPPContext
- | position result |
- position := aPPContext remember.
- result := aPPContext stream next: size.
- (result size = size and: [ predicate value: result ])
- ifTrue: [ ^ result ].
- aPPContext restore: position.
- ^ PPFailure message: predicateMessage context: aPPContext!! !!
-
-
-!!PPPredicateSequenceParser methodsFor: ''accessing'' stamp: ''lr 6/12/2010 08:58''!!
-size
- "Answer the sequence size of the receiver."
-
- ^ size!! !!
-
-
-!!PPPredicateSequenceParser methodsFor: ''initialization'' stamp: ''lr 6/12/2010 09:13''!!
-initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger
- predicate := aBlock.
- predicateMessage := aString.
- negated := aNegatedBlock.
- negatedMessage := aNegatedString.
- size := anInteger !! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPPredicateSequenceParser class
- instanceVariableNames: ''''!!
-!!PPPredicateSequenceParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPPredicateSequenceParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:14''!!
-on: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger
- ^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger!! !!
-
-!!PPPredicateSequenceParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:14''!!
-on: aBlock message: aString size: anInteger
- ^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: ''no '' , aString size: anInteger !! !!
-
-
-PPParser subclass: #PPDelegateParser
- instanceVariableNames: ''parser''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPDelegateParser commentStamp: ''<historical>'' prior: 0!!
-A parser that delegates to another parser.
-
-Instance Variables:
- parser <PPParser> The parser to delegate to.!!
-
-
-!!PPDelegateParser methodsFor: ''accessing'' stamp: ''lr 10/21/2009 16:37''!!
-children
- ^ Array with: parser!! !!
-
-
-!!PPDelegateParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 4/13/2010 09:39''!!
-replace: aParser with: anotherParser
- super replace: aParser with: anotherParser.
- parser == aParser ifTrue: [ parser := anotherParser ]!! !!
-
-
-!!PPDelegateParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!!
-parseOn: aPPContext
- ^ parser parseOn: aPPContext!! !!
-
-
-!!PPDelegateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:27''!!
-exampleOn: aStream
- parser exampleOn: aStream!! !!
-
-!!PPDelegateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:20''!!
-displayDescription
- ^ nil!! !!
-
-
-!!PPDelegateParser methodsFor: ''initialization'' stamp: ''lr 4/20/2008 16:23''!!
-setParser: aParser
- parser := aParser!! !!
-
-
-!!PPDelegateParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 11:21''!!
-morphicShapeSeen: aSet depth: anInteger
- ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |
- self displayDescription isNil
- ifTrue: [ cc value: parser ]
- ifFalse: [
- self newRowMorph
- addMorphBack: (self newColumnMorph
- addMorphBack: (self newSpacerMorph height: 10);
- addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);
- yourself);
- addMorphBack: (self newRowMorph
- color: (self backgroundForDepth: anInteger);
- addMorphBack: (self newColumnMorph
- addMorphBack: (cc value: parser);
- addMorphBack: (self newRowMorph
- hResizing: #spaceFill;
- addMorphBack: (self newSpacerMorph
- width: 20;
- yourself);
- addMorphBack: (self newColumnMorph
- hResizing: #spaceFill;
- listCentering: #center;
- addMorphBack: (self newSpacerMorph);
- addMorphBack: (StringMorph new
- contents: self displayDescription;
- yourself);
- yourself);
- yourself);
- yourself);
- addMorphBack: (self newColumnMorph
- addMorphBack: (self newSpacerMorph height: 10);
- addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);
- yourself);
- yourself);
- yourself ] ]!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPDelegateParser class
- instanceVariableNames: ''''!!
-!!PPDelegateParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPDelegateParser class methodsFor: ''instance creation'' stamp: ''lr 4/20/2008 16:22''!!
-on: aParser
- ^ self new setParser: aParser!! !!
-
-
-PPDelegateParser subclass: #PPAndParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPAndParser commentStamp: ''TudorGirba 2/27/2011 22:22'' prior: 0!!
-The and-predicate, a parser that succeeds whenever its delegate does, but does not consume the input stream [Parr 1994, 1995].!!
-
-
-!!PPAndParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 5/1/2010 16:16''!!
-exampleOn: aStream!! !!
-
-!!PPAndParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:17''!!
-displayDescription
- ^ ''and''!! !!
-
-
-!!PPAndParser methodsFor: ''operators'' stamp: ''lr 5/1/2010 16:16''!!
-and
- ^ self!! !!
-
-
-!!PPAndParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:50''!!
-parseOn: aPPContext
- | element position |
- position := aPPContext remember.
- element := parser parseOn: aPPContext.
- aPPContext restore: position.
- ^ element!! !!
-
-
-PPDelegateParser subclass: #PPTrimmingParser
- instanceVariableNames: ''trimmer''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPTrimmingParser commentStamp: ''lr 4/6/2010 19:27'' prior: 0!!
-A parser that silently consumes spaces before and after the delegate parser.!!
-
-
-!!PPTrimmingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 4/14/2010 20:48''!!
-exampleOn: aStream
- super exampleOn: aStream.
- aStream nextPut: Character space!! !!
-
-
-!!PPTrimmingParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:42''!!
-parseOn: aPPContext
- | position element |
- position := aPPContext remember.
- [ (trimmer parseOn: aPPContext) isPetitFailure ]
- whileFalse.
- element := parser parseOn: aPPContext.
- element isPetitFailure ifTrue: [
- aPPContext restore: position.
- ^ element ].
- [ (trimmer parseOn: aPPContext) isPetitFailure ]
- whileFalse.
- ^ element!! !!
-
-
-!!PPTrimmingParser methodsFor: ''initialization'' stamp: ''lr 7/31/2010 12:00''!!
-setTrimmer: aParser
- trimmer := aParser!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPTrimmingParser class
- instanceVariableNames: ''''!!
-!!PPTrimmingParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPTrimmingParser class methodsFor: ''instance creation'' stamp: ''lr 7/31/2010 12:01''!!
-on: aParser trimmer: aTrimParser
- ^ self new
- setParser: aParser;
- setTrimmer: aTrimParser;
- yourself!! !!
-
-
-PPDelegateParser subclass: #PPMemoizedParser
- instanceVariableNames: ''buffer context''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPMemoizedParser commentStamp: ''<historical>'' prior: 0!!
-A memoized parser, for refraining redundant computations.
-
-Instance Variables:
- stream <PositionableStream> The stream of the associated memento objects.
- buffer <Array of: PPMemento> The buffer of memento objects.
-!!
-
-
-!!PPMemoizedParser methodsFor: ''operators'' stamp: ''lr 4/2/2009 19:48''!!
-memoized
- "Ther is no point in memoizing more than once."
-
- ^ self!! !!
-
-
-!!PPMemoizedParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 13:20''!!
-reset: aPPContext
- context := aPPContext.
- buffer := Dictionary new.!! !!
-
-!!PPMemoizedParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:00''!!
-parseOn: aPPContext
- | memento contextMemento aStream |
- "TODO: JK memoizing needs review!!!!"
-
- contextMemento := aPPContext remember.
- context == aPPContext
- ifFalse: [ self reset: aPPContext ].
- memento := (buffer at: contextMemento ifAbsentPut: [ PPMemento new ]).
-
- memento contextMemento isNil
- ifTrue: [
- aStream := aPPContext stream.
- memento result: (aStream size - aStream position + 2 < memento count
- ifTrue: [ PPFailure message: ''overflow'' context: aPPContext ]
- ifFalse: [ memento increment. parser parseOn: aPPContext ]).
- memento contextMemento: aPPContext remember ]
- ifFalse: [ context restore: memento contextMemento ].
- ^ memento result.!! !!
-
-
-PPDelegateParser subclass: #PPEndOfInputParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPEndOfInputParser commentStamp: ''lr 4/18/2008 13:46'' prior: 0!!
-A parser that succeeds only at the end of the input stream.!!
-
-
-!!PPEndOfInputParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:58''!!
-parseOn: aPPContext
- | position result |
- position := aPPContext remember.
- result := parser parseOn: aPPContext.
- (result isPetitFailure or: [ aPPContext stream atEnd ])
- ifTrue: [ ^ result ].
- result := PPFailure
- message: ''end of input expected''
- context: aPPContext.
- aPPContext restore: position.
- ^ result!! !!
-
-
-!!PPEndOfInputParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:18''!!
-displayDescription
- ^ ''end of input''!! !!
-
-
-!!PPEndOfInputParser methodsFor: ''operators'' stamp: ''lr 12/7/2009 08:53''!!
-end
- ^ self!! !!
-
-
-PPDelegateParser subclass: #PPActionParser
- instanceVariableNames: ''block''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPActionParser commentStamp: ''<historical>'' prior: 0!!
-A parser that performs an action block with the successful parse result of the delegate.
-
-Instance Variables:
- block <BlockClosure> The action block to be executed.
-!!
-
-
-!!PPActionParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 16:58''!!
-setBlock: aBlock
- block := aBlock!! !!
-
-
-!!PPActionParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:41''!!
-visualizationGraphType
- ^ ''[]''!! !!
-
-
-!!PPActionParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!!
-parseOn: aPPContext
- | element |
- ^ (element := parser parseOn: aPPContext) isPetitFailure
- ifFalse: [ block value: element ]
- ifTrue: [ element ]!! !!
-
-
-!!PPActionParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:10''!!
-block
- "Answer the action block of the receiver."
-
- ^ block!! !!
-
-
-!!PPActionParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 5/7/2011 15:08''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ]!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPActionParser class
- instanceVariableNames: ''''!!
-!!PPActionParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPActionParser class methodsFor: ''instance creation'' stamp: ''lr 5/2/2010 16:58''!!
-on: aParser block: aBlock
- ^ (self on: aParser) setBlock: aBlock!! !!
-
-
-PPActionParser subclass: #PPWrappingParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPWrappingParser commentStamp: ''<historical>'' prior: 0!!
-A parser that performs an action block upon activation with the stream and a continuation block.!!
-
-
-!!PPWrappingParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!!
-parseOn: aPPContext
- ^ block value: aPPContext value: [ parser parseOn: aPPContext ]!! !!
-
-
-PPParser subclass: #PPListParser
- instanceVariableNames: ''parsers''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPListParser commentStamp: ''<historical>'' prior: 0!!
-Abstract parser that parses a list of things in some way (to be specified by the subclasses).
-
-Instance Variables:
- parsers <SequenceableCollection of: PPParser> A sequence of other parsers to delegate to.!!
-
-
-!!PPListParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/30/2010 08:15''!!
-copyInContext: aDictionary seen: aSeenDictionary
- | copy copies |
- aSeenDictionary at: self ifPresent: [ :value | ^ value ].
- copy := aSeenDictionary at: self put: self copy.
- copies := OrderedCollection new.
- parsers do: [ :each |
- | result |
- result := each
- copyInContext: aDictionary
- seen: aSeenDictionary.
- result isCollection
- ifTrue: [ copies addAll: result ]
- ifFalse: [ copies add: result ] ].
- ^ copy
- setParsers: copies;
- yourself!! !!
-
-
-!!PPListParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 5/22/2010 10:24''!!
-replace: aParser with: anotherParser
- super replace: aParser with: anotherParser.
- parsers keysAndValuesDo: [ :index :parser |
- parser == aParser
- ifTrue: [ parsers at: index put: anotherParser ] ]!! !!
-
-
-!!PPListParser methodsFor: ''initialization'' stamp: ''lr 4/29/2010 10:12''!!
-setParsers: aCollection
- parsers := aCollection asArray!! !!
-
-!!PPListParser methodsFor: ''initialization'' stamp: ''lr 4/29/2010 10:12''!!
-initialize
- super initialize.
- self setParsers: #()!! !!
-
-
-!!PPListParser methodsFor: ''accessing'' stamp: ''lr 10/21/2009 16:37''!!
-children
- ^ parsers!! !!
-
-
-!!PPListParser methodsFor: ''copying'' stamp: ''lr 9/17/2008 22:36''!!
-copyWith: aParser
- ^ self species withAll: (parsers copyWith: aParser)!! !!
-
-!!PPListParser methodsFor: ''copying'' stamp: ''lr 5/22/2010 10:26''!!
-postCopy
- super postCopy.
- parsers := parsers copy!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPListParser class
- instanceVariableNames: ''''!!
-!!PPListParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPListParser class methodsFor: ''instance creation'' stamp: ''lr 9/23/2008 18:32''!!
-with: aFirstParser with: aSecondParser
- ^ self withAll: (Array with: aFirstParser with: aSecondParser)!! !!
-
-!!PPListParser class methodsFor: ''instance creation'' stamp: ''lr 5/3/2010 20:26''!!
-with: aParser
- ^ self withAll: (Array with: aParser)!! !!
-
-!!PPListParser class methodsFor: ''instance creation'' stamp: ''lr 4/29/2010 10:12''!!
-withAll: aCollection
- ^ self basicNew setParsers: aCollection!! !!
-
-
-PPListParser subclass: #PPChoiceParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPChoiceParser commentStamp: ''lr 4/18/2008 15:35'' prior: 0!!
-A parser that uses the first parser that succeeds.!!
-
-
-!!PPChoiceParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:42''!!
-visualizationGraphType
- ^ ''/''!! !!
-
-
-!!PPChoiceParser methodsFor: ''operators'' stamp: ''lr 9/17/2008 00:16''!!
-/ aRule
- ^ self copyWith: aRule!! !!
-
-
-!!PPChoiceParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!!
-parseOn: aPPContext
- "This is optimized code that avoids unnecessary block activations, do not change. When all choices fail, the last failure is answered."
-
- | element |
- 1 to: parsers size do: [ :index |
- element := (parsers at: index)
- parseOn: aPPContext.
- element isPetitFailure
- ifFalse: [ ^ element ] ].
- ^ element!! !!
-
-
-!!PPChoiceParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 5/2/2010 20:15''!!
-exampleOn: aStream
- "If there is already a lot written, try to pick an empty possiblity."
-
- aStream position > 512 ifTrue: [
- (parsers anySatisfy: [ :each | each isNullable ])
- ifTrue: [ ^ self ] ].
- parsers atRandom exampleOn: aStream!! !!
-
-!!PPChoiceParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 11:14''!!
-morphicShapeSeen: aSet depth: anInteger
- ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |
- | morph |
- morph := self newColumnMorph
- cellInset: 5;
- yourself.
- self children do: [ :each |
- morph addMorphBack: (self newRowMorph
- hResizing: #spaceFill;
- addMorphBack: (cc value: each);
- addMorphBack: (self newColumnMorph
- hResizing: #spaceFill;
- addMorphBack: (self newSpacerMorph height: 10);
- addMorphBack: ((LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)
- hResizing: #spaceFill;
- minWidth: 20;
- yourself);
- yourself);
- yourself) ].
- morph fullBounds.
- self newRowMorph
- addMorphBack: (self newColumnMorph
- addMorphBack: (self newSpacerMorph height: 10);
- addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);
- yourself);
- addMorphBack: (self newColumnMorph
- addMorphBack: (self newSpacerMorph width: 1; height: 10);
- addMorphBack: (LineMorph from: 0 @ 0 to: 0 @ (morph height - 23) color: Color black width: 1);
- yourself);
- addMorphBack: morph;
- addMorphBack: (self newColumnMorph
- addMorphBack: (self newSpacerMorph width: 1; height: 10);
- addMorphBack: (LineMorph from: 0 @ (morph height - 23) to: 0 @ 0 color: Color black width: 1)
- makeForwardArrow;
- width: 1;
- yourself);
- yourself ]!! !!
-
-
-PPDelegateParser subclass: #PPNotParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPNotParser commentStamp: ''<historical>'' prior: 0!!
-The not-predicate, a parser that succeeds whenever its delegate does not, but consumes no input [Parr 1994, 1995].!!
-
-
-!!PPNotParser methodsFor: ''*petitanalyzer-testing'' stamp: ''JanKurs 5/31/2013 11:50''!!
-isFirstSetTerminal
- ^ true!! !!
-
-
-!!PPNotParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:01''!!
-parseOn: aPPContext
- | element position |
- position := aPPContext remember.
- element := parser parseOn: aPPContext.
- aPPContext restore: position.
- ^ element isPetitFailure
- ifFalse: [ PPFailure message: '''' context: aPPContext ]!! !!
-
-
-!!PPNotParser methodsFor: ''*petitanalyzer-private'' stamp: ''JanKurs 5/31/2013 11:50''!!
-firstSets: aFirstDictionary into: aSet
- !! !!
-
-
-!!PPNotParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/11/2009 21:09''!!
-exampleOn: aStream!! !!
-
-!!PPNotParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:17''!!
-displayDescription
- ^ ''not''!! !!
-
-
-PPLiteralParser subclass: #PPLiteralSequenceParser
- instanceVariableNames: ''size''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPLiteralSequenceParser commentStamp: ''lr 12/4/2009 18:39'' prior: 0!!
-A parser accepts a sequence of literal objects, such as a String. This is an optimization to avoid having to compose longer sequences from PPSequenceParser.!!
-
-
-!!PPLiteralSequenceParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:38''!!
-parseOn: aPPContext
- | memento result |
- memento := aPPContext remember.
- result := aPPContext stream next: size.
- literal = result ifTrue: [ ^ result ].
- aPPContext restore: memento.
- ^ PPFailure message: message context: aPPContext!! !!
-
-
-!!PPLiteralSequenceParser methodsFor: ''initialization'' stamp: ''lr 6/1/2010 22:21''!!
-initializeOn: anObject message: aString
- super initializeOn: anObject message: aString.
- size := literal size!! !!
-
-
-!!PPLiteralSequenceParser methodsFor: ''accessing'' stamp: ''lr 9/15/2010 11:16''!!
-size
- "Answer the sequence size of the receiver."
-
- ^ size!! !!
-
-
-!!PPLiteralSequenceParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:25''!!
-exampleOn: aStream
- aStream nextPutAll: literal!! !!
-
-
-!!PPLiteralSequenceParser methodsFor: ''operators'' stamp: ''lr 8/18/2010 20:16''!!
-caseInsensitive
- "Answer a parser that can parse the receiver case-insensitive."
-
- literal asUppercase = literal asLowercase ifTrue: [ ^ self ].
- ^ PPPredicateSequenceParser on: [ :value | literal sameAs: value ] message: message size: size!! !!
-
-
-PPDelegateParser subclass: #PPOptionalParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPOptionalParser commentStamp: ''lr 4/3/2011 14:46'' prior: 0!!
-A parser that optionally parsers its delegate, or answers nil.!!
-
-
-!!PPOptionalParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 9/1/2010 22:10''!!
-isNullable
- ^ true!! !!
-
-
-!!PPOptionalParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:44''!!
-visualizationGraphType
- ^ ''?''!! !!
-
-
-!!PPOptionalParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/19/2014 15:12''!!
-parseOn: aPPContext
- | element |
- element := parser parseOn: aPPContext.
- ^ element isPetitFailure ifFalse: [ element ]!! !!
-
-
-PPDelegateParser subclass: #PPFlattenParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPFlattenParser commentStamp: ''lr 11/22/2009 13:09'' prior: 0!!
-A parser that answers a flat copy of the range my delegate parses.!!
-
-
-!!PPFlattenParser methodsFor: ''private'' stamp: ''lr 2/25/2013 23:31''!!
-on: aCollection start: aStartInteger stop: aStopInteger value: anObject
- ^ aCollection copyFrom: aStartInteger to: aStopInteger!! !!
-
-
-!!PPFlattenParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:42''!!
-parseOn: aPPContext
- | start element |
- start := aPPContext stream position.
- element := parser parseOn: aPPContext.
- element isPetitFailure ifTrue: [ ^ element ].
- ^ self on: aPPContext stream collection start: start + 1 stop: aPPContext stream position value: element!! !!
-
-
-PPFlattenParser subclass: #PPTokenParser
- instanceVariableNames: ''tokenClass''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPTokenParser commentStamp: ''lr 2/25/2013 23:31'' prior: 0!!
-A parser that answers a token with the value of my delegate parses.
-
-Instance Variables:
- tokenClass <PPToken class> The token sub-class to be used.!!
-
-
-!!PPTokenParser methodsFor: ''private'' stamp: ''lr 4/6/2010 19:18''!!
-defaultTokenClass
- ^ PPToken!! !!
-
-!!PPTokenParser methodsFor: ''private'' stamp: ''lr 2/25/2013 23:32''!!
-on: aCollection start: aStartInteger stop: aStopInteger value: anObject
- ^ self tokenClass on: aCollection start: aStartInteger stop: aStopInteger value: anObject!! !!
-
-
-!!PPTokenParser methodsFor: ''initialization'' stamp: ''lr 4/6/2010 19:19''!!
-initialize
- tokenClass := self defaultTokenClass
- !! !!
-
-
-!!PPTokenParser methodsFor: ''accessing'' stamp: ''lr 4/6/2010 19:23''!!
-tokenClass
- ^ tokenClass!! !!
-
-!!PPTokenParser methodsFor: ''accessing'' stamp: ''lr 4/6/2010 19:24''!!
-tokenClass: aTokenClass
- tokenClass := aTokenClass!! !!
-
-
-!!PPTokenParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self tokenClass = aParser tokenClass ]!! !!
-
-
-PPDelegateParser subclass: #PPRepeatingParser
- instanceVariableNames: ''min max''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPRepeatingParser commentStamp: ''lr 4/3/2011 14:45'' prior: 0!!
-An abstract parser that repeatedly parses between ''min'' and ''max'' instances of its delegate. The default configuration parses an infinite number of elements, as ''min'' is set to 0 and ''max'' to infinity (SmallInteger maxVal).
-
-Instance Variables:
- min <Integer> The minimum number of repetitions.
- max <Integer> The maximum number of repetitions.!!
-
-
-!!PPRepeatingParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self min = aParser min and: [ self max = aParser max ] ]!! !!
-
-
-!!PPRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/1/2011 21:00''!!
-setMax: anInteger
- max := anInteger!! !!
-
-!!PPRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/1/2011 21:01''!!
-setMin: anInteger
- min := anInteger!! !!
-
-!!PPRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/1/2011 21:06''!!
-initialize
- super initialize.
- self setMin: 0; setMax: SmallInteger maxVal!! !!
-
-
-!!PPRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:08''!!
-max
- "Answer the maximum number of repetitions."
-
- ^ max!! !!
-
-!!PPRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:08''!!
-min
- "Answer the minimum number of repetitions."
-
- ^ min!! !!
-
-
-!!PPRepeatingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/11/2009 20:57''!!
-exampleOn: aStream
- "Perform the minimal repeatitions required, and a random amount of more if possible and if not that much output has been produced yet."
-
- min timesRepeat: [
- super exampleOn: aStream ].
- (max - min min: 5) atRandom timesRepeat: [
- aStream position > 512
- ifTrue: [ ^ self ].
- super exampleOn: aStream ]!! !!
-
-!!PPRepeatingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:18''!!
-displayDescription
- ^ String streamContents: [ :stream |
- min = 0
- ifFalse: [ stream print: min; nextPutAll: ''..'' ].
- max = SmallInteger maxVal
- ifTrue: [ stream nextPut: $* ]
- ifFalse: [ stream print: max ] ]!! !!
-
-
-!!PPRepeatingParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 10/21/2009 12:13''!!
-isNullable
- ^ min = 0!! !!
-
-
-!!PPRepeatingParser methodsFor: ''*petitanalyzer-private'' stamp: ''JanKurs 5/31/2013 11:51''!!
-followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet
- | firstSet |
- super followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet.
-
- firstSet := aFirstDictionary at: self.
- self children do: [:p | (aFollowDictionary at: p) addAll: (firstSet reject: [:each | each isNullable]) ]!! !!
-
-
-!!PPRepeatingParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:44''!!
-visualizationGraphType
- ^ ''*''!! !!
-
-
-!!PPRepeatingParser methodsFor: ''printing'' stamp: ''lr 6/3/2010 14:00''!!
-printOn: aStream
- super printOn: aStream.
- aStream nextPutAll: '' [''; print: min; nextPutAll: '', ''; nextPutAll: (max = SmallInteger maxVal
- ifTrue: [ ''*'' ] ifFalse: [ max printString ]); nextPut: $]!! !!
-
-
-PPRepeatingParser subclass: #PPPossessiveRepeatingParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPPossessiveRepeatingParser commentStamp: ''lr 4/3/2011 14:35'' prior: 0!!
-The default repeating parser with standard PEG semantics (i.e. possessive, blind, eager).!!
-
-
-!!PPPossessiveRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:43''!!
-parseOn: aPPContext
- | start element elements |
- start := aPPContext remember.
- elements := OrderedCollection new.
- [ elements size < min ] whileTrue: [
- (element := parser parseOn: aPPContext) isPetitFailure ifTrue: [
- aPPContext restore: start.
- ^ element ].
- elements addLast: element ].
- [ elements size < max ] whileTrue: [
- (element := parser parseOn: aPPContext) isPetitFailure
- ifTrue: [ ^ elements asArray ].
- elements addLast: element ].
- ^ elements asArray!! !!
-
-
-PPRepeatingParser subclass: #PPLimitedRepeatingParser
- instanceVariableNames: ''limit''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPLimitedRepeatingParser commentStamp: ''lr 4/3/2011 14:37'' prior: 0!!
-An abstract parser that repeatedly parses between ''min'' and ''max'' instances of my delegate and that requires the input to be completed with a specified parser ''limit''. Subclasses provide repeating behavior as typically seen in regular expression implementations (non-blind).
-
-Instance Variables:
- limit <PPParser> The parser to complete the input with.!!
-
-
-!!PPLimitedRepeatingParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 4/4/2011 18:46''!!
-replace: aParser with: anotherParser
- super replace: aParser with: anotherParser.
- limit == aParser ifTrue: [ limit := anotherParser ]!! !!
-
-
-!!PPLimitedRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/2/2011 10:00''!!
-setLimit: aParser
- limit := aParser!! !!
-
-
-!!PPLimitedRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/4/2011 18:46''!!
-children
- ^ Array with: parser with: limit!! !!
-
-!!PPLimitedRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/2/2011 10:00''!!
-limit
- "Answer the parser that limits (or ends) this repetition."
-
- ^ limit!! !!
-
-
-!!PPLimitedRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 16:04''!!
-matchesLimitOn: aPPContext
- | element position |
- position := aPPContext remember.
- element := limit parseOn: aPPContext.
- aPPContext restore: position.
- ^ element isPetitFailure not!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPLimitedRepeatingParser class
- instanceVariableNames: ''''!!
-!!PPLimitedRepeatingParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPLimitedRepeatingParser class methodsFor: ''instance creation'' stamp: ''lr 4/3/2011 14:58''!!
-on: aParser limit: aLimitParser
- ^ (self on: aParser) setLimit: aLimitParser!! !!
-
-
-PPLimitedRepeatingParser subclass: #PPGreedyRepeatingParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPGreedyRepeatingParser commentStamp: ''lr 4/3/2011 15:08'' prior: 0!!
-A greedy repeating parser, commonly seen in regular expression implementations. It aggressively consumes as much input as possible and then backtracks to meet the ''limit'' condition.
-
-This class essentially implements the iterative version of the following recursive parser composition:
-
- | parser |
- parser := PPChoiceParser new.
- parser setParsers: (Array
- with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ])
- with: (limit and ==> [ :each | OrderedCollection new ])).
- ^ parser ==> [ :rest | rest asArray ]!!
-
-
-!!PPGreedyRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:59''!!
-parseOn: aPPContext
- | start element elements positions |
- start := aPPContext remember.
- elements := OrderedCollection new.
- [ elements size < min ] whileTrue: [
- (element := parser parseOn: aPPContext) isPetitFailure ifTrue: [
- aPPContext restore: start.
- ^ element ].
- elements addLast: element ].
- positions := OrderedCollection with: aPPContext remember.
- [ elements size < max and: [ (element := parser parseOn: aPPContext) isPetitFailure not ] ] whileTrue: [
- elements addLast: element.
- positions addLast: aPPContext remember ].
- [ positions isEmpty ] whileFalse: [
- aPPContext restore: positions last.
- element := limit parseOn: aPPContext.
- element isPetitFailure ifFalse: [
- aPPContext restore: positions last.
- ^ elements asArray ].
- elements isEmpty ifTrue: [
- aPPContext restore: start.
- ^ element ].
- elements removeLast.
- positions removeLast ].
- aPPContext restore: start.
- ^ PPFailure message: ''overflow'' context: aPPContext at: start!! !!
-
-
-PPParser subclass: #PPEpsilonParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPEpsilonParser commentStamp: ''lr 5/15/2008 15:09'' prior: 0!!
-A parser that consumes nothing and always succeeds.!!
-
-
-!!PPEpsilonParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 10/21/2009 12:11''!!
-isNullable
- ^ true!! !!
-
-
-!!PPEpsilonParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 11:15''!!
-morphicShapeSeen: aSet depth: anInteger
- ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |
- self newRowMorph
- addMorphBack: (self newColumnMorph
- addMorphBack: (self newSpacerMorph height: 10);
- addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);
- yourself);
- yourself ]!! !!
-
-
-!!PPEpsilonParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/6/2009 18:42''!!
-displayName
- ^ ''epsilon''!! !!
-
-
-!!PPEpsilonParser methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:49''!!
-parseOn: aStream
- ^ nil!! !!
-
-
-PPLimitedRepeatingParser subclass: #PPLazyRepeatingParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPLazyRepeatingParser commentStamp: ''lr 4/3/2011 15:08'' prior: 0!!
-A lazy repeating parser, commonly seen in regular expression implementations. It limits its consumption to meet the ''limit'' condition as early as possible.
-
-This class essentially implements the iterative version of the following recursive parser composition:
-
- | parser |
- parser := PPChoiceParser new.
- parser setParsers: (Array
- with: (limit and ==> [ :each | OrderedCollection new ])
- with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ])).
- ^ parser ==> [ :rest | rest asArray ]!!
-
-
-!!PPLazyRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:00''!!
-parseOn: aPPContext
- | start element elements |
- start := aPPContext remember.
- elements := OrderedCollection new.
- [ elements size < min ] whileTrue: [
- (element := parser parseOn: aPPContext) isPetitFailure ifTrue: [
- aPPContext restore: start.
- ^ element ].
- elements addLast: element ].
- [ self matchesLimitOn: aPPContext ] whileFalse: [
- elements size < max ifFalse: [
- aPPContext restore: start.
- ^ PPFailure message: ''overflow'' context: aPPContext at: start ].
- element := parser parseOn: aPPContext.
- element isPetitFailure ifTrue: [
- aPPContext restore: start.
- ^ element ].
- elements addLast: element ].
- ^ elements asArray!! !!
-
-
-PPListParser subclass: #PPSequenceParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPSequenceParser commentStamp: ''lr 4/18/2008 15:34'' prior: 0!!
-A parser that parses a sequence of parsers.!!
-
-
-!!PPSequenceParser methodsFor: ''operators-mapping'' stamp: ''lr 5/6/2011 20:27''!!
-map: aBlock
- ^ aBlock numArgs = self children size
- ifTrue: [ self ==> [ :nodes | aBlock valueWithArguments: nodes ] ]
- ifFalse: [ self error: aBlock numArgs asString , '' arguments expected.'' ]!! !!
-
-!!PPSequenceParser methodsFor: ''operators-mapping'' stamp: ''lr 1/8/2010 12:01''!!
-permutation: anArrayOfIntegers
- "Answer a permutation of the receivers sequence."
-
- anArrayOfIntegers do: [ :index |
- (index isInteger and: [ index between: 1 and: parsers size ])
- ifFalse: [ self error: ''Invalid permutation index: '' , index printString ] ].
- ^ self ==> [ :nodes | anArrayOfIntegers collect: [ :index | nodes at: index ] ]!! !!
-
-
-!!PPSequenceParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/17/2009 21:54''!!
-morphicShapeSeen: aSet depth: anInteger
- ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |
- self children
- inject: self newRowMorph
- into: [ :result :each |
- result
- addMorphBack: (cc value: each);
- yourself ] ]!! !!
-
-
-!!PPSequenceParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:24''!!
-exampleOn: aStream
- parsers do: [ :each | each exampleOn: aStream ]!! !!
-
-
-!!PPSequenceParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:43''!!
-parseOn: aPPContext
- "This is optimized code that avoids unnecessary block activations, do not change."
-
- | start elements element |
- start := aPPContext remember.
- elements := Array new: parsers size.
- 1 to: parsers size do: [ :index |
- element := (parsers at: index)
- parseOn: aPPContext.
- element isPetitFailure ifTrue: [
- aPPContext restore: start.
- ^ element ].
- elements at: index put: element ].
- ^ elements!! !!
-
-
-!!PPSequenceParser methodsFor: ''operators'' stamp: ''lr 9/17/2008 00:17''!!
-, aRule
- ^ self copyWith: aRule!! !!
-
-
-!!PPSequenceParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 12/9/2010 10:37''!!
-cycleSet: aDictionary
- | firstSet |
- 1 to: parsers size do: [ :index |
- firstSet := aDictionary at: (parsers at: index).
- (firstSet anySatisfy: [ :each | each isNullable ])
- ifFalse: [ ^ parsers copyFrom: 1 to: index ] ].
- ^ parsers!! !!
-
-!!PPSequenceParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 9/16/2010 17:56''!!
-firstSets: aFirstDictionary into: aSet
- | nullable |
- parsers do: [ :parser |
- nullable := false.
- (aFirstDictionary at: parser) do: [ :each |
- each isNullable
- ifTrue: [ nullable := true ]
- ifFalse: [ aSet add: each ] ].
- nullable
- ifFalse: [ ^ self ] ].
- aSet add: PPSentinel instance!! !!
-
-!!PPSequenceParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 8/14/2010 13:51''!!
-followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet
- parsers keysAndValuesDo: [ :index :parser |
- | followSet firstSet |
- followSet := aFollowDictionary at: parser.
- index = parsers size
- ifTrue: [ followSet addAll: aSet ]
- ifFalse: [
- (self class withAll: (parsers
- copyFrom: index + 1 to: parsers size))
- firstSets: aFirstDictionary
- into: (firstSet := IdentitySet new).
- (firstSet anySatisfy: [ :each | each isNullable ])
- ifTrue: [ followSet addAll: aSet ].
- followSet addAll: (firstSet
- reject: [ :each | each isNullable ]) ] ]!! !!
-
-
-!!PPSequenceParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:44''!!
-visualizationGraphType
- ^ '',''!! !!
-Object subclass: #PPFailure
- instanceVariableNames: ''message context position''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Core''!!
-!!PPFailure commentStamp: ''<historical>'' prior: 0!!
-The failure object in PetitParser. It is the only class that responds to #isPetitFailure with true. It contains an error message and a position of the occurrence of the failure.
-
-Instance Variables:
- message <String> The error message of this failure.
- position <Integer> The position of this failure in the input stream.
-!!
-
-
-!!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:39''!!
-sampleIn: composite
-
- (composite text)
- title: ''Sample'';
- display: [:res | res findStream contents ifNil: [''''] ];
- allowNil.!! !!
-
-!!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:40''!!
-treeViewIn: composite
- composite tree
- title: ''Execution Traces'';
- format: [:resultNode | resultNode formattedText ];
- children: [:resultNode | resultNode showChildren
- ifTrue: [ resultNode children ]
- ifFalse: [ #() ] ]. !! !!
-
-!!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:53''!!
-gtDebugView: composite
- <gtInspectorPresentationOrder: 40>
-
- | browser |
- browser :=
- composite tabulator.
-
- browser title: ''Debug View''.
- browser row: #tree;
- row: #source.
- browser transmit
- fromOutsideEntityPort;
- toOutsidePort: #debugResult;
- transformed: [ :failure | failure debugResult ].
-
- browser transmit
- from: #tree;
- to: #source port: #selectionInterval;
- transformed: [:debuggingResult |
- debuggingResult ifNotNil: [
- debuggingResult start to: debuggingResult end]
- ].
-
- browser transmit
- fromOutsidePort: #debugResult;
- to: #source;
- andShow: [ :a | self sampleIn: a ].
-
- browser transmit
- fromOutsidePort: #debugResult;
- to: #tree;
- andShow: [ :a | self treeViewIn: a ].
-
- browser startOn: self!! !!
-
-!!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:54''!!
-debugResult
- ^ context root enableDebug parse: context stream reset!! !!
-
-
-!!PPFailure methodsFor: ''testing'' stamp: ''lr 2/7/2010 20:54''!!
-isPetitFailure
- "I am the only class that should implement this method to return true."
-
- ^ true!! !!
-
-
-!!PPFailure methodsFor: ''printing'' stamp: ''JanKurs 8/19/2014 16:30''!!
-printOn: aStream
- aStream nextPutAll: self message; nextPutAll: '' at ''; print: self position!! !!
-
-
-!!PPFailure methodsFor: ''initialization'' stamp: ''JanKurs 8/19/2014 16:57''!!
-initializeMessage: aString context: aPPContext
- self initializeMessage: aString context: aPPContext position: aPPContext position!! !!
-
-!!PPFailure methodsFor: ''initialization'' stamp: ''JanKurs 8/19/2014 16:33''!!
-initializeMessage: aString at: anInteger
- self halt: ''deprecated''.!! !!
-
-!!PPFailure methodsFor: ''initialization'' stamp: ''JanKurs 8/19/2014 16:57''!!
-initializeMessage: aString context: aPPContext position: position
- message := aString.
- context := aPPContext.
- position := position.!! !!
-
-
-!!PPFailure methodsFor: ''accessing'' stamp: ''lr 5/5/2010 13:56''!!
-message
- "Answer a human readable error message of this parse failure."
-
- ^ message!! !!
-
-!!PPFailure methodsFor: ''accessing'' stamp: ''lr 5/5/2010 13:55''!!
-position
- "Answer the position in the source string that caused this parse failure."
-
- ^ position!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPFailure class
- instanceVariableNames: ''''!!
-!!PPFailure class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPFailure class methodsFor: ''instance creation'' stamp: ''JanKurs 8/19/2014 16:33''!!
-message: aString at: anInteger
- self halt: ''deprecated, use message:context:''.
- ^ self basicNew initializeMessage: aString at: anInteger!! !!
-
-!!PPFailure class methodsFor: ''instance creation'' stamp: ''JanKurs 8/19/2014 16:32''!!
-message: aString context: aPPContext
- ^ self basicNew initializeMessage: aString context: aPPContext!! !!
-
-!!PPFailure class methodsFor: ''instance creation'' stamp: ''JanKurs 8/19/2014 16:57''!!
-message: aString context: aPPContext at: position
- ^ self basicNew initializeMessage: aString context: aPPContext position: position!! !!
-
-
-ReadStream subclass: #PPStream
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Core''!!
-!!PPStream commentStamp: ''<historical>'' prior: 0!!
-A positional stream implementation used for parsing. It overrides some methods for optimization reasons.!!
-
-
-!!PPStream methodsFor: ''accessing'' stamp: ''lr 4/29/2008 21:48''!!
-peek
- "An improved version of peek, that is slightly faster than the built in version."
-
- ^ self atEnd ifFalse: [ collection at: position + 1 ]!! !!
-
-!!PPStream methodsFor: ''accessing'' stamp: ''lr 10/5/2010 16:29''!!
-uncheckedPeek
- "An unchecked version of peek that throws an error if we try to peek over the end of the stream, even faster than #peek."
-
- ^ collection at: position + 1!! !!
-
-!!PPStream methodsFor: ''accessing'' stamp: ''lr 2/13/2012 20:25''!!
-collection
- "Answer the underlying collection."
-
- ^ collection!! !!
-
-!!PPStream methodsFor: ''accessing'' stamp: ''lr 8/25/2010 11:36''!!
-position: anInteger
- "The receiver does not check for invalid arguments passed to this method, as it is solely used with valid indexes for backtracking."
-
- position := anInteger!! !!
-
-
-!!PPStream methodsFor: ''printing'' stamp: ''lr 11/4/2010 19:23''!!
-printOn: aStream
- collection isString
- ifFalse: [ ^ super printOn: aStream ].
- aStream
- nextPutAll: (collection copyFrom: 1 to: position);
- nextPutAll: ''·'';
- nextPutAll: (collection copyFrom: position + 1 to: readLimit)!! !!
-
-
-!!PPStream methodsFor: ''converting'' stamp: ''lr 2/7/2010 20:53''!!
-asPetitStream
- ^ self!! !!
-
-
-Object subclass: #PPToken
- instanceVariableNames: ''collection start stop value''
- classVariableNames: ''NewLineParser''
- poolDictionaries: ''''
- category: ''PetitParser-Core''!!
-!!PPToken commentStamp: ''lr 2/25/2013 23:34'' prior: 0!!
-PPToken represents a parsed part of the input stream. Contrary to a simple String it remembers where it came from, the original collection, its start and stop position and its parse value.
-
-Instance Variables:
- collection <SequenceableCollection> The collection this token comes from.
- start <Integer> The start position in the collection.
- stop <Integer> The stop position in the collection.
- value <Object> The parse result.!!
-
-
-!!PPToken methodsFor: ''querying'' stamp: ''lr 9/7/2011 20:41''!!
-line
- "Answer the line number of this token in the underlying collection."
-
- | line |
- line := 1.
- (NewLineParser , [ :stream |
- start <= stream position
- ifTrue: [ ^ line ].
- line := line + 1 ] asParser
- / #any asParser) star
- parse: collection.
- ^ line!! !!
-
-!!PPToken methodsFor: ''querying'' stamp: ''lr 9/7/2011 20:40''!!
-column
- "Answer the column number of this token in the underlying collection."
-
- | position |
- position := 0.
- (NewLineParser , [ :stream |
- start <= stream position
- ifTrue: [ ^ start - position ].
- position := stream position ] asParser
- / #any asParser) star
- parse: collection.
- ^ start - position!! !!
-
-
-!!PPToken methodsFor: ''initialization'' stamp: ''lr 2/25/2013 23:36''!!
-initializeOn: aSequenceableCollection start: aStartInteger stop: aStopInteger value: anObject
- collection := aSequenceableCollection.
- start := aStartInteger.
- stop := aStopInteger.
- value := anObject!! !!
-
-
-!!PPToken methodsFor: ''accessing'' stamp: ''lr 6/15/2010 23:33''!!
-stop
- "Answer the stop position of this token in the underlying collection."
-
- ^ stop!! !!
-
-!!PPToken methodsFor: ''accessing'' stamp: ''lr 2/25/2013 23:56''!!
-size
- "Answer the size of this token in the underlying collection."
-
- ^ stop - start + 1!! !!
-
-!!PPToken methodsFor: ''accessing'' stamp: ''lr 6/15/2010 23:34''!!
-collection
- "Answer the underlying collection of this token."
-
- ^ collection!! !!
-
-!!PPToken methodsFor: ''accessing'' stamp: ''lr 6/15/2010 23:33''!!
-start
- "Answer the start position of this token in the underlying collection."
-
- ^ start!! !!
-
-
-!!PPToken methodsFor: ''printing'' stamp: ''lr 2/26/2013 00:37''!!
-printOn: aStream
- super printOn: aStream.
- aStream nextPut: $[; print: self start; nextPut: $,; print: self stop; nextPut: $].
- aStream nextPut: $(; print: self parsedValue; nextPut: $)!! !!
-
-
-!!PPToken methodsFor: ''copying'' stamp: ''lr 2/26/2013 00:34''!!
-copyFrom: aStartInteger to: aStopInteger
- ^ self class on: collection start: start + aStartInteger - 1 stop: stop + aStopInteger - 3 value: value!! !!
-
-
-!!PPToken methodsFor: ''accessing-values'' stamp: ''lr 2/26/2013 00:34''!!
-value
- self notify: ''Token>>#value is no longer supported. Instead use Token>>#inputValue or the more pragmatic #parsedValue.''.
- ^ self inputValue!! !!
-
-!!PPToken methodsFor: ''accessing-values'' stamp: ''lr 2/26/2013 00:32''!!
-inputValue
- "Answer the consumed input of this token."
-
- ^ collection copyFrom: start to: stop!! !!
-
-!!PPToken methodsFor: ''accessing-values'' stamp: ''lr 2/26/2013 00:32''!!
-parsedValue
- "Answer the parsed value of this token."
-
- ^ value!! !!
-
-
-!!PPToken methodsFor: ''comparing'' stamp: ''lr 2/26/2013 00:34''!!
-= anObject
- ^ self class = anObject class and: [ self parsedValue = anObject parsedValue ]!! !!
-
-!!PPToken methodsFor: ''comparing'' stamp: ''lr 2/26/2013 00:34''!!
-hash
- ^ self parsedValue hash!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPToken class
- instanceVariableNames: ''''!!
-!!PPToken class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPToken class methodsFor: ''initialization'' stamp: ''lr 11/29/2011 20:42''!!
-initialize
- "Platform independent newline sequence. LF: Unix, CR+LF: Windows, and CR: Apple."
-
- NewLineParser := (Character lf asParser) / (Character cr asParser , Character lf asParser optional)!! !!
-
-
-!!PPToken class methodsFor: ''instance creation'' stamp: ''lr 2/25/2013 23:39''!!
-on: aSequenceableCollection start: aStartInteger stop: aStopInteger value: anObject
- ^ self basicNew
- initializeOn: aSequenceableCollection
- start: aStartInteger stop: aStopInteger
- value: anObject!! !!
-
-!!PPToken class methodsFor: ''instance creation'' stamp: ''lr 2/25/2013 23:36''!!
-on: aSequenceableCollection
- ^ self on: aSequenceableCollection start: 1 stop: aSequenceableCollection size value: nil!! !!
-
-!!PPToken class methodsFor: ''instance creation'' stamp: ''lr 4/6/2010 20:58''!!
-new
- self error: ''Token can only be created using a dedicated constructor.''!! !!
-
-
-Object subclass: #PPContextMemento
- instanceVariableNames: ''stream position properties''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Core''!!
-!!PPContextMemento commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPContextMemento methodsFor: ''comparing'' stamp: ''JanKurs 3/19/2014 13:03''!!
-= anObject
-
- (self == anObject) ifTrue: [ ^ true ].
- (anObject class = PPContextMemento) ifFalse: [ ^ false ].
-
- (anObject stream == stream) ifFalse: [ ^ false ].
- (anObject position = position) ifFalse: [ ^ false ].
- (anObject properties = properties) ifFalse: [ ^ false ].
-
- ^ true.
-!! !!
-
-!!PPContextMemento methodsFor: ''comparing'' stamp: ''JanKurs 3/19/2014 13:04''!!
-hash
- ^ (position hash bitXor: stream hash) bitXor: properties hash.!! !!
-
-
-!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
-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 ]!! !!
-
-!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
-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!! !!
-
-!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:14''!!
-propertyAt: aKey
- "Answer the property value associated with aKey."
-
- ^ self propertyAt: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
-
-!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
-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 ]!! !!
-
-!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
-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."
-
- ^ (properties ifNil: [ properties := Dictionary new: 1 ])
- at: aKey put: anObject!! !!
-
-!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:14''!!
-hasProperty: aKey
- "Test if the property aKey is present."
-
- ^ properties notNil and: [ properties includesKey: aKey ]!! !!
-
-!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
-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'' ]!! !!
-
-!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 13:04''!!
-properties
- ^ properties !! !!
-
-
-!!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:52''!!
-stream: aStream
- stream := aStream!! !!
-
-!!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:51''!!
-position
- ^ position!! !!
-
-!!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:52''!!
-position: anInteger
- position := anInteger !! !!
-
-!!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:51''!!
-stream
- ^ stream!! !!
-
-
-Object subclass: #PPContext
- instanceVariableNames: ''stream root properties''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Core''!!
-!!PPContext commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:27''!!
-remember
- | memento |
- memento := PPContextMemento new
- stream: stream;
- position: stream position;
- yourself.
-
- self rememberProperties: memento.
- ^ memento!! !!
-
-!!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:26''!!
-restore: aPPContextMemento
- aPPContextMemento stream == stream ifFalse: [ self error: ''Oops!!!!'' ].
-
- stream position: aPPContextMemento position.
- self restoreProperties: aPPContextMemento.!! !!
-
-!!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:29''!!
-restoreProperties: aPPContextMemento
- aPPContextMemento stream == stream ifFalse: [ self error: ''Oops!!!!'' ].
-
- aPPContextMemento class selectorsAndMethodsDo: [ :selector :method |
- (selector beginsWith: ''restore'') ifTrue: [
- aPPContextMemento withArgs: (Array with: self) executeMethod: method.
- ]
- ]!! !!
-
-!!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:28''!!
-rememberProperties: aPPContextMemento
- aPPContextMemento class selectorsAndMethodsDo: [ :selector :method |
- (selector beginsWith: ''remember'') ifTrue: [
- aPPContextMemento withArgs: (Array with: self) executeMethod: method.
- ]
- ]
-!! !!
-
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:25''!!
-peekTwice
- ^ stream peekTwice!! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/15/2014 16:02''!!
-position
- ^ stream position!! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 8/19/2014 14:08''!!
-uncheckedPeek
- ^ stream uncheckedPeek!! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/15/2014 16:11''!!
-upTo: anObject
- ^ stream upTo: anObject!! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 8/19/2014 14:08''!!
-collection
- ^ stream collection !! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/16/2014 12:13''!!
-atEnd
- ^ stream atEnd!! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:24''!!
-peek
- ^ stream peek!! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:29''!!
-upToAll: whatever
- ^ stream upToAll: whatever!! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 8/19/2014 14:08''!!
-skip: anInteger
- ^ stream skip: anInteger !! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:31''!!
-upToAnyOf: whatever
- ^ stream upToAnyOf: whatever!! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/15/2014 16:02''!!
-next
- ^ stream next!! !!
-
-
-!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
-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 ]!! !!
-
-!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
-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!! !!
-
-!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
-propertyAt: aKey
- "Answer the property value associated with aKey."
-
- ^ self propertyAt: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
-
-!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
-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 ]!! !!
-
-!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
-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."
-
- ^ (properties ifNil: [ properties := Dictionary new: 1 ])
- at: aKey put: anObject!! !!
-
-!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
-hasProperty: aKey
- "Test if the property aKey is present."
-
- ^ properties notNil and: [ properties includesKey: aKey ]!! !!
-
-!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
-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'' ]!! !!
-
-
-!!PPContext methodsFor: ''initialization'' stamp: ''JanKurs 1/16/2014 11:24''!!
-initialize
- stream := nil.!! !!
-
-
-!!PPContext methodsFor: ''as yet unclassified'' stamp: ''JanKurs 3/19/2014 16:26''!!
-parsed: aPPParser at: anInteger result: anObject
- self halt.
- ^ anObject!! !!
-
-
-!!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 10/29/2013 10:13''!!
-root: aPPParser
- root := aPPParser !! !!
-
-!!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 10/29/2013 10:13''!!
-root
- ^ root !! !!
-
-!!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 1/15/2014 15:36''!!
-stream: aStream
- stream := aStream.!! !!
-
-!!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 1/16/2014 15:12''!!
-stream
- ^ stream!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPContext class
- instanceVariableNames: ''''!!
-!!PPContext class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPContext class methodsFor: ''as yet unclassified'' stamp: ''JanKurs 1/16/2014 14:38''!!
-on: aPPParser stream: aStream
- ^ self basicNew
- initialize;
- root: aPPParser;
- stream: aStream asPetitStream;
- yourself!! !!
-
-
-Object subclass: #PPMemento
- instanceVariableNames: ''result count context''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Core''!!
-!!PPMemento commentStamp: ''<historical>'' prior: 0!!
-PPMemento is an internal class used by PPMemoizedParser to cache results and detect left-recursive calls.
-
-Instance Variables:
- result <Object> The cached result.
- count <Integer> The number of recursive cycles followed.
- position <Integer> The position of the cached result in the input stream.!!
-
-
-!!PPMemento methodsFor: ''accessing'' stamp: ''JanKurs 1/15/2014 16:09''!!
-contextMemento: aPPContextMemento
- context := aPPContextMemento
-!! !!
-
-!!PPMemento methodsFor: ''accessing'' stamp: ''JanKurs 1/15/2014 16:09''!!
-contextMemento
- ^ context!! !!
-
-!!PPMemento methodsFor: ''accessing'' stamp: ''lr 4/24/2008 10:15''!!
-result
- ^ result!! !!
-
-!!PPMemento methodsFor: ''accessing'' stamp: ''lr 4/22/2008 18:23''!!
-result: anObject
- result := anObject!! !!
-
-
-!!PPMemento methodsFor: ''accessing-readonly'' stamp: ''lr 4/22/2008 18:23''!!
-count
- ^ count!! !!
-
-
-!!PPMemento methodsFor: ''initialization'' stamp: ''lr 4/22/2008 18:21''!!
-initialize
- count := 0
- !! !!
-
-
-!!PPMemento methodsFor: ''actions'' stamp: ''lr 4/22/2008 18:20''!!
-increment
- count := count + 1!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPMemento class
- instanceVariableNames: ''''!!
-!!PPMemento class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPMemento class methodsFor: ''instance creation'' stamp: ''lr 4/22/2008 18:21''!!
-new
- ^ self basicNew initialize!! !!
-
-PPToken initialize!!''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!SequenceableCollection methodsFor: ''*petitparser-core-converting'' stamp: ''lr 2/7/2010 20:53''!!
-asPetitStream
- ^ PPStream on: self!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Character methodsFor: ''*petitparser-core-operators'' stamp: ''lr 6/12/2010 09:04''!!
-- aCharacter
- "Create a range of characters between the receiver and the argument."
-
- ^ PPPredicateObjectParser between: self and: aCharacter!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Character methodsFor: ''*petitparser-core-converting'' stamp: ''lr 12/18/2011 15:58''!!
-asParser
- "Answer a parser that accepts the receiving character."
-
- ^ PPLiteralObjectParser on: self!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!PositionableStream methodsFor: ''*petitparser-core'' stamp: ''sback 9/3/2010 10:00''!!
-peekTwice
- "Answer what would be returned if the message next were sent to the
- receiver. If the receiver is at the end, answer nil."
-
- | array |
- self atEnd
- ifTrue: [^Array with: nil with: nil].
- array := Array with: (self next) with: (self peek).
- position := position - 1.
- ^array!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Stream methodsFor: ''*petitparser-core-converting'' stamp: ''lr 4/8/2010 14:46''!!
-asPetitStream
- ^ self contents asPetitStream!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Symbol methodsFor: ''*petitparser-core-converting'' stamp: ''lr 12/18/2011 15:58''!!
-asParser
- "Answer a predicate parser named after the receiving symbol. Possible symbols are the method selectors on the class-side of PPPredicateObjectParser."
-
- ^ PPPredicateObjectParser perform: self!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!String methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:48''!!
-asParser
- "Answer a parser that accepts the receiving string."
-
- ^ PPLiteralSequenceParser on: self!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!BlockClosure methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:48''!!
-asParser
- "Answer a parser implemented in the receiving one-argument block."
-
- ^ PPPluggableParser on: self!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!UndefinedObject methodsFor: ''*petitparser-converting'' stamp: ''lr 11/29/2011 20:49''!!
-asParser
- "Answer a parser that succeeds and does not consume anything."
-
- ^ PPEpsilonParser new!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Text methodsFor: ''*petitparser-core-converting'' stamp: ''lr 2/7/2010 20:53''!!
-asPetitStream
- ^ string asPetitStream!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Collection methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:38''!!
-asChoiceParser
- ^ PPChoiceParser withAll: (self collect: [ :each | each asParser ])!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Collection methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:38''!!
-asSequenceParser
- ^ PPSequenceParser withAll: (self collect: [ :each | each asParser ])!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Object methodsFor: ''*petitparser-core-testing'' stamp: ''lr 8/6/2010 16:44''!!
-isPetitParser
- ^ false!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Object methodsFor: ''*petitparser-core-converting'' stamp: ''lr 12/18/2011 15:58''!!
-asParser
- "Answer a parser accepting the receiving object."
-
- ^ PPPredicateObjectParser expect: self!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.314418 pm''!!
-
-!!Object methodsFor: ''*petitparser-core-testing'' stamp: ''lr 2/7/2010 20:54''!!
-isPetitFailure
- ^ false!! !!
-'
-!
-
smalltalkInDirectory: directory
| files |
files := self readDirectory: directory.
files := self files: files withExtension: 'st'.
- ^ files collect: [ :f | (FileStream fileNamed: f) contents asString ]
+ ^ files collect: [ :f | (FileStream fileNamed: f) contents ]
!
smalltalkObjectMethods
@@ -3998,36 +76,16 @@
!PPCBenchmarkResources methodsFor:'private utilities'!
files: files withExtension: extension
- ( (Smalltalk respondsTo: #isSmalltalkX) and:[ Smalltalk isSmalltalkX ] ) ifTrue:[
- ^ files select: [ :f | f suffix = extension ]
- ] ifFalse:[
- "Assuming Pharo..."
- ^ files select: [ :f | f extension = extension ]
- ]
-
- "Modified: / 20-04-2015 / 10:58:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ ^ files select: [ :f | f extension = extension ]
!
readDirectory: directory
- | file |
-
- ( (Smalltalk respondsTo: #isSmalltalkX) and:[ Smalltalk isSmalltalkX ] ) ifTrue:[
- file := directory asFilename.
- file exists ifFalse:[
- self error: 'Directory does not exist'.
- ].
- ^ file recursiveDirectoryContentsAsFilenames select:[:each | each isRegularFile ]
- ] ifFalse:[
- "Assuming Pharo..."
-
- file := directory asFileReference.
- file exists ifFalse: [
- self error: 'Directory does not exist'.
- ].
- ^ file allFiles
- ]
-
- "Modified: / 20-04-2015 / 11:12:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ | file |
+ file := directory asFileReference.
+ file exists ifTrue: [
+ ^ file allFiles
+ ].
+ ^ #()
! !
!PPCBenchmarkResources class methodsFor:'documentation'!
--- a/compiler/benchmarks/bc.mak Fri May 01 13:44:43 2015 +0200
+++ b/compiler/benchmarks/bc.mak Fri May 01 14:04:37 2015 +0200
@@ -35,7 +35,7 @@
-LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\compiler -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser -I$(INCLUDE_TOP)\stx\libbasic
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\compiler -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\java -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser -I$(INCLUDE_TOP)\stx\libbasic
LOCALDEFINES=
STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
--- a/compiler/benchmarks/stx_goodies_petitparser_compiler_benchmarks.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/benchmarks/stx_goodies_petitparser_compiler_benchmarks.st Fri May 01 14:04:37 2015 +0200
@@ -73,6 +73,7 @@
^ #(
#'stx:goodies/petitparser' "PPContext - referenced by PPCBenchmark>>benchmarkSmalltalkGrammar"
#'stx:goodies/petitparser/compiler' "PPCContext - referenced by PPCBenchmark>>benchmarkJavaSyntax"
+ #'stx:goodies/petitparser/parsers/java' "PPJavaSyntax - referenced by PPCBenchmark>>benchmarkJavaSyntax"
#'stx:goodies/petitparser/parsers/smalltalk' "PPSmalltalkGrammar - referenced by PPCBenchmark>>benchmarkSmalltalkGrammar"
#'stx:goodies/refactoryBrowser/parser' "RBParser - referenced by PPCBenchmark>>benchmarkRBParserC"
)
--- a/compiler/extensions.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/extensions.st Fri May 01 14:04:37 2015 +0200
@@ -43,6 +43,14 @@
!PPCharSetPredicate methodsFor:'*petitcompiler'!
+= anObject
+ self == anObject ifTrue: [ ^ true ].
+ self class == anObject class ifFalse: [ ^ false ].
+ ^ classification = anObject classification
+! !
+
+!PPCharSetPredicate methodsFor:'*petitcompiler'!
+
block
^ block
! !
@@ -62,6 +70,12 @@
^ classification = anotherPredicate classification.
! !
+!PPCharSetPredicate methodsFor:'*petitcompiler'!
+
+hash
+ ^ classification hash
+! !
+
!PPChoiceParser methodsFor:'*petitcompiler'!
asCompilerNode
@@ -88,6 +102,12 @@
!PPContext methodsFor:'*petitcompiler'!
+atWs
+ ^ false
+! !
+
+!PPContext methodsFor:'*petitcompiler'!
+
comment
^ self globalAt: #comment ifAbsent: [ nil ].
! !
@@ -124,12 +144,24 @@
!PPContext methodsFor:'*petitcompiler'!
+methodInvoked: whatever
+ "nothing to do"
+! !
+
+!PPContext methodsFor:'*petitcompiler'!
+
peek: anInteger
^ stream peek: anInteger
! !
!PPContext methodsFor:'*petitcompiler'!
+setWs
+ "nothing to do"
+! !
+
+!PPContext methodsFor:'*petitcompiler'!
+
whitespace
^ self globalAt: #whitespace ifAbsent: [ nil ].
! !
@@ -198,6 +230,20 @@
position := anInteger
! !
+!PPJavaWhitespaceParser methodsFor:'*petitcompiler'!
+
+= anotherParser
+ anotherParser == self ifTrue: [ ^ true ].
+ anotherParser class = self class ifFalse: [ ^ false ].
+ ^ anotherParser name = self name
+! !
+
+!PPJavaWhitespaceParser methodsFor:'*petitcompiler'!
+
+hash
+ ^ self name hash
+! !
+
!PPLiteralObjectParser methodsFor:'*petitcompiler'!
asCompilerNode
@@ -290,42 +336,39 @@
!PPParser methodsFor:'*petitcompiler'!
compile
- ^ self compile: #PPGeneratedParser
+ ^ self compile: PPCArguments default
! !
!PPParser methodsFor:'*petitcompiler'!
-compile: name
- ^ self compile: name parameters: #()
-! !
-
-!PPParser methodsFor:'*petitcompiler'!
-
-compile: name andParse: input
- ^ (self compile: name) parse: input
+compile: arguments
+ self assert: (arguments isKindOf: PPCArguments).
+
+ ^ PPCConfiguration default
+ arguments: arguments;
+ compile: self
! !
!PPParser methodsFor:'*petitcompiler'!
-compile: name parameters: params
- ^ (PPCCompiler new parameters: params; compile: self as: name) new
+compile: arguments andParse: input
+ ^ (self compile: arguments) parse: input
! !
!PPParser methodsFor:'*petitcompiler'!
-compileWith: aPetitCompiler
- | compiled |
- self children do: [ :child |
- compiled := child compileWith: aPetitCompiler.
- self replace: child with: compiled bridge.
- ].
- ^ aPetitCompiler compileBridgeTo: self
+compileAs: name
+ | arguments |
+ arguments := PPCArguments default.
+ arguments name: name.
+
+ ^ self compile: arguments
! !
!PPParser methodsFor:'*petitcompiler'!
-compileWithParameters: params
- ^ self compile: #PPGeneratedParser parameters: params
+compileWithConfiguration: configuration
+ ^ configuration compile: self
! !
!PPParser methodsFor:'*petitcompiler'!
@@ -388,6 +431,16 @@
!PPParser methodsFor:'*petitcompiler'!
+javaToken
+ | ws |
+ ws := PPJavaWhitespaceParser new.
+ ^ ((ws, ((PPTokenParser on: self) tokenClass: PPJavaToken; yourself), ws) ==> #second)
+ propertyAt: #'trimmingToken' put: true;
+ yourself
+! !
+
+!PPParser methodsFor:'*petitcompiler'!
+
optimize
^ self copy
! !
@@ -524,16 +577,6 @@
!PPSmalltalkGrammar methodsFor:'*petitcompiler'!
-updateContext: aPPContext
- super updateContext: aPPContext.
-"
- aPPContext globalAt: #comment ifAbsentPut: [ self comment ].
- aPPContext globalAt: #whitespace ifAbsentPut: [ PPSmalltalkWhitespaceParser new ].
-"
-! !
-
-!PPSmalltalkGrammar methodsFor:'*petitcompiler'!
-
whitespace
^ #space asParser plus
! !
@@ -566,12 +609,6 @@
!PPSmalltalkTokenParser methodsFor:'*petitcompiler'!
-updateContext: aPPContext
- aPPContext globalAt: #whitespace ifAbsentPut: PPSmalltalkWhitespaceParser new
-! !
-
-!PPSmalltalkTokenParser methodsFor:'*petitcompiler'!
-
whitespace
^ PPSmalltalkWhitespaceParser new
! !
@@ -646,13 +683,6 @@
!PPTokenParser methodsFor:'*petitcompiler'!
-firstSets: aFirstDictionary into: aSet
- "Or keep empty, if token is a terminal"
- ^ super firstSets: aFirstDictionary into: aSet
-! !
-
-!PPTokenParser methodsFor:'*petitcompiler'!
-
isFirstSetTerminal
^ false
! !
@@ -678,8 +708,7 @@
!PPTokenParser methodsFor:'*petitcompiler'!
startsWith: aCharacter
- self first do: [:first | (first startsWith: aCharacter) ifTrue: [ ^ true ] ].
- ^ false
+ ^ self first anySatisfy: [ :first | first startsWith: aCharacter ]
! !
!PPTokenParser methodsFor:'*petitcompiler'!
@@ -697,18 +726,6 @@
yourself
! !
-!PPTrimmingParser methodsFor:'*petitcompiler'!
-
-compileWith: aPetitCompiler
- ^ aPetitCompiler compileTrim: self.
-! !
-
-!PPTrimmingParser methodsFor:'*petitcompiler'!
-
-firstSets: aFirstDictionary into: aSet
- super firstSets: aFirstDictionary into: aSet
-! !
-
!UndefinedObject methodsFor:'*petitcompiler'!
asInteger
--- a/compiler/libInit.cc Fri May 01 13:44:43 2015 +0200
+++ b/compiler/libInit.cc Fri May 01 14:04:37 2015 +0200
@@ -27,72 +27,74 @@
void _libstx_goodies_petitparser_compiler_Init(pass, __pRT__, snd)
OBJ snd; struct __vmData__ *__pRT__; {
__BEGIN_PACKAGE2__("libstx_goodies_petitparser_compiler", _libstx_goodies_petitparser_compiler_Init, "stx:goodies/petitparser/compiler");
+_PPCArguments_Init(pass,__pRT__,snd);
_PPCBridge_Init(pass,__pRT__,snd);
_PPCCompiledMethod_Init(pass,__pRT__,snd);
_PPCCompiler_Init(pass,__pRT__,snd);
+_PPCConfiguration_Init(pass,__pRT__,snd);
_PPCContext_Init(pass,__pRT__,snd);
_PPCContextMemento_Init(pass,__pRT__,snd);
_PPCGuard_Init(pass,__pRT__,snd);
_PPCMethod_Init(pass,__pRT__,snd);
-_PPCMethodStrategy_Init(pass,__pRT__,snd);
_PPCNode_Init(pass,__pRT__,snd);
-_PPCOptimizationResult_Init(pass,__pRT__,snd);
+_PPCNodeVisitor_Init(pass,__pRT__,snd);
_PPCompiledParser_Init(pass,__pRT__,snd);
_stx_137goodies_137petitparser_137compiler_Init(pass,__pRT__,snd);
_PPCAbstractCharacterNode_Init(pass,__pRT__,snd);
_PPCAbstractLiteralNode_Init(pass,__pRT__,snd);
_PPCAbstractPredicateNode_Init(pass,__pRT__,snd);
_PPCAnyNode_Init(pass,__pRT__,snd);
+_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);
_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);
_PPCUnknownNode_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);
_PPCForwardNode_Init(pass,__pRT__,snd);
-_PPCInlineAnyNode_Init(pass,__pRT__,snd);
-_PPCInlineCharacterNode_Init(pass,__pRT__,snd);
-_PPCInlineNilNode_Init(pass,__pRT__,snd);
-_PPCInlinePluggableNode_Init(pass,__pRT__,snd);
_PPCLiteralNode_Init(pass,__pRT__,snd);
+_PPCMergingVisitor_Init(pass,__pRT__,snd);
_PPCMessagePredicateNode_Init(pass,__pRT__,snd);
_PPCNegateNode_Init(pass,__pRT__,snd);
_PPCNotCharSetPredicateNode_Init(pass,__pRT__,snd);
_PPCNotLiteralNode_Init(pass,__pRT__,snd);
_PPCNotMessagePredicateNode_Init(pass,__pRT__,snd);
_PPCNotNode_Init(pass,__pRT__,snd);
+_PPCOptimizingVisitor_Init(pass,__pRT__,snd);
_PPCOptionalNode_Init(pass,__pRT__,snd);
_PPCPlusNode_Init(pass,__pRT__,snd);
_PPCPredicateNode_Init(pass,__pRT__,snd);
_PPCSentinelNode_Init(pass,__pRT__,snd);
_PPCSequenceNode_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);
+_PPCTokenizingCodeGenerator_Init(pass,__pRT__,snd);
_PPCTrimNode_Init(pass,__pRT__,snd);
_PPCTrimmingTokenNode_Init(pass,__pRT__,snd);
_PPCActionNode_Init(pass,__pRT__,snd);
-_PPCInlineCharSetPredicateNode_Init(pass,__pRT__,snd);
-_PPCInlineLiteralNode_Init(pass,__pRT__,snd);
-_PPCInlineMessagePredicateNode_Init(pass,__pRT__,snd);
-_PPCInlineNotCharSetPredicateNode_Init(pass,__pRT__,snd);
-_PPCInlineNotLiteralNode_Init(pass,__pRT__,snd);
-_PPCInlineNotMessagePredicateNode_Init(pass,__pRT__,snd);
+_PPCLLChoiceNode_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);
-_PPCTokenActionNode_Init(pass,__pRT__,snd);
_PPCTokenStarMessagePredicateNode_Init(pass,__pRT__,snd);
-_PPCInlineTokenStarMessagePredicateNode_Init(pass,__pRT__,snd);
_PPCTokenStarSeparatorNode_Init(pass,__pRT__,snd);
-_PPCInlineTokenStarSeparatorNode_Init(pass,__pRT__,snd);
_stx_137goodies_137petitparser_137compiler_extensions_Init(pass,__pRT__,snd);
__END_PACKAGE__();
--- a/compiler/stx_goodies_petitparser_compiler.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/stx_goodies_petitparser_compiler.st Fri May 01 14:04:37 2015 +0200
@@ -58,6 +58,7 @@
^ #(
#'stx:goodies/petitparser' "PPActionParser - extended"
+ #'stx:goodies/petitparser/parsers/java' "PPJavaWhitespaceParser - extended"
#'stx:goodies/petitparser/parsers/smalltalk' "PPSmalltalkGrammar - extended"
#'stx:libbasic' "Character - extended"
)
@@ -74,9 +75,8 @@
by searching all classes (and their packages) which are referenced by my classes."
^ #(
- #'stx:libbasic2' "Stack - referenced by PPCCompiler>>initialize"
- #'stx:goodies/petitparser/analyzer'
- #'stx:goodies/petitparser/islands'
+ #'stx:goodies/petitparser/analyzer' "PPSentinel - referenced by PPCompiledParser class>>referringParser"
+ #'stx:libbasic2' "Stack - referenced by PPCCompiler>>initializeForCompiledClassName:"
)
!
@@ -108,72 +108,74 @@
^ #(
"<className> or (<className> attributes...) in load order"
+ PPCArguments
PPCBridge
PPCCompiledMethod
PPCCompiler
+ PPCConfiguration
PPCContext
PPCContextMemento
PPCGuard
PPCMethod
- PPCMethodStrategy
PPCNode
- PPCOptimizationResult
+ PPCNodeVisitor
PPCompiledParser
#'stx_goodies_petitparser_compiler'
PPCAbstractCharacterNode
PPCAbstractLiteralNode
PPCAbstractPredicateNode
PPCAnyNode
+ PPCCodeGenerator
PPCDelegateNode
+ PPCEndOfFileNode
+ PPCFirstPrototype
PPCInlinedMethod
+ PPCInliningVisitor
PPCListNode
PPCNilNode
+ PPCPluggableConfiguration
PPCPluggableNode
PPCProfilingContext
+ PPCRewritingVisitor
PPCUnknownNode
PPCAbstractActionNode
PPCAndNode
PPCCharSetPredicateNode
PPCCharacterNode
PPCChoiceNode
+ PPCCopyVisitor
PPCForwardNode
- PPCInlineAnyNode
- PPCInlineCharacterNode
- PPCInlineNilNode
- PPCInlinePluggableNode
PPCLiteralNode
+ PPCMergingVisitor
PPCMessagePredicateNode
PPCNegateNode
PPCNotCharSetPredicateNode
PPCNotLiteralNode
PPCNotMessagePredicateNode
PPCNotNode
+ PPCOptimizingVisitor
PPCOptionalNode
PPCPlusNode
PPCPredicateNode
PPCSentinelNode
PPCSequenceNode
PPCStarNode
+ PPCTokenConsumeNode
+ PPCTokenDetector
PPCTokenNode
+ PPCTokenVisitor
+ PPCTokenizingCodeGenerator
PPCTrimNode
PPCTrimmingTokenNode
PPCActionNode
- PPCInlineCharSetPredicateNode
- PPCInlineLiteralNode
- PPCInlineMessagePredicateNode
- PPCInlineNotCharSetPredicateNode
- PPCInlineNotLiteralNode
- PPCInlineNotMessagePredicateNode
+ PPCLLChoiceNode
PPCStarAnyNode
PPCStarCharSetPredicateNode
PPCStarMessagePredicateNode
PPCSymbolActionNode
PPCTokenSequenceNode
- PPCTokenActionNode
PPCTokenStarMessagePredicateNode
- PPCInlineTokenStarMessagePredicateNode
PPCTokenStarSeparatorNode
- PPCInlineTokenStarSeparatorNode
)
!
@@ -224,9 +226,6 @@
PPParser compile
PPParser compile:
PPParser compile:andParse:
- PPParser compile:parameters:
- PPParser compileWith:
- PPParser compileWithParameters:
PPParser firstSetSuchThat:
PPParser firstSetSuchThat:into:openSet:
PPParser id
@@ -250,11 +249,9 @@
PPSequenceParser compileWith:
PPSequenceParser firstSetSuchThat:into:openSet:
PPSmalltalkGrammar comment
- PPSmalltalkGrammar updateContext:
PPSmalltalkGrammar whitespace
PPSmalltalkTokenParser compileWith:
PPSmalltalkTokenParser parseOnX:
- PPSmalltalkTokenParser updateContext:
PPSmalltalkTokenParser whitespace
PPSmalltalkWhitespaceParser #'='
PPSmalltalkWhitespaceParser acceptsEpsilon
@@ -266,7 +263,6 @@
PPToken isToken
PPTokenParser asCompilerNode
PPTokenParser displayName
- PPTokenParser firstSets:into:
PPTokenParser isFirstSetTerminal
PPTokenParser isTokenParser
PPTokenParser optimize
@@ -274,13 +270,21 @@
PPTokenParser startsWith:
PPTokenParser whitespace
PPTrimmingParser asCompilerNode
- PPTrimmingParser compileWith:
- PPTrimmingParser firstSets:into:
UndefinedObject asInteger
UndefinedObject isAlphaNumeric
UndefinedObject isDigit
UndefinedObject isLetter
UndefinedObject isSeparator
+ PPCharSetPredicate #'='
+ PPCharSetPredicate hash
+ PPContext atWs
+ PPContext methodInvoked:
+ PPContext setWs
+ PPJavaWhitespaceParser #'='
+ PPJavaWhitespaceParser hash
+ PPParser compileAs:
+ PPParser compileWithConfiguration:
+ PPParser javaToken
)
! !
--- a/compiler/tests/Make.proto Fri May 01 13:44:43 2015 +0200
+++ b/compiler/tests/Make.proto Fri May 01 14:04:37 2015 +0200
@@ -34,7 +34,7 @@
# add the path(es) here:,
# ********** OPTIONAL: MODIFY the next lines ***
# LOCALINCLUDES=-Ifoo -Ibar
-LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/compiler -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/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/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
# if you need any additional defines for embedded C code,
@@ -109,6 +109,7 @@
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)"
@@ -128,15 +129,30 @@
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)PPCCodeGeneratorTest.$(O) PPCCodeGeneratorTest.$(H): PPCCodeGeneratorTest.st $(INCLUDE_TOP)/stx/goodies/petitparser/tests/PPAbstractParserTest.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCCompilerTest.$(O) PPCCompilerTest.$(H): PPCCompilerTest.st $(INCLUDE_TOP)/stx/goodies/petitparser/tests/PPAbstractParserTest.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCContextMementoTest.$(O) PPCContextMementoTest.$(H): PPCContextMementoTest.st $(INCLUDE_TOP)/stx/goodies/petitparser/tests/PPContextMementoTest.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCContextTest.$(O) PPCContextTest.$(H): PPCContextTest.st $(INCLUDE_TOP)/stx/goodies/petitparser/tests/PPContextTest.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCCopyVisitorTest.$(O) PPCCopyVisitorTest.$(H): PPCCopyVisitorTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCGuardTest.$(O) PPCGuardTest.$(H): PPCGuardTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)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)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)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)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)
# ENDMAKEDEPEND --- do not remove this line
--- a/compiler/tests/Make.spec Fri May 01 13:44:43 2015 +0200
+++ b/compiler/tests/Make.spec Fri May 01 14:04:37 2015 +0200
@@ -51,30 +51,60 @@
STCWARNINGS=-warnNonStandard
COMMON_CLASSES= \
+ PPCCodeGeneratorTest \
PPCCompilerTest \
PPCContextMementoTest \
PPCContextTest \
+ PPCCopyVisitorTest \
PPCGuardTest \
+ PPCInliningVisitorTest \
+ PPCMergingVisitorTest \
PPCMockCompiler \
PPCNodeFirstFollowNextTests \
PPCNodeTest \
PPCOptimizingTest \
+ PPCOptimizingVisitorTest \
+ PPCProtype1Test \
+ PPCTokenDetectorTest \
+ PPCTokenVisitorTest \
+ PPCTokenizingCodeGeneratorTest \
+ PPCVerificationTest \
+ PPCompiledExpressionGrammarResource \
+ PPCompiledExpressionGrammarTest \
+ PPCompiledJavaResource \
PPCompiledSmalltalkGrammarResource \
+ PPExpressionGrammar \
+ PPExpressionGrammarTest \
stx_goodies_petitparser_compiler_tests \
COMMON_OBJS= \
+ $(OUTDIR_SLASH)PPCCodeGeneratorTest.$(O) \
$(OUTDIR_SLASH)PPCCompilerTest.$(O) \
$(OUTDIR_SLASH)PPCContextMementoTest.$(O) \
$(OUTDIR_SLASH)PPCContextTest.$(O) \
+ $(OUTDIR_SLASH)PPCCopyVisitorTest.$(O) \
$(OUTDIR_SLASH)PPCGuardTest.$(O) \
+ $(OUTDIR_SLASH)PPCInliningVisitorTest.$(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)PPCTokenDetectorTest.$(O) \
+ $(OUTDIR_SLASH)PPCTokenVisitorTest.$(O) \
+ $(OUTDIR_SLASH)PPCTokenizingCodeGeneratorTest.$(O) \
+ $(OUTDIR_SLASH)PPCVerificationTest.$(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) \
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCCodeGeneratorTest.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,891 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPAbstractParserTest subclass:#PPCCodeGeneratorTest
+ instanceVariableNames:'visitor node result compiler parser context arguments'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Visitors'
+!
+
+!PPCCodeGeneratorTest methodsFor:'as yet unclassified'!
+
+context
+ ^ context := PPCProfilingContext new
+!
+
+setUp
+ arguments := PPCArguments default
+ profile: true;
+ yourself.
+
+ compiler := PPCCompiler new.
+ compiler arguments: arguments.
+
+ visitor := PPCCodeGenerator new.
+ visitor compiler: compiler.
+ visitor arguments: arguments.
+!
+
+tearDown
+ | class |
+
+ 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.
+
+! !
+
+!PPCCodeGeneratorTest methodsFor:'testing'!
+
+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: ''.
+!
+
+testAnyNode
+ node := PPCForwardNode new
+ child: PPCAnyNode new;
+ yourself.
+ self compileTree: node.
+
+ 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.
+
+ "Modified: / 23-04-2015 / 12:43:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testAnyNode2
+ node := PPCForwardNode new
+ child: (PPCAnyNode new markForInline; yourself);
+ yourself.
+
+ self compileTree: node.
+
+ 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.
+
+ "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'.
+!
+
+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.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: context invocationCount = 1.
+
+ 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'.
+!
+
+testCharacterNode2
+ node := (PPCCharacterNode new character: $#; yourself).
+ self compileTree: node.
+
+ self assert: parser parse: '#'
+!
+
+testCharacterNode3
+ node := PPCCharacterNode new character: Character lf; yourself.
+ self compileTree: node.
+
+ 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'.
+!
+
+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: '_'.
+!
+
+testChoiceNode2
+ | digitNode letterNode |
+ digitNode := PPCMessagePredicateNode new
+ message: #isDigit;
+ 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: '_'.
+!
+
+testForwardNode
+ | 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: ''.
+!
+
+testForwardNode2
+ | letterNode forwardNode |
+ letterNode := PPCMessagePredicateNode new
+ message: #isLetter;
+ markForInline;
+ yourself.
+
+ forwardNode := PPCForwardNode new
+ child: letterNode;
+ yourself.
+ node := PPCForwardNode new
+ child: forwardNode;
+ yourself.
+
+
+ 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: ''.
+!
+
+testForwardNode3
+ | 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 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.
+
+ 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: ''.
+!
+
+testInlinePluggableNode
+ "Sadly, on Smalltalk/X blocks cannot be inlined because
+ the VM does not provide enough information to map
+ it back to source code. Very bad indeed!!"
+ ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
+ self skipIf: true description: 'Blocks cannot be inlined due to a lack of proper VM support'.
+ ].
+
+ node := PPCSequenceNode new
+ children: {
+ PPCPluggableNode new block: [ :ctx | ctx next ]; markForInline; yourself.
+ $a asParser asCompilerNode }.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 2.
+ self assert: parser parse: 'ba' to: #($b $a).
+!
+
+testLiteralNode
+ 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'.
+!
+
+testLiteralNode2
+ 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'.
+!
+
+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: ''.
+!
+
+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: ''.
+!
+
+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.
+!
+
+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.
+!
+
+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.
+!
+
+testNotCharSetPredicateNode2
+ | 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.
+!
+
+testNotLiteralNode
+ | 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.
+!
+
+testNotLiteralNode2
+ | 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.
+!
+
+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.
+!
+
+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.
+!
+
+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.
+!
+
+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.
+!
+
+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.
+!
+
+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'.
+!
+
+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'.
+!
+
+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: ''.
+!
+
+testPredicateNode2
+ | 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: ''.
+!
+
+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'.
+!
+
+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: #().
+!
+
+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.
+
+!
+
+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.
+
+!
+
+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.
+!
+
+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: ''.
+!
+
+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'.
+!
+
+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'.
+!
+
+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.
+!
+
+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.
+
+!
+
+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.
+
+!
+
+testTrimNode
+ 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'.
+
+ self assert: parser parse: ' abc '.
+ self assert: result class = PPToken.
+ self assert: result inputValue = 'abc'.
+
+
+ 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.
+! !
+
--- a/compiler/tests/PPCCompilerTest.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/tests/PPCCompilerTest.st Fri May 01 14:04:37 2015 +0200
@@ -3,57 +3,32 @@
"{ NameSpace: Smalltalk }"
PPAbstractParserTest subclass:#PPCCompilerTest
- instanceVariableNames:'parser result context'
+ instanceVariableNames:'parser result context node compiler id node2 id2 id1 node1 node3
+ arguments configuration'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Tests-Core'
!
-!PPCCompilerTest methodsFor:'context'!
-
-context
- ^ context := PPCProfilingContext new
-! !
-
-!PPCCompilerTest methodsFor:'test support'!
+!PPCCompilerTest methodsFor:'as yet unclassified'!
assert: p parse: whatever
^ result := super assert: p parse: whatever.
!
-compile: aPPParser
- | compiler |
- compiler := PPCCompiler new.
- compiler profile: true.
- ^ (compiler compile: aPPParser as: #PPGeneratedParser) new.
-!
-
-compile: aPPParser params: params
- | compiler |
- compiler := PPCCompiler new.
- compiler profile: true.
- ^ (compiler compile: aPPParser as: #PPGeneratedParser params: params) new.
+context
+ ^ context := PPCProfilingContext new
!
-compileInlining: aPPParser
- | compiler |
- compiler := PPCCompiler new.
- compiler inlining: true.
- compiler profile: true.
- ^ (compiler compile: aPPParser as: #PPGeneratedParser) new.
-!
-
-compileTree: tree params: params
- | compiler mock |
- compiler := PPCCompiler new.
- compiler profile: true.
- mock := nil asParser.
- ^ (compiler compileTree: tree as: #PPGeneratedParser parser: mock params: params) new.
-!
-
-parse: whatever
- ^ result := super parse: whatever.
+setUp
+ arguments := PPCArguments default
+ profile: true;
+ yourself.
+
+ configuration := PPCFirstPrototype new
+ arguments: arguments;
+ yourself.
!
tearDown
@@ -65,462 +40,6 @@
].
! !
-!PPCCompilerTest methodsFor:'tests - compiling'!
-
-testCompileAnd
- parser := #digit asParser and compile.
-
- 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 compile.
-
- self assert: parser parse: 'aaa' to: { $a. $a . $a }.
- self assert: parser parse: '' to: { }.
-
-!
-
-testCompileBlock
- parser := (#letter asParser) plus ==> [ :res | res collect: [:each | each asUppercase ]].
- parser := parser compile.
-
- 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 compile.
-
- self assert: parser parse: 'a' to: $a.
- self assert: parser fail: 'b'.
-
- parser := $# asParser compile.
- self assert: parser parse: '#'.
-!
-
-testCompileChoice
- parser := (#digit asParser / #letter asParser) compile.
-
- self assert: parser parse: '1' to: $1.
- self assert: parser parse: 'a' to: $a.
- self assert: parser fail: '_'.
-
-!
-
-testCompileLiteral
- parser := 'foo' asParser compile.
-
- 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 )compile: #PPCompilerTest.
- self assert: parser parse: '''a' to: {'''' . $a}.
-!
-
-testCompileNegate
- parser := #letter asParser negate star, #letter asParser.
- parser := parser compile.
-
- self assert: parser parse: '...a' to: { { $. . $. . $. } . $a }.
- self assert: parser parse: 'aaa' to: { {} . $a } end: 1.
- self assert: parser fail: '...'.
-!
-
-testCompileNil
- parser := nil asParser compile.
-
- 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 compile.
-
- 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 compile: #PPCompilerTest.
- self assert: parser parse: 'foo' to: { 'foo'. nil } end: 3.
-
- parser := 'foo' asParser, $: asParser not, 'bar' asParser.
- parser := parser compile: #PPCompilerTest.
- self assert: parser parse: 'foobar' to: { 'foo'. nil . 'bar' } end: 6.
-!
-
-testCompileNot2
- parser := ($a asParser, $b asParser) not compile.
-
- 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) compile.
-
- self assert: parser parse: 'fee' to: #(nil 'fee').
- self assert: parser fail: 'foo'.
-!
-
-testCompileNotLiteral
- parser := 'foo' asParser not compile.
- self assert: parser class methodDictionary size = 2.
-
- 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 = 2.
-
- 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 compile.
-
- self assert: parser parse: '1' to: $1.
- self assert: parser parse: 'a' to: nil end: 0.
- self assert: parser class parsers isEmpty.
-
- parser := (#digit asParser optional, #letter asParser) compile.
- self assert: parser parse: '1a' to: { $1 . $a }.
- self assert: parser parse: 'a' to: { nil . $a }.
- self assert: parser class parsers isEmpty.
-!
-
-testCompilePlus
- parser := #letter asParser plus compile: #PPCompilerTest.
-
- 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 compile.
-
- self assert: parser parse: '1' to: $1.
- self assert: parser parse: '0' to: $0.
- self assert: parser fail: 'a'.
-!
-
-testCompilePredicate2
- parser := #space asParser compile.
-
- self assert: parser parse: ' ' to: Character space.
- self assert: parser fail: 'a'.
-!
-
-testCompileSequence
- parser := (#digit asParser, #letter asParser) compile.
-
- self assert: parser parse: '1a' to: {$1 .$a}.
-
-
-!
-
-testCompileSequence2
- parser := (#digit asParser, #space asParser, #letter asParser) compile: #PPCompilerTest.
-
- self assert: parser parse: '9 c' to: {$9 . Character space. $c }.
- self assert: parser fail: '9c'.
-
-!
-
-testCompileSequence3
- parser := (#any asParser, #any asParser, #any asParser) compile.
-
- self assert: parser parse: 'foo' to: #($f $o $o).
- self assert: parser fail: 'fo'.
-
-!
-
-testCompileStar
- parser := #letter asParser star compile.
-
- 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 compile.
-
- 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 compile.
-
- 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 compile.
-
- 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.
-!
-
-testCompileTrimmingToken
- | token1 token2 |
- token1 := (#letter asParser) plus trimmingToken.
- token2 := (#letter asParser) plus trimmingToken.
-
- parser := (token1, token2) compile.
-
- 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) compile.
-
- self assert: parser parse: 'foo bar'.
- self assert: parser parse: ' foo bar '.
-!
-
-testTrim
- parser := self compile: $a asParser trim.
-
- 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.
-! !
-
-!PPCCompilerTest methodsFor:'tests - extra'!
-
-testCompileSmalltalkToken
- parser := (#letter asParser, ((#letter asParser / #digit asParser) star)) smalltalkToken compile.
-
- 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 compile.
- self assert: parser parse: '{}' to: { ${. nil . $} }.
- self assert: parser parse: '{{}}' to: { ${. { ${ . nil . $} } . $} }.
-
-!
-
-testSmalltalkToken
- parser := (#letter asParser, (#digit asParser / #letter asParser) star) smalltalkToken compileWithParameters: {#profile -> true}.
-
- self assert: parser class methodDictionary size = 6.
- self assert: parser parse: 'foo'.
- self assert: result inputValue = 'foo'.
- self assert: context invocationCount = 9.
- self assert: context rememberCount = 0.
- self assert: context lwRememberCount = 1.
- self assert: context lwRestoreCount = 0.
-!
-
-testSmalltalkToken2
- |id|
- id := (#letter asParser, (#digit asParser / #letter asParser) star)
- name: 'identifier';
- yourself.
-
- parser := (id wrapped, $: asParser) smalltalkToken
- name: 'kw';
- yourself.
-
- parser := parser compileWithParameters: {#profile -> true}.
-
- self assert: parser parse: 'foo:'.
- self assert: result inputValue = 'foo:'.
-!
-
-testToken
- parser := (#letter asParser, (#digit asParser / #letter asParser) star) flatten compile.
-
- 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 compileWithParameters: {#profile -> true}.
-
- self assert: parser class methodDictionary size = 5.
- self assert: parser parse: 'foo'.
- self assert: result inputValue = 'foo'.
- self assert: context invocationCount = 7.
- 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 compileWithParameters: { #profile -> true }.
-
- self assert: parser class methodDictionary size = 5.
-
- self assert: parser parse: 'foo'.
- self assert: result inputValue = 'foo'.
-
- self assert: context invocationCount = 7.
- 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 = 2.
- 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 compileWithParameters: { #profile -> true }.
- self assert: parser class methodDictionary size = 6.
-
- 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 compileWithParameters: { #profile -> true }.
- self assert: parser class methodDictionary size = 6.
-
- 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 compileWithParameters: { #profile -> true }.
- self assert: parser class methodDictionary size = 9.
- 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'.
-! !
-
!PPCCompilerTest methodsFor:'tests - first set'!
testFirstSetSuchThat
@@ -569,7 +88,7 @@
testChoiceGuard
parser := ('foo' asParser trimmingToken / 'bar' asParser trimmingToken / $d asParser trimmingToken plus)
- compileWithParameters: {#profile -> true}.
+ compileWithConfiguration: configuration.
self assert: parser parse: 'foo'.
self assert: result inputValue = 'foo'.
@@ -594,7 +113,7 @@
testEmptyChoiceGuard
parser := ('foo' asParser trimmingToken / 'bar' asParser trimmingToken / $d asParser trimmingToken star)
- compileWithParameters: {#profile -> true}.
+ compileWithConfiguration: configuration.
self assert: parser parse: 'foo'.
self assert: result inputValue = 'foo'.
@@ -614,7 +133,8 @@
!
testGuardSmalltlakToken
- parser := (#letter asParser, #word asParser star) smalltalkToken compileWithParameters: { #profile -> true }.
+ parser := (#letter asParser, #word asParser star) smalltalkToken compileWithConfiguration: configuration.
+
self assert: parser parse: 'bar'.
self assert: (context invocations anySatisfy: [ :e | e beginsWith: 'seq' ]).
@@ -623,7 +143,7 @@
!
testSequenceGuard
- parser := ((#any asParser, #any asParser) wrapped, (#any asParser, #any asParser)) compile.
+ 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.
@@ -632,12 +152,81 @@
!
testTrimmerGuard
- parser := $a asParser trim, $b asParser compile: #PPGeneratedParser parameters: { #profile -> true }.
+ 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'.
+!
+
+testId2
+ node1 := PPCNode new
+ name: 'foo'.
+
+ node2 := PPCNode new
+ name: 'foo'.
+ compiler := PPCCompiler new.
+
+ id1 := compiler idFor: node1.
+ self assert: compiler ids size = 1.
+ self assert: id1 = 'foo'.
+
+ id2 := compiler idFor: node2.
+ self assert: compiler ids size = 2.
+ self assert: id2 = 'foo_1'.
+
+ self assert: (id1 = id2) not.
+!
+
+testId3
+ node1 := PPCNode new
+ name: 'foo'.
+
+ node2 := node1.
+ compiler := PPCCompiler new.
+
+ id1 := compiler idFor: node1.
+ self assert: compiler ids size = 1.
+ self assert: id1 = 'foo'.
+
+ id2 := compiler idFor: node2.
+ self assert: compiler ids size = 1.
+ self assert: id2 = 'foo'.
+
+ self assert: (id1 == id2).
+!
+
+testId4
+ node1 := PPCNode new
+ name: 'foo+='.
+
+ node2 := PPCNode new
+ name: 'foo+='.
+ compiler := PPCCompiler new.
+
+ id1 := compiler idFor: node1.
+ self assert: compiler ids size = 1.
+ self assert: id1 = 'foo'.
+
+ id2 := compiler idFor: node2.
+ self assert: compiler ids size = 2.
+ self assert: id2 = 'foo_1'.
+
+ self assert: (id1 = id2) not.
+! !
+
!PPCCompilerTest class methodsFor:'documentation'!
version_HG
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCCopyVisitorTest.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,75 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCCopyVisitorTest
+ instanceVariableNames:'node result visitor'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Visitors'
+!
+
+!PPCCopyVisitorTest methodsFor:'as yet unclassified'!
+
+assert: object equal: anotherObject
+ self assert: object = anotherObject
+!
+
+assert: object identical: anotherObject
+ self assert: (object == anotherObject)
+!
+
+assert: object notIdentical: anotherObject
+ self assert: (object == anotherObject) not
+!
+
+setUp
+ visitor := PPCCopyVisitor new
+!
+
+testCopy1
+ 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.
+
+ 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.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCInliningVisitorTest.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,174 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCInliningVisitorTest
+ instanceVariableNames:'node result visitor'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Visitors'
+!
+
+!PPCInliningVisitorTest methodsFor:'as yet unclassified'!
+
+assert: object type: class
+ self assert: object class == class
+!
+
+setUp
+ 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.
+!
+
+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.
+!
+
+testLiteralNode
+ | 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'.
+!
+
+testNil
+ node := PPCNilNode new.
+ result := visitor visit: node.
+
+ self assert: result type: PPCNilNode.
+ self assert: result isMarkedForInline not.
+!
+
+testNil2
+ 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.
+!
+
+testNotLiteralNode
+ | notLiteralNode |
+
+ notLiteralNode := PPCNotLiteralNode new
+ literal: 'foo';
+ 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'.
+!
+
+testPluggable
+ | 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!!'.
+ ].
+
+ 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.
+
+ 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.
+!
+
+testTokenStarSeparatorNode
+ | tokenNode |
+ tokenNode := (PPCTokenStarSeparatorNode new)
+ name: #name;
+ message: #message;
+ child: PPCNilNode new;
+ 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.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCMergingVisitorTest.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,75 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCMergingVisitorTest
+ instanceVariableNames:'node result visitor node1 node2'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Visitors'
+!
+
+
+!PPCMergingVisitorTest methodsFor:'as yet unclassified'!
+
+javaWsNode
+ ^ PPCUnknownNode new
+ parser: PPJavaWhitespaceParser new;
+ yourself
+!
+
+nilNode
+ ^ PPCNilNode new
+!
+
+setUp
+ 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).
+!
+
+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).
+!
+
+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.
+! !
+
+!PPCMergingVisitorTest class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/compiler/tests/PPCMockCompiler.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/tests/PPCMockCompiler.st Fri May 01 14:04:37 2015 +0200
@@ -38,7 +38,9 @@
addConstant: object as: id
"TODO"
-!
+! !
+
+!PPCMockCompiler methodsFor:'initialization'!
initialize
super initialize.
--- a/compiler/tests/PPCNodeCompilingTest.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/tests/PPCNodeCompilingTest.st Fri May 01 14:04:37 2015 +0200
@@ -23,343 +23,32 @@
!
compileTree: root
- ^ self compileTree: root params: #()
-!
-
-compileTree: root params: params
- | compiler mock |
- compiler := PPCCompiler new.
- compiler profile: true.
- mock := nil asParser.
- ^ (compiler compileTree: root as: #PPGeneratedParser parser: mock params: params) new.
-! !
-
-!PPCNodeCompilingTest methodsFor:'tests - compiling'!
-
-testCompileAction
- tree := PPCActionNode new
- block: [ :res | res collect: [:each | each asUppercase ]];
- child: #letter asParser plus asCompilerTree;
- yourself.
- parser := self compileTree: tree.
-
- self assert: parser parse: 'foo' to: { $F . $O . $O}.
- self assert: parser parse: 'bar' to: { $B . $A . $R}.
- self assert: parser fail: ''.
-!
-
-testCompileAnd
- tree := PPCAndNode new
- child: #digit asParser asCompilerNode;
- yourself.
- parser := self compileTree: tree.
-
- self assert: parser parse: '1' to: $1 end: 0.
- self assert: parser fail: 'a'.
- self assert: parser fail: ''.
-!
-
-testCompileAny
- tree := PPCAnyNode new.
- parser := self compileTree: tree.
-
- self assert: parser parse: 'a' to: $a.
- self assert: parser parse: '_' to: $_.
- self assert: parser parse: '
-' to: Character cr.
-!
-
-testCompileCharSetPredicate
- tree := PPCCharSetPredicateNode new
- predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
- yourself.
- parser := self compileTree: tree.
-
- self assert: parser parse: 'a' to: $a.
- self assert: parser fail: 'b'.
-!
-
-testCompileCharacter
- tree := PPCCharacterNode new character: $a; yourself.
- parser := self compileTree: tree.
-
- self assert: parser parse: 'a' to: $a.
- self assert: parser fail: 'b'.
-
- parser := self compileTree: (PPCCharacterNode new character: $#; yourself).
- self assert: parser parse: '#'.
-
- parser := self compileTree: (PPCCharacterNode new character: Character lf; yourself).
- self assert: parser parse: String lf.
-!
-
-testCompileChoice
- tree := PPCChoiceNode new
- children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode };
- yourself.
-
- parser := self compileTree: tree.
-
- self assert: parser class methodDictionary size = 4.
-
- self assert: parser parse: '1' to: $1.
- self assert: parser parse: 'a' to: $a.
- self assert: parser fail: '_'.
-!
-
-testCompileLiteral
- tree := PPCLiteralNode new
- literal: 'foo';
- yourself.
- parser := self compileTree: tree.
-
- self assert: parser class methodDictionary size = 2.
- self assert: parser parse: 'foo' to: 'foo'.
- self assert: parser parse: 'foobar' to: 'foo' end: 3.
- self assert: parser fail: 'boo'.
-!
-
-testCompileLiteral2
- | |
-
- tree := PPCLiteralNode new
- literal: '''''';
- yourself.
- parser := self compileTree: tree.
-
- self assert: parser parse: '''''' to: ''''''.
-!
-
-testCompileNil
- tree := PPCNilNode new.
-
- parser := self compileTree: tree.
-
- self assert: parser parse: 'a' to: nil end: 0.
- self assert: parser parse: '' to: nil end: 0.
-!
-
-testCompileNot
- tree := PPCNotNode new
- child: #digit asParser asCompilerNode;
- yourself.
- parser := self compileTree: tree.
-
- self assert: parser parse: 'a' to: nil end: 0.
- self assert: parser fail: '1'.
- self assert: parser parse: '' to: nil end: 0.
-!
-
-testCompileNotCharSetPredicate
- tree := PPCNotCharSetPredicateNode new
- predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
- yourself.
- parser := self compileTree: tree.
-
- 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.
-!
-
-testCompileNotLiteral
- tree := PPCNotLiteralNode new
- literal: 'foo';
- yourself.
- parser := self compileTree: tree.
-
- 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.
-!
-
-testCompileNotMessagePredicate
- tree := PPCNotMessagePredicateNode new
- message: #isDigit;
- yourself.
- parser := self compileTree: tree.
-
- 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.
+ ^ self compileTree: root arguments: PPCArguments default
!
-testCompileOptional
- tree := PPCOptionalNode new
- child: ($a asParser asCompilerNode);
- yourself.
- parser := self compileTree: tree.
-
- self assert: parser parse: 'b' to: nil end: 0.
- self assert: parser parse: 'a' to: $a.
- self assert: parser parse: '' to: nil end: 0.
-!
-
-testCompilePluggable
- tree := PPCPluggableNode new
- block: [:ctx | ctx next ];
- yourself.
- parser := self compileTree: tree.
-
- self assert: parser parse: 'foo' to: $f end: 1.
- self assert: parser parse: 'bar' to: $b end: 1.
- self assert: parser parse: '' to: nil.
-!
-
-testCompilePlus
- tree := PPCPlusNode new
- child: ($a asParser asCompilerNode);
- yourself.
- parser := self compileTree: tree.
-
- 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'.
-!
-
-testCompileSequence
- tree := PPCSequenceNode new
- children: { $a asParser asCompilerNode . $b asParser asCompilerNode . $c asParser asCompilerNode }
- yourself.
- parser := self compileTree: tree.
+compileTree: root arguments: arguments
+ | configuration |
+ arguments profile: true.
- 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'.
-!
-
-testCompileStar
- tree := PPCStarNode new
- child: ($a asParser asCompilerNode);
- yourself.
- parser := self compileTree: tree.
-
- 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.
-!
+ configuration := PPCPluggableConfiguration on: [ :_self |
+ _self specialize.
+ _self specialize.
+ _self tokenize.
+ _self inline.
+ _self merge.
+ _self generate.
+ ].
-testCompileStarAny
- tree := PPCStarAnyNode new child: PPCNilNode new; yourself.
- parser := self compileTree: tree.
-
- self assert: parser parse: 'abc' to: #($a $b $c).
- self assert: parser parse: 'a' to: #($a).
- self assert: parser parse: '' to: #().
-!
-
-testCompileStarCharSetPredicate
- tree := PPCStarCharSetPredicateNode new
- predicate: (PPCharSetPredicate on: [:e | e = $a ]);
- "I have to put something here"
- child: PPCNilNode new;
- yourself.
- parser := self compileTree: tree.
-
- self assert: parser class methodDictionary size = 2.
- self assert: parser parse: 'aaa1' to: #( $a $a $a) end: 3.
- self assert: context invocationCount = 2.
- self assert: parser parse: 'bba' to: #() end: 0.
- self assert: context invocationCount = 2.
-
+ ^ configuration compile: root arguments: arguments.
!
-testCompileStarMessagePredicate
- tree := PPCStarMessagePredicateNode new
- message: #isLetter;
- "I have to add something here"
- child: PPCNilNode new;
- yourself.
- parser := self compileTree: tree.
-
- self assert: parser class methodDictionary size = 2.
- self assert: parser parse: 'abc1' to: #( $a $b $c) end: 3.
- self assert: context invocationCount = 2.
-
- self assert: parser parse: '123a' to: #() end: 0.
- self assert: context invocationCount = 2.
-
-!
-
-testCompileSymbolAction
- tree := PPCSymbolActionNode new
- block: #second;
- child: #letter asParser plus asCompilerTree;
- yourself.
- parser := self compileTree: tree.
-
- self assert: parser parse: 'foo' to: $o.
- self assert: parser parse: 'bar' to: $a.
- self assert: parser fail: ''.
-!
-
-testCompileToken
- tree := PPCTokenNode new
- child: #letter asParser plus asCompilerTree;
- tokenClass: PPToken;
- yourself.
-
- parser := self compileTree: tree.
-
- self assert: parser parse: 'abc'.
- self assert: result class = PPToken.
- self assert: result inputValue = 'abc'.
-
- self assert: parser fail: '1a'.
-!
+tearDown
+ | class |
-testCompileTokenSequence
- tree := PPCTokenSequenceNode new.
- tree children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode }.
-
- parser := self compileTree: tree.
-
- self assert: parser parse: '1a' to: parser.
- self assert: context rememberCount = 0.
- self assert: context lwRememberCount = 1.
- self assert: context restoreCount = 0.
- self assert: context lwRestoreCount = 0.
-
- self assert: parser parse: '1ab' to: parser end: 2.
- self assert: context lwRememberCount = 1.
- self assert: context lwRestoreCount = 0.
-
- self assert: parser fail: 'a1'.
- self assert: context lwRememberCount = 1.
- self assert: context lwRestoreCount = 0.
-
- self assert: parser fail: 'aa'.
- self assert: context lwRememberCount = 1.
- self assert: context lwRestoreCount = 0.
-
- self assert: parser fail: '11'.
- self assert: context lwRememberCount = 1.
- self assert: context lwRestoreCount = 1.
-
-!
-
-testCompileTokenStarMessagePredicate
-
- tree := PPCTokenStarMessagePredicateNode new message: #isLetter; child: PPCNilNode new; yourself.
- parser := self compileTree: tree params: {#guards -> false}.
-
- self assert: parser class methodDictionary size = 2.
-
- self assert: parser parse: 'foo' to: parser.
- self assert: context invocationCount = 2.
- self assert: context lwRememberCount = 0.
- self assert: context lwRestoreCount = 0.
- self assert: context rememberCount = 0.
-
- self assert: parser parse: 'foo123' to: parser end: 3.
+ class := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]).
+ class notNil ifTrue:[
+ class removeFromSystem
+ ].
! !
!PPCNodeCompilingTest methodsFor:'tests - guard'!
@@ -411,89 +100,6 @@
self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]).
! !
-!PPCNodeCompilingTest methodsFor:'tests - inlining'!
-
-testInlineAny
- tree := PPCSequenceNode new
- children: { PPCInlineAnyNode new. $a asParser asCompilerNode }.
-
- parser := self compileTree: tree.
-
- self assert: parser class methodDictionary size = 3.
- self assert: parser parse: '.a' to: #($. $a).
-!
-
-testInlineCharSetPredicate
- tree := PPCPlusNode new
- child: (PPCInlineCharSetPredicateNode new
- predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
- yourself);
- yourself.
-
- parser := self compileTree: tree.
-
- self assert: parser class methodDictionary size = 2.
- self assert: parser parse: 'a' to: #($a).
- self assert: parser fail: 'b'.
-!
-
-testInlineCharacter
- tree := PPCSequenceNode new
- children: { PPCInlineCharacterNode new character: $b . $a asParser asCompilerNode }.
-
- parser := self compileTree: tree.
-
- self assert: parser class methodDictionary size = 3.
- self assert: parser parse: 'ba' to: #($b $a).
-!
-
-testInlineLiteral
- tree := PPCSequenceNode new
- children: { PPCInlineLiteralNode new literal: 'foo'. $a asParser asCompilerNode }.
-
- parser := self compileTree: tree.
-
- self assert: parser class methodDictionary size = 3.
- self assert: parser parse: 'fooa' to: #('foo' $a).
-!
-
-testInlineNil
- tree := PPCSequenceNode new
- children: { PPCInlineNilNode new . $a asParser asCompilerNode }.
-
- parser := self compileTree: tree.
-
- self assert: parser class methodDictionary size = 3.
- self assert: parser parse: 'a' to: #(nil $a).
-!
-
-testInlineNotLiteral
- tree := PPCSequenceNode new
- children: { PPCInlineNotLiteralNode new literal: 'foo'. $a asParser asCompilerNode }.
-
- parser := self compileTree: tree.
-
- self assert: parser class methodDictionary size = 3.
- self assert: parser parse: 'a' to: #(nil $a).
-!
-
-testInlinePluggable
- "Sadly, on Smalltalk/X blocks cannot be inlined because
- the VM does not provide enough information to map
- it back to source code. Very bad indeed!!"
- ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
- self skipIf: true description: 'Blocks cannot be inlined due to a lack of proper VM support'.
- ].
-
- tree := PPCSequenceNode new
- children: { PPCInlinePluggableNode new block: [ :ctx | ctx next ]. $a asParser asCompilerNode }.
-
- parser := self compileTree: tree.
-
- self assert: parser class methodDictionary size = 3.
- self assert: parser parse: 'ba' to: #($b $a).
-! !
-
!PPCNodeCompilingTest class methodsFor:'documentation'!
version_HG
--- a/compiler/tests/PPCNodeTest.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/tests/PPCNodeTest.st Fri May 01 14:04:37 2015 +0200
@@ -3,7 +3,7 @@
"{ NameSpace: Smalltalk }"
TestCase subclass:#PPCNodeTest
- instanceVariableNames:''
+ instanceVariableNames:'node'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Tests-Nodes'
@@ -13,27 +13,54 @@
!PPCNodeTest methodsFor:'as yet unclassified'!
testCopy
- | n1 n2 |
- n1 := PPCDelegateNode new
+ | newNode |
+ node := PPCDelegateNode new
child: #foo;
yourself.
- n2 := n1 copy.
- self assert: (n1 = n2).
+ newNode := node copy.
+ self assert: (node = newNode).
+ self assert: (node hash = newNode hash).
- n2 child: #bar.
- self assert: (n1 = n2) not.
+ newNode child: #bar.
+ self assert: (node = newNode) not.
!
testCopy2
- | n1 n2 |
- n1 := PPCSequenceNode new
- children: (Array with: #foo with: #bar);
+ | newNode |
+ node := PPCSequenceNode new
+ children: { #foo . #bar }
yourself.
- n2 := n1 copy.
- self assert: (n1 = n2).
+ newNode := node copy.
+
+ self assert: (node = newNode).
+ self assert: (node hash = newNode hash).
- n2 children at: 1 put: #zorg.
- self assert: (n1 = n2) not.
+ 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.
+!
+
+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.
!
testEquals
@@ -54,6 +81,26 @@
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.
! !
!PPCNodeTest methodsFor:'test support'!
@@ -131,22 +178,32 @@
tree := parser asCompilerTree optimizeTree.
self assert: tree type: PPCTrimmingTokenNode.
- self assert: tree child type: PPCInlineLiteralNode.
+ 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: PPCInlineTokenStarSeparatorNode.
+ 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: PPCInlineCharacterNode.
+ self assert: tree child child type: PPCCharacterNode.
+ self assert: tree child child isMarkedForInline.
! !
!PPCNodeTest methodsFor:'tests - epsilon'!
--- a/compiler/tests/PPCOptimizingTest.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/tests/PPCOptimizingTest.st Fri May 01 14:04:37 2015 +0200
@@ -13,11 +13,11 @@
!PPCOptimizingTest methodsFor:'test support'!
assert: object type: class
- self assert: object class == class
+ self assert: (object isKindOf: class)
!
optimize: p
- ^ self optimize: p parameters: #()
+ ^ p asCompilerTree optimizeTree
!
optimize: p parameters: parameters
@@ -45,8 +45,11 @@
tree := self optimize: $a asParser / $b asParser.
self assert: tree type: PPCChoiceNode.
- self assert: tree children first type: PPCInlineCharacterNode.
- self assert: tree children second type: PPCInlineCharacterNode.
+ 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
@@ -56,7 +59,7 @@
p1 name: 'p1'.
tree := self optimize: p1.
- self assert: tree type: PPCCharacterNode.
+ self assert: tree type: PPCAbstractCharacterNode.
self assert: tree name = 'p1'.
p2 name: 'p2'.
@@ -71,7 +74,8 @@
tree := self optimize: $a asParser plus.
self assert: tree type: PPCPlusNode.
- self assert: tree child type: PPCInlineCharacterNode.
+ self assert: tree child type: PPCCharacterNode.
+ self assert: tree child isMarkedForInline.
self assert: tree child character = $a.
!
@@ -80,7 +84,8 @@
tree := self optimize: $a asParser star.
self assert: tree type: PPCStarNode.
- self assert: tree child type: PPCInlineCharacterNode.
+ self assert: tree child type: PPCCharacterNode.
+ self assert: tree child isMarkedForInline.
self assert: tree child character = $a.
!
@@ -89,9 +94,11 @@
tree := self optimize: $a asParser, $b asParser.
self assert: tree type: PPCSequenceNode.
- self assert: tree children first type: PPCInlineCharacterNode.
+ 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: PPCInlineCharacterNode.
+ self assert: tree children second type: PPCCharacterNode.
+ self assert: tree children second isMarkedForInline.
self assert: tree children second character = $b.
!
@@ -100,7 +107,8 @@
tree := self optimize: nil asParser star.
self assert: tree type: PPCStarNode.
- self assert: tree child type: PPCInlineNilNode.
+ self assert: tree child type: PPCNilNode.
+ self assert: tree child isMarkedForInline.
!
testInlineNotLiteral
@@ -108,8 +116,9 @@
tree := self optimize: 'foo' asParser not star.
self assert: tree type: PPCStarNode.
- self assert: tree child type: PPCInlineNotLiteralNode.
+ self assert: tree child type: PPCNotLiteralNode.
self assert: tree child literal = 'foo'.
+ self assert: tree child isMarkedForInline.
!
testInlineNotPredicate
@@ -117,16 +126,25 @@
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: PPCInlineNotMessagePredicateNode.
- self assert: tree children second type: PPCInlineNotCharSetPredicateNode.
+ 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: PPCInlinePluggableNode.
+ 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
@@ -134,8 +152,11 @@
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: PPCInlineMessagePredicateNode.
- self assert: tree children second type: PPCInlineCharSetPredicateNode.
+ 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
@@ -207,7 +228,7 @@
testStarSeparator
| tree |
- tree := self optimize: #space asParser star trimmingToken parameters: { #inline -> false }.
+ tree := self optimize: #space asParser star trimmingToken parameters: { #rewrite . #token }.
self assert: tree type: PPCTrimmingTokenNode.
self assert: tree child type: PPCTokenStarSeparatorNode.
@@ -219,7 +240,8 @@
self assert: tree type: PPCTrimmingTokenNode.
self assert: tree child type: PPCTokenSequenceNode.
- self assert: tree child children first type: PPCInlineTokenStarSeparatorNode.
+ self assert: tree child children first type: PPCTokenStarSeparatorNode.
+ self assert: tree child children first isMarkedForInline.
!
testSymbolAction
@@ -239,11 +261,14 @@
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: PPCInlineMessagePredicateNode.
- self assert: tree child children second type: PPCInlineTokenStarMessagePredicateNode.
+ 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.
+
!
-testTokenSequence
+testTokenSequence2
| tree |
tree := self optimize: ($a asParser, $b asParser) token.
@@ -261,11 +286,15 @@
tree := self optimize: ((#letter asParser, #word asParser star) trimmingToken).
self assert: tree type: PPCTrimmingTokenNode.
- self assert: tree whitespace type: PPCInlineTokenStarSeparatorNode.
+ 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: PPCInlineMessagePredicateNode.
- self assert: tree child children second type: PPCInlineTokenStarMessagePredicateNode.
+ 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
@@ -274,7 +303,8 @@
tree := parser asCompilerTree optimizeTree.
self assert: tree type: PPCTrimmingTokenNode.
- self assert: tree child type: PPCInlineLiteralNode.
+ 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.
@@ -282,14 +312,16 @@
self assert: tree type: PPCTrimmingTokenNode.
self assert: tree child type: PPCTokenSequenceNode.
- self assert: tree whitespace type: PPCInlineTokenStarSeparatorNode.
+ 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: PPCInlineCharacterNode.
+ self assert: tree child child type: PPCCharacterNode.
+ self assert: tree child child isMarkedForInline.
!
testTrimmingToken3
@@ -310,7 +342,8 @@
self assert: tree type: PPCTrimmingTokenNode.
self assert: tree children second type: PPCTokenSequenceNode.
- self assert: tree children second children first type: PPCInlineNotLiteralNode.
+ self assert: tree children second children first type: PPCNotLiteralNode.
+ self assert: tree children second children first isMarkedForInline.
! !
!PPCOptimizingTest class methodsFor:'documentation'!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCOptimizingVisitorTest.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,155 @@
+"{ 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/PPCProtype1Test.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,532 @@
+"{ 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/PPCTokenDetectorTest.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,239 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCTokenDetectorTest
+ instanceVariableNames:'node result visitor'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Visitors'
+!
+
+!PPCTokenDetectorTest methodsFor:'as yet unclassified'!
+
+assert: object type: class
+ self assert: object class == class
+!
+
+setUp
+ 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.
+
+ 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 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.
+!
+
+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.
+!
+
+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.
+
+
+!
+
+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.
+!
+
+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).
+
+!
+
+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.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCTokenVisitorTest.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,194 @@
+"{ 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.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCTokenizingCodeGeneratorTest.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,143 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPAbstractParserTest subclass:#PPCTokenizingCodeGeneratorTest
+ instanceVariableNames:'visitor node result compiler parser context choiceNode tokenizer
+ arguments'
+ 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
+!
+
+compileTokenizer: aNode
+
+ tokenizer := visitor visit: aNode
+!
+
+compileTree: root
+
+ | 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.
+
+!
+
+context
+ ^ context := PPCProfilingContext new
+!
+
+literalNode: literal
+ ^ PPCLiteralNode new
+ literal: literal;
+ yourself
+!
+
+setUp
+ arguments := PPCArguments default
+ profile: true;
+ yourself.
+
+ compiler := PPCCompiler new.
+ compiler arguments: arguments.
+
+ visitor := PPCTokenizingCodeGenerator new.
+ visitor compiler: compiler.
+!
+
+tearDown
+ | class |
+
+ class := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]).
+ class notNil ifTrue:[
+ class removeFromSystem
+ ].
+!
+
+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.
+
+ 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'.
+
+ parser := compiler compiledParser new.
+ self assert: parser parse: 'bar'.
+ self assert: result inputValue = 'bar'.
+
+ parser := compiler compiledParser new.
+ self assert: parser fail: 'baz'.
+!
+
+tokenNode: child
+ ^ PPCTokenNode new
+ child: child;
+ tokenClass: PPToken;
+ yourself
+!
+
+tokenNodeForEOF
+ | eof |
+ eof := PPCEndOfFileNode new
+ yourself.
+
+ ^ PPCTokenNode new
+ child: eof;
+ tokenClass: PPToken;
+ yourself.
+!
+
+tokenNodeForLiteral: literal
+ | literalNode |
+ literalNode := self literalNode: literal.
+ ^ self tokenNode: literalNode
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCVerificationTest.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,113 @@
+"{ 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).
+ ].
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCompiledExpressionGrammarResource.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,22 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestResource subclass:#PPCompiledExpressionGrammarResource
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-ExpressionGrammar'
+!
+
+!PPCompiledExpressionGrammarResource methodsFor:'as yet unclassified'!
+
+setUp
+ | time |
+ time := Time millisecondsToRun: [
+ PPExpressionGrammar new compileAs: #PPCompiledExpressionGrammar
+ ].
+ Transcript crShow: 'Exprssion grammar compiled in: ', time asString, 'ms'.
+
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCompiledExpressionGrammarTest.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,54 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCompositeParserTest subclass:#PPCompiledExpressionGrammarTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-ExpressionGrammar'
+!
+
+!PPCompiledExpressionGrammarTest class methodsFor:'as yet unclassified'!
+
+resources
+ ^ (OrderedCollection with: PPCompiledExpressionGrammarResource)
+ addAll: super resources;
+ yourself
+! !
+
+!PPCompiledExpressionGrammarTest methodsFor:'as yet unclassified'!
+
+compilerArguments
+ ^ PPCArguments default
+ profile: true;
+ ll: true;
+ yourself
+!
+
+context
+ ^ PPCContext new
+!
+
+parserClass
+ ^ Smalltalk at: #PPCompiledExpressionGrammar
+!
+
+parserInstanceFor: aSymbol
+ ^ (Smalltalk at: #PPCompiledExpressionGrammar) new startSymbol: aSymbol
+!
+
+testNumber
+ result := self parse: '1' rule: #number.
+ 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.
+
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCompiledJavaResource.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,21 @@
+"{ 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'.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCompiledJavaSyntaxTest.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,573 @@
+"{ 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 Fri May 01 13:44:43 2015 +0200
+++ b/compiler/tests/PPCompiledSmalltalkGrammarResource.st Fri May 01 14:04:37 2015 +0200
@@ -12,12 +12,11 @@
!PPCompiledSmalltalkGrammarResource methodsFor:'as yet unclassified'!
setUp
- | time |
- time := Time millisecondsToRun: [
- PPSmalltalkGrammar new compile: #PPCompiledSmalltalkGrammar
- ].
- Transcript show: 'Grammar compiled in: ', time asString, 'ms'; cr.
-
- "Modified: / 21-11-2014 / 12:33:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ | time |
+ time := Time millisecondsToRun: [
+ PPSmalltalkGrammar new compileAs: #PPCompiledSmalltalkGrammar
+ ].
+ Transcript crShow: 'Smalltalk Grammar compiled in: ', time asString, 'ms'.
+
! !
--- a/compiler/tests/PPCompiledSmalltalkGrammarTests.st Fri May 01 13:44:43 2015 +0200
+++ b/compiler/tests/PPCompiledSmalltalkGrammarTests.st Fri May 01 14:04:37 2015 +0200
@@ -730,6 +730,18 @@
rule: #expression
!
+testIdentifierToken
+ self
+ parse: 'foo'
+ rule: #identifierToken
+!
+
+testIdentifierToken2
+ self
+ parse: ' foo'
+ rule: #identifierToken
+!
+
testKeywordExpression1
self
parse: '1 to: 2'
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPExpressionGrammar.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,45 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCompositeParser subclass:#PPExpressionGrammar
+ instanceVariableNames:'add prod term mul prim parens number'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-ExpressionGrammar'
+!
+
+!PPExpressionGrammar methodsFor:'as yet unclassified'!
+
+add
+ ^ prod , $+ asParser trimmingToken , term
+!
+
+mul
+ ^ prim , $* asParser trimmingToken , prod
+!
+
+number
+ ^ #digit asParser plus trimmingToken ==> [ :token | token inputValue asNumber ]
+!
+
+parens
+ ^ $( asParser trim, term , $) asParser trim
+!
+
+prim
+ ^ parens / number
+!
+
+prod
+ ^ mul / prim
+!
+
+start
+ ^ term end
+!
+
+term
+ ^ add / prod
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPExpressionGrammarTest.st Fri May 01 14:04:37 2015 +0200
@@ -0,0 +1,47 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPCompositeParserTest subclass:#PPExpressionGrammarTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-ExpressionGrammar'
+!
+
+!PPExpressionGrammarTest methodsFor:'as yet unclassified'!
+
+parserClass
+ ^ PPExpressionGrammar
+!
+
+testNumber
+ result := self parse: '1' rule: #number.
+ 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.
+
+!
+
+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.
+!
+
+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.
+! !
+
--- a/compiler/tests/abbrev.stc Fri May 01 13:44:43 2015 +0200
+++ b/compiler/tests/abbrev.stc Fri May 01 14:04:37 2015 +0200
@@ -1,15 +1,31 @@
# 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.
+PPCCodeGeneratorTest PPCCodeGeneratorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
PPCCompilerTest PPCCompilerTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 1
PPCContextMementoTest PPCContextMementoTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Context' 1
PPCContextTest PPCContextTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Context' 1
+PPCCopyVisitorTest PPCCopyVisitorTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Visitors' 1
PPCGuardTest PPCGuardTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 1
+PPCInliningVisitorTest PPCInliningVisitorTest 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
+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
+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 Fri May 01 13:44:43 2015 +0200
+++ b/compiler/tests/bc.mak Fri May 01 14:04:37 2015 +0200
@@ -35,7 +35,7 @@
-LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\compiler -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\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\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
LOCALDEFINES=
STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
@@ -59,6 +59,7 @@
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) "
@@ -75,15 +76,30 @@
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)PPCCodeGeneratorTest.$(O) PPCCodeGeneratorTest.$(H): PPCCodeGeneratorTest.st $(INCLUDE_TOP)\stx\goodies\petitparser\tests\PPAbstractParserTest.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCCompilerTest.$(O) PPCCompilerTest.$(H): PPCCompilerTest.st $(INCLUDE_TOP)\stx\goodies\petitparser\tests\PPAbstractParserTest.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCContextMementoTest.$(O) PPCContextMementoTest.$(H): PPCContextMementoTest.st $(INCLUDE_TOP)\stx\goodies\petitparser\tests\PPContextMementoTest.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCContextTest.$(O) PPCContextTest.$(H): PPCContextTest.st $(INCLUDE_TOP)\stx\goodies\petitparser\tests\PPContextTest.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCCopyVisitorTest.$(O) PPCCopyVisitorTest.$(H): PPCCopyVisitorTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCGuardTest.$(O) PPCGuardTest.$(H): PPCGuardTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)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)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)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)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)
# ENDMAKEDEPEND --- do not remove this line
--- a/compiler/tests/libInit.cc Fri May 01 13:44:43 2015 +0200
+++ b/compiler/tests/libInit.cc Fri May 01 14:04:37 2015 +0200
@@ -27,15 +27,30 @@
void _libstx_goodies_petitparser_compiler_tests_Init(pass, __pRT__, snd)
OBJ snd; struct __vmData__ *__pRT__; {
__BEGIN_PACKAGE2__("libstx_goodies_petitparser_compiler_tests", _libstx_goodies_petitparser_compiler_tests_Init, "stx:goodies/petitparser/compiler/tests");
+_PPCCodeGeneratorTest_Init(pass,__pRT__,snd);
_PPCCompilerTest_Init(pass,__pRT__,snd);
_PPCContextMementoTest_Init(pass,__pRT__,snd);
_PPCContextTest_Init(pass,__pRT__,snd);
+_PPCCopyVisitorTest_Init(pass,__pRT__,snd);
_PPCGuardTest_Init(pass,__pRT__,snd);
+_PPCInliningVisitorTest_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);
+_PPCTokenDetectorTest_Init(pass,__pRT__,snd);
+_PPCTokenVisitorTest_Init(pass,__pRT__,snd);
+_PPCTokenizingCodeGeneratorTest_Init(pass,__pRT__,snd);
+_PPCVerificationTest_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 Fri May 01 13:44:43 2015 +0200
+++ b/compiler/tests/stx_goodies_petitparser_compiler_tests.st Fri May 01 14:04:37 2015 +0200
@@ -57,8 +57,10 @@
by searching along the inheritance chain of all of my classes."
^ #(
- #'stx:goodies/petitparser/tests' "PPAbstractParserTest - superclass of PPCCompilerTest"
- #'stx:goodies/sunit' "TestAsserter - superclass of PPCCompilerTest"
+ #'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"
)
!
@@ -74,9 +76,9 @@
by searching all classes (and their packages) which are referenced by my classes."
^ #(
- #'stx:goodies/petitparser' "PPCharSetPredicate - referenced by PPCNodeCompilingTest>>testCompileCharSetPredicate"
- #'stx:goodies/petitparser/compiler' "PPCAbstractLiteralNode - referenced by PPCNodeFirstFollowNextTests>>testFirst1"
- #'stx:goodies/petitparser/parsers/smalltalk' "PPSmalltalkGrammar - referenced by PPCompiledSmalltalkGrammarResource>>setUp"
+ #'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"
)
!
@@ -108,17 +110,33 @@
^ #(
"<className> or (<className> attributes...) in load order"
+ PPCCodeGeneratorTest
PPCCompilerTest
PPCContextMementoTest
PPCContextTest
+ PPCCopyVisitorTest
PPCGuardTest
+ PPCInliningVisitorTest
+ PPCMergingVisitorTest
PPCMockCompiler
(PPCNodeCompilingTest autoload)
PPCNodeFirstFollowNextTests
PPCNodeTest
PPCOptimizingTest
+ PPCOptimizingVisitorTest
+ PPCProtype1Test
+ PPCTokenDetectorTest
+ PPCTokenVisitorTest
+ PPCTokenizingCodeGeneratorTest
+ PPCVerificationTest
+ PPCompiledExpressionGrammarResource
+ PPCompiledExpressionGrammarTest
+ PPCompiledJavaResource
+ (PPCompiledJavaSyntaxTest autoload)
PPCompiledSmalltalkGrammarResource
(PPCompiledSmalltalkGrammarTests autoload)
+ PPExpressionGrammar
+ PPExpressionGrammarTest
#'stx_goodies_petitparser_compiler_tests'
)
!