Added static analysis of blocks when inlining. Allow inlining only when block is functional
...i.e., does not access any shared state (in instance or class variables). If the block does
a self-send, the sent method has to be (transitively) functional too.
To allow for self-sends in action blocks, copy (transitively) self-sent methods to target
parser. This is safe as these self-sent methods are guarnateed to be functional.
--- a/compiler/Make.proto Mon Jul 27 10:21:41 2015 +0100
+++ b/compiler/Make.proto Mon Jul 27 16:28:48 2015 +0100
@@ -34,7 +34,7 @@
# add the path(es) here:,
# ********** OPTIONAL: MODIFY the next lines ***
# LOCALINCLUDES=-Ifoo -Ibar
-LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/analyzer -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/java -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk -I$(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2 -I$(INCLUDE_TOP)/stx/libview -I$(INCLUDE_TOP)/stx/libwidg -I$(INCLUDE_TOP)/stx/libwidg2
+LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/analyzer -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/java -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk -I$(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser -I$(INCLUDE_TOP)/stx/goodies/sunit -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2 -I$(INCLUDE_TOP)/stx/libview -I$(INCLUDE_TOP)/stx/libwidg -I$(INCLUDE_TOP)/stx/libwidg2
# if you need any additional defines for embedded C code,
@@ -136,11 +136,14 @@
$(OUTDIR)PEGFsaPair.$(O) PEGFsaPair.$(H): PEGFsaPair.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PEGFsaState.$(O) PEGFsaState.$(H): PEGFsaState.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PEGFsaTransition.$(O) PEGFsaTransition.$(H): PEGFsaTransition.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCASTUtilities.$(O) PPCASTUtilities.$(H): PPCASTUtilities.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCArguments.$(O) PPCArguments.$(H): PPCArguments.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCBridge.$(O) PPCBridge.$(H): PPCBridge.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCClassBuilder.$(O) PPCClassBuilder.$(H): PPCClassBuilder.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCCodeBlock.$(O) PPCCodeBlock.$(H): PPCCodeBlock.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCCodeGen.$(O) PPCCodeGen.$(H): PPCCodeGen.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCCompilationError.$(O) PPCCompilationError.$(H): PPCCompilationError.st $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCCompilationWarning.$(O) PPCCompilationWarning.$(H): PPCCompilationWarning.st $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Notification.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/UserNotification.$(H) $(INCLUDE_TOP)/stx/libbasic/Warning.$(H) $(STCHDR)
$(OUTDIR)PPCCompiledMethod.$(O) PPCCompiledMethod.$(H): PPCCompiledMethod.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCCompiler.$(O) PPCCompiler.$(H): PPCCompiler.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCCompilerTokenErrorStrategy.$(O) PPCCompilerTokenErrorStrategy.$(H): PPCCompilerTokenErrorStrategy.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
--- a/compiler/Make.spec Mon Jul 27 10:21:41 2015 +0100
+++ b/compiler/Make.spec Mon Jul 27 16:28:48 2015 +0100
@@ -57,11 +57,14 @@
PEGFsaPair \
PEGFsaState \
PEGFsaTransition \
+ PPCASTUtilities \
PPCArguments \
PPCBridge \
PPCClassBuilder \
PPCCodeBlock \
PPCCodeGen \
+ PPCCompilationError \
+ PPCCompilationWarning \
PPCCompiledMethod \
PPCCompiler \
PPCCompilerTokenErrorStrategy \
@@ -165,11 +168,14 @@
$(OUTDIR_SLASH)PEGFsaPair.$(O) \
$(OUTDIR_SLASH)PEGFsaState.$(O) \
$(OUTDIR_SLASH)PEGFsaTransition.$(O) \
+ $(OUTDIR_SLASH)PPCASTUtilities.$(O) \
$(OUTDIR_SLASH)PPCArguments.$(O) \
$(OUTDIR_SLASH)PPCBridge.$(O) \
$(OUTDIR_SLASH)PPCClassBuilder.$(O) \
$(OUTDIR_SLASH)PPCCodeBlock.$(O) \
$(OUTDIR_SLASH)PPCCodeGen.$(O) \
+ $(OUTDIR_SLASH)PPCCompilationError.$(O) \
+ $(OUTDIR_SLASH)PPCCompilationWarning.$(O) \
$(OUTDIR_SLASH)PPCCompiledMethod.$(O) \
$(OUTDIR_SLASH)PPCCompiler.$(O) \
$(OUTDIR_SLASH)PPCCompilerTokenErrorStrategy.$(O) \
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCASTUtilities.st Mon Jul 27 16:28:48 2015 +0100
@@ -0,0 +1,138 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCASTUtilities
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Support'
+!
+
+!PPCASTUtilities methodsFor:'checks'!
+
+checkNodeIsFunctional: anRBBlockNode inClass: aClaas
+ "Check whether the given node is purely functional or not.
+ If no, raise an erorr. If not, this method is noop.
+
+ A block is purely functional if and only if:
+ (i) it does not refer to any instance or class variable or non-local variable
+ (ii) all self-sends within the block are to 'purely-functional' methods
+ (transitively)
+ (iiI) contains no super-sends.
+ "
+ | allDefinedVarNames allInstVarNames allClassVarNames cls |
+
+ allDefinedVarNames := anRBBlockNode allDefinedVariables.
+ allInstVarNames := Set new.
+ allClassVarNames := Set new.
+ cls := aClaas.
+ [ cls notNil ] whileTrue:[
+ allInstVarNames addAll: cls instanceVariables.
+ allClassVarNames addAll: cls classVariables.
+ cls := cls superclass.
+ ].
+
+ self withAllVariableNodesOf: anRBBlockNode do: [ :node |
+ (allDefinedVarNames includes: node name) ifFalse:[
+ (allInstVarNames includes: node name) ifTrue:[
+ PPCCompilationError new signalWith: 'code refers to an instance variable named `',node name,'`'.
+ ^ self.
+ ].
+ (allClassVarNames includes: node name) ifTrue:[
+ PPCCompilationError new signalWith: 'code refers to a class variable named `',node name,'`'.
+ ^ self.
+ ].
+ (Smalltalk includesKey: node name asSymbol) ifFalse:[
+ PPCCompilationError new signalWith: 'code refers to an unknown variable named `',node name,'`'.
+ ^ self.
+ ].
+ ]
+ ].
+ self withAllMessageNodesOf: anRBBlockNode sentToSelfDo:[:node |
+ | method |
+
+ method := aClaas lookupSelector: node selector.
+ method isNil ifTrue:[
+ PPCCompilationError new signalWith: 'code contains self-send to non-existent method'.
+ ^ self
+ ].
+ self checkNodeIsFunctional: method parseTree inClass: method methodClass.
+ ].
+ self withAllSuperNodesOf: anRBBlockNode do: [ :node |
+ PPCCompilationError new signalWith: 'code contains a super-send'.
+ ^ self
+ ].
+
+ "Created: / 27-07-2015 / 12:15:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-07-2015 / 14:43:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCASTUtilities methodsFor:'enumerating'!
+
+withAllMessageNodesOf: anRBProgramNode do: aBlock
+ "Enumerate all chilren of `anRBProgramNode` (including itself)
+ and evaluate `aBlock` for each message node."
+
+ self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isMessage ] do: aBlock.
+
+ "Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 27-07-2015 / 11:26:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+withAllMessageNodesOf: anRBProgramNode sentToSelfDo: aBlock
+ "Enumerate all chilren of `anRBProgramNode` (including itself)
+ and evaluate `aBlock` for each message node which sends a message
+ to self (i.e., for self-sends)."
+
+ self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isMessage and:[node receiver isSelf ] ] do: aBlock.
+
+ "Created: / 27-07-2015 / 14:41:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+withAllNodesOf: node suchThat: predicate do: action
+ "Enumerate all chilren of `node` (including itself)
+ and evaluate `aBlock` for each node for which `predicate` returns true."
+
+ (predicate value: node) ifTrue:[
+ action value: node.
+ ].
+ node children do:[:each |
+ self withAllNodesOf: each suchThat: predicate do: action
+ ].
+
+ "Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 27-07-2015 / 11:26:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+withAllSelfNodesOf: anRBProgramNode do: aBlock
+ "Enumerate all chilren of `anRBProgramNode` (including itself)
+ and evaluate `aBlock` for each `self` node."
+
+ self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isSelf ] do: aBlock.
+
+ "Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 27-07-2015 / 11:26:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+withAllSuperNodesOf: anRBProgramNode do: aBlock
+ "Enumerate all chilren of `anRBProgramNode` (including itself)
+ and evaluate `aBlock` for each `super` node."
+
+ self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isSuper ] do: aBlock.
+
+ "Created: / 27-07-2015 / 14:42:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+withAllVariableNodesOf: anRBProgramNode do: aBlock
+ "Enumerate all chilren of `anRBProgramNode` (including itself)
+ and evaluate `aBlock` for each variable node.
+ This is a replacement for Smalltalk/X's RBProgramNode>>variableNodesDo:
+ which is not present in Pharo"
+
+ self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isVariable and:[node isSelf not and:[node isSuper not]]] do: aBlock.
+
+ "Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 27-07-2015 / 11:27:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCASTUtilitiesTests.st Mon Jul 27 16:28:48 2015 +0100
@@ -0,0 +1,117 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCASTUtilitiesTests
+ instanceVariableNames:''
+ classVariableNames:'SomeClassVariable'
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Support'
+!
+
+!PPCASTUtilitiesTests methodsFor:'methods under test'!
+
+methodSimple1
+ ^ 1
+
+ "Created: / 27-07-2015 / 13:27:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithArguments: arg1
+ (arg1 + 4) yourself isOdd ifTrue:[
+ ^ true
+ ].
+ ^ false not.
+
+ "Created: / 27-07-2015 / 13:35:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithClassReference
+ ^ PPCASTUtilities new
+
+ "Created: / 27-07-2015 / 13:28:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithClassVariableReference
+ ^ SomeClassVariable
+
+ "Created: / 27-07-2015 / 14:02:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithInstanceVariableReference
+ ^ testSelector
+
+ "Created: / 27-07-2015 / 13:29:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithSelfSend1
+ ^ self methodSimple1
+
+ "Created: / 27-07-2015 / 13:28:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithSelfSend2
+ ^ self methodWithSelfSend1
+
+ "Created: / 27-07-2015 / 13:34:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithSelfSend3
+ ^ self methodWithInstanceVariableReference
+
+ "Created: / 27-07-2015 / 14:01:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithSuperSend
+ ^ super yourself
+
+ "Created: / 27-07-2015 / 14:02:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methodWithTemporaries
+ | tmp1 |
+
+ tmp1 := 3.
+ (tmp1 + 4) yourself isOdd ifTrue:[
+ | tmp2 |
+
+ tmp2 := tmp1 + 1.
+ ^ tmp1 + tmp2.
+ ].
+ ^ tmp1
+
+ "Created: / 27-07-2015 / 13:33:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCASTUtilitiesTests methodsFor:'tests'!
+
+test_checkNodeIsFunctional_1
+ self shouldnt: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodSimple1) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+ self shouldnt: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithSelfSend1) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+ self shouldnt: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithSelfSend2) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+ self shouldnt: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithClassReference) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+ self shouldnt: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithTemporaries) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+ self shouldnt: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithArguments:) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+
+ "Created: / 27-07-2015 / 14:00:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_checkNodeIsFunctional_2
+ self should: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithInstanceVariableReference) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+ self should: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithClassVariableReference) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+ self should: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithSelfSend3) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+ self should: [ PPCASTUtilities new checkNodeIsFunctional: (self class >> #methodWithSuperSend) parseTree inClass: self class ]
+ raise: PPCCompilationError.
+
+ "Created: / 27-07-2015 / 14:00:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- a/compiler/PPCCodeGenerator.st Mon Jul 27 10:21:41 2015 +0100
+++ b/compiler/PPCCodeGenerator.st Mon Jul 27 16:28:48 2015 +0100
@@ -191,21 +191,59 @@
!PPCCodeGenerator methodsFor:'private'!
-withAllVariableNodesOf: anRBProgramNode do: aBlock
- "Enumerate all chilren of `anRBProgramNode` (including itself)
- and evaluate `aBlock` for each variable node.
- This is a replacement for Smalltalk/X's RBProgramNode>>variableNodesDo:
- which is not present in Pharo"
+checkBlockIsInlinable: block
+ "Check whether the given block could be inlined. If not,
+ throw an error. If yes, this method is noop.
+
+ A block is inlineable if and only if it's a purely functional
+ (see PPCASTUtilities>>checkBlockIsPurelyFunctional:inClass: for
+ details)
+
+ As a side-effect, copy all self-sent methods from the block
+ to the target class.
+ "
+ | blockNode |
- anRBProgramNode isVariable ifTrue:[
- aBlock value: anRBProgramNode.
- ^ self.
- ].
- anRBProgramNode children do:[:each |
- self withAllVariableNodesOf: each do: aBlock
+ blockNode := block sourceNode.
+ "In Smalltalk implementation which use cheap-block optimization (Smalltalk/X) it may
+ happen that home context of the block is nil (in case of cheap blocks)"
+ block home notNil ifTrue:[
+ | blockClass |
+
+ blockClass := block home receiver class.
+ PPCASTUtilities new checkNodeIsFunctional: blockNode inClass: blockClass.
+ "The above code should raise an error when block is not functional (i.e., when not
+ inlineable, so if the control flow reach this point, block is OK and we can safely
+ copy self-sent methods."
+ self copySelfSentMethodsOf: blockNode inClass: blockClass
].
- "Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 27-07-2015 / 14:40:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-07-2015 / 15:52:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+copySelfSentMethodsOf: anRBProgramNode inClass: aClass
+ PPCASTUtilities new withAllMessageNodesOf: anRBProgramNode sentToSelfDo: [ :node|
+ | method source |
+
+ method := aClass lookupSelector: node selector.
+ method isNil ifTrue:[
+ PPCCompilationError new signalWith: 'oops, no method found (internal error)!!'.
+ ].
+ source := method source.
+ source isNil ifTrue:[
+ PPCCompilationError new signalWith: 'unavailable source for method ', method printString ,'!!'.
+ ].
+ "Following actually copies the method to the target class,
+ though the APU is not nice. This has to be cleaned up"
+ (compiler cachedValue: node selector) isNil ifTrue:[
+ compiler cache: node selector as: (PPCMethod new id: node selector; source: source; yourself).
+ "Now compile self-sends of the just copied method"
+ self copySelfSentMethodsOf: method parseTree inClass: aClass
+ ].
+ ]
+
+ "Created: / 27-07-2015 / 14:50:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCCodeGenerator methodsFor:'support'!
@@ -311,6 +349,7 @@
visitActionNode: node
| blockNode blockBody blockNodesVar blockNeedsCollection blockMatches childValueVars |
+ self checkBlockIsInlinable: node block.
blockNode := node block sourceNode copy.
self assert: blockNode arguments size == 1.
blockNodesVar := blockNode arguments first .
@@ -335,7 +374,7 @@
blockNeedsCollection := false.
blockMatches := IdentityDictionary new."Must use IDENTITY dict as nodes have overwritten their #=!!!!!!"
childValueVars := node child preferredChildrenVariableNames.
- self withAllVariableNodesOf: blockBody do:[:variableNode|
+ PPCASTUtilities new withAllVariableNodesOf: blockBody do:[:variableNode|
variableNode name = blockNodesVar name ifTrue:[
"Check if variable node matches..."
variableNode parent isMessage ifTrue:[
@@ -366,7 +405,7 @@
blockNeedsCollection ifTrue:[
"Bad, we have to use the collection.
Replace all references to blockNodeVar to retvalVar..."
- self withAllVariableNodesOf: blockBody do:[:variableNode|
+ PPCASTUtilities new withAllVariableNodesOf: blockBody do:[:variableNode|
variableNode name = blockNodesVar name ifTrue:[
variableNode name: self retvalVar.
].
@@ -404,7 +443,7 @@
compiler code: blockBody.
]
- "Modified: / 19-06-2015 / 07:05:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-07-2015 / 15:49:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitAndNode: node
@@ -536,6 +575,7 @@
visitMappedActionNode: node
| child blockNode blockBody |
+ self checkBlockIsInlinable: node block.
child := node child.
blockNode := node block sourceNode copy.
blockBody := blockNode body.
@@ -569,7 +609,7 @@
| blockArg |
blockArg := blockNode arguments first.
- self withAllVariableNodesOf: blockBody do:[:variableNode|
+ PPCASTUtilities new withAllVariableNodesOf: blockBody do:[:variableNode|
variableNode name = blockArg name ifTrue:[
variableNode name: self retvalVar.
].
@@ -595,7 +635,7 @@
]
"Created: / 02-06-2015 / 17:28:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 19-06-2015 / 07:06:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-07-2015 / 15:49:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitMessagePredicateNode: node
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCCompilationError.st Mon Jul 27 16:28:48 2015 +0100
@@ -0,0 +1,11 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Error subclass:#PPCCompilationError
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Exceptions'
+!
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCCompilationWarning.st Mon Jul 27 16:28:48 2015 +0100
@@ -0,0 +1,11 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Warning subclass:#PPCCompilationWarning
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Exceptions'
+!
+
--- a/compiler/abbrev.stc Mon Jul 27 10:21:41 2015 +0100
+++ b/compiler/abbrev.stc Mon Jul 27 16:28:48 2015 +0100
@@ -7,11 +7,15 @@
PEGFsaPair PEGFsaPair stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
PEGFsaState PEGFsaState stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
PEGFsaTransition PEGFsaTransition stx:goodies/petitparser/compiler 'PetitCompiler-FSA' 0
+PPCASTUtilities PPCASTUtilities stx:goodies/petitparser/compiler 'PetitCompiler-Support' 0
+PPCASTUtilitiesTests PPCASTUtilitiesTests stx:goodies/petitparser/compiler 'PetitCompiler-Tests-Support' 1
PPCArguments PPCArguments stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCBridge PPCBridge stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCClassBuilder PPCClassBuilder stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCCodeBlock PPCCodeBlock stx:goodies/petitparser/compiler 'PetitCompiler-Compiler-Codegen' 0
PPCCodeGen PPCCodeGen stx:goodies/petitparser/compiler 'PetitCompiler-Compiler-Codegen' 0
+PPCCompilationError PPCCompilationError stx:goodies/petitparser/compiler 'PetitCompiler-Exceptions' 1
+PPCCompilationWarning PPCCompilationWarning stx:goodies/petitparser/compiler 'PetitCompiler-Exceptions' 1
PPCCompiledMethod PPCCompiledMethod stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCCompiler PPCCompiler stx:goodies/petitparser/compiler 'PetitCompiler-Compiler' 0
PPCCompilerTokenErrorStrategy PPCCompilerTokenErrorStrategy stx:goodies/petitparser/compiler 'PetitCompiler-Compiler' 0
--- a/compiler/bc.mak Mon Jul 27 10:21:41 2015 +0100
+++ b/compiler/bc.mak Mon Jul 27 16:28:48 2015 +0100
@@ -35,7 +35,7 @@
-LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\analyzer -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\java -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2 -I$(INCLUDE_TOP)\stx\libview -I$(INCLUDE_TOP)\stx\libwidg -I$(INCLUDE_TOP)\stx\libwidg2
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\analyzer -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\java -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser -I$(INCLUDE_TOP)\stx\goodies\sunit -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2 -I$(INCLUDE_TOP)\stx\libview -I$(INCLUDE_TOP)\stx\libwidg -I$(INCLUDE_TOP)\stx\libwidg2
LOCALDEFINES=
STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
@@ -83,11 +83,14 @@
$(OUTDIR)PEGFsaPair.$(O) PEGFsaPair.$(H): PEGFsaPair.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PEGFsaState.$(O) PEGFsaState.$(H): PEGFsaState.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PEGFsaTransition.$(O) PEGFsaTransition.$(H): PEGFsaTransition.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCASTUtilities.$(O) PPCASTUtilities.$(H): PPCASTUtilities.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCArguments.$(O) PPCArguments.$(H): PPCArguments.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCBridge.$(O) PPCBridge.$(H): PPCBridge.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCClassBuilder.$(O) PPCClassBuilder.$(H): PPCClassBuilder.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCCodeBlock.$(O) PPCCodeBlock.$(H): PPCCodeBlock.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCCodeGen.$(O) PPCCodeGen.$(H): PPCCodeGen.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCCompilationError.$(O) PPCCompilationError.$(H): PPCCompilationError.st $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCCompilationWarning.$(O) PPCCompilationWarning.$(H): PPCCompilationWarning.st $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Notification.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\UserNotification.$(H) $(INCLUDE_TOP)\stx\libbasic\Warning.$(H) $(STCHDR)
$(OUTDIR)PPCCompiledMethod.$(O) PPCCompiledMethod.$(H): PPCCompiledMethod.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCCompiler.$(O) PPCCompiler.$(H): PPCCompiler.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCCompilerTokenErrorStrategy.$(O) PPCCompilerTokenErrorStrategy.$(H): PPCCompilerTokenErrorStrategy.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
--- a/compiler/libInit.cc Mon Jul 27 10:21:41 2015 +0100
+++ b/compiler/libInit.cc Mon Jul 27 16:28:48 2015 +0100
@@ -33,11 +33,14 @@
_PEGFsaPair_Init(pass,__pRT__,snd);
_PEGFsaState_Init(pass,__pRT__,snd);
_PEGFsaTransition_Init(pass,__pRT__,snd);
+_PPCASTUtilities_Init(pass,__pRT__,snd);
_PPCArguments_Init(pass,__pRT__,snd);
_PPCBridge_Init(pass,__pRT__,snd);
_PPCClassBuilder_Init(pass,__pRT__,snd);
_PPCCodeBlock_Init(pass,__pRT__,snd);
_PPCCodeGen_Init(pass,__pRT__,snd);
+_PPCCompilationError_Init(pass,__pRT__,snd);
+_PPCCompilationWarning_Init(pass,__pRT__,snd);
_PPCCompiledMethod_Init(pass,__pRT__,snd);
_PPCCompiler_Init(pass,__pRT__,snd);
_PPCCompilerTokenErrorStrategy_Init(pass,__pRT__,snd);
--- a/compiler/stx_goodies_petitparser_compiler.st Mon Jul 27 10:21:41 2015 +0100
+++ b/compiler/stx_goodies_petitparser_compiler.st Mon Jul 27 16:28:48 2015 +0100
@@ -59,6 +59,7 @@
#'stx:goodies/petitparser' "PPActionParser - extended"
#'stx:goodies/petitparser/parsers/java' "PPJavaWhitespaceParser - extended"
#'stx:goodies/petitparser/parsers/smalltalk' "PPSmalltalkGrammar - extended"
+ #'stx:goodies/sunit' "TestAsserter - superclass of PPCASTUtilitiesTests"
#'stx:libbasic' "Character - extended"
)
!
@@ -117,11 +118,15 @@
PEGFsaPair
PEGFsaState
PEGFsaTransition
+ PPCASTUtilities
+ (PPCASTUtilitiesTests autoload)
PPCArguments
PPCBridge
PPCClassBuilder
PPCCodeBlock
PPCCodeGen
+ PPCCompilationError
+ PPCCompilationWarning
PPCCompiledMethod
PPCCompiler
PPCCompilerTokenErrorStrategy
--- a/compiler/tests/PPCCodeGeneratorTest.st Mon Jul 27 10:21:41 2015 +0100
+++ b/compiler/tests/PPCCodeGeneratorTest.st Mon Jul 27 16:28:48 2015 +0100
@@ -143,6 +143,20 @@
"Created: / 16-06-2015 / 07:22:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+testActionNode7
+ node := ((#letter asParser , #letter asParser)
+ ==> [:nodes | self createStringFromCharacters: nodes ]) asCompilerTree.
+ node child markForInline.
+
+ self compileTree:node.
+
+ self assert:parser parse:'ab' to:'ab'.
+ self assert:parser parse:'cz' to:'cz'.
+ self assert:parser fail:''.
+
+ "Created: / 27-07-2015 / 15:48:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
testAnyNode
node := PPCForwardNode new
child: PPCAnyNode new;
@@ -1109,6 +1123,14 @@
self assert: parser parse: '' to: nil.
! !
+!PPCCodeGeneratorTest methodsFor:'utilities'!
+
+createStringFromCharacters: characters
+ ^ String withAll: characters
+
+ "Created: / 27-07-2015 / 15:47:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!PPCCodeGeneratorTest class methodsFor:'documentation'!
version_HG
--- a/compiler/tests/extras/PPCompiledSmalltalkParserTests.st Mon Jul 27 10:21:41 2015 +0100
+++ b/compiler/tests/extras/PPCompiledSmalltalkParserTests.st Mon Jul 27 16:28:48 2015 +0100
@@ -12,9 +12,9 @@
!PPCompiledSmalltalkParserTests class methodsFor:'as yet unclassified'!
resources
- ^ (OrderedCollection with: PPCompiledSmalltalkParserResource)
- addAll: super resources;
- yourself
+ ^ Array with: PPCompiledSmalltalkParserResource
+
+ "Modified: / 27-07-2015 / 15:58:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCompiledSmalltalkParserTests methodsFor:'as yet unclassified'!
@@ -29,11 +29,901 @@
parserInstanceFor: aSymbol
^ (Smalltalk at: #PPCompiledSmalltalkParser) new startSymbol: aSymbol
+! !
+
+!PPCompiledSmalltalkParserTests methodsFor:'testing'!
+
+testArray1
+ self
+ parse: '{}'
+ rule: #array
+!
+
+testArray2
+ self
+ parse: '{self foo}'
+ rule: #array
+!
+
+testArray3
+ self
+ parse: '{self foo. self bar}'
+ rule: #array
+!
+
+testArray4
+ self
+ parse: '{self foo. self bar.}'
+ rule: #array
+!
+
+testAssignment1
+ self
+ parse: '1'
+ rule: #expression
+!
+
+testAssignment2
+ self
+ parse: 'a := 1'
+ rule: #expression
+!
+
+testAssignment3
+ self
+ parse: 'a := b := 1'
+ rule: #expression
+!
+
+testAssignment4
+ PPSmalltalkGrammar allowUnderscoreAssignment
+ ifTrue: [ self parse: 'a _ 1' rule: #expression ]
+ ifFalse: [ self fail: 'a _ 1' rule: #expression ]
+!
+
+testAssignment5
+ PPSmalltalkGrammar allowUnderscoreAssignment
+ ifTrue: [ self parse: 'a _ b _ 1' rule: #expression ]
+ ifFalse: [ self fail: 'a _ b _ 1' rule: #expression ]
+!
+
+testAssignment6
+ self
+ parse: 'a := (b := c)'
+ rule: #expression
+!
+
+testComment1
+ self
+ parse: '1"one"+2'
+ rule: #expression
+!
+
+testComment2
+ self
+ parse: '1 "one" +2'
+ rule: #expression
+!
+
+testComment3
+ self
+ parse: '1"one"+"two"2'
+ rule: #expression
+!
+
+testComment4
+ self
+ parse: '1"one""two"+2'
+ rule: #expression
+!
+
+testComment5
+ self
+ parse: '1"one" "two"+2'
+ rule: #expression
+!
+
+testCompleteness
+ "This test asserts that all subclasses override all test methods."
+
+ self class allSubclasses do: [ :subclass |
+ self class testSelectors do: [ :selector |
+ self
+ assert: (selector = #testCompleteness or: [ subclass selectors includes: selector ])
+ description: subclass printString , ' does not test ' , selector printString ] ]
+!
+
+testMethod1
+ self
+ parse: 'negated ^ 0 - self'
+ rule: #method
+!
+
+testMethod2
+ "Spaces at the beginning of the method."
+ self
+ parse: ' negated ^ 0 - self'
+ rule: #method
+!
+
+testMethod3
+ "Spaces at the end of the method."
+ self
+ parse: ' negated ^ 0 - self '
+ rule: #method
+!
+
+testMethod4
+ self
+ parse: 'foo: bar
+ foo:= bar'
+ rule: #method
+!
+
+testSequence1
+ self
+ parse: '| a | 1 . 2'
+ rule: #sequence
+!
+
+testStatements1
+ self
+ parse: '1'
+ rule: #sequence
+!
+
+testStatements2
+ self
+ parse: '1 . 2'
+ rule: #sequence
+!
+
+testStatements3
+ self
+ parse: '1 . 2 . 3'
+ rule: #sequence
+!
+
+testStatements4
+ self
+ parse: '1 . 2 . 3 .'
+ rule: #sequence
+!
+
+testStatements5
+ self
+ parse: '1 . . 2'
+ rule: #sequence
+!
+
+testStatements6
+ self
+ parse: '1. 2'
+ rule: #sequence
+!
+
+testStatements7
+ self
+ parse: '. 1'
+ rule: #sequence
+!
+
+testStatements8
+ self
+ parse: '.1'
+ rule: #sequence
+!
+
+testStatements9
+ self
+ parse: ''
+ rule: #statements
+!
+
+testTemporaries1
+ self
+ parse: '| a |'
+ rule: #sequence
+!
+
+testTemporaries2
+ self
+ parse: '| a b |'
+ rule: #sequence
+!
+
+testTemporaries3
+ self
+ parse: '| a b c |'
+ rule: #sequence
+!
+
+testVariable1
+ self
+ parse: 'trueBinding'
+ rule: #primary
+!
+
+testVariable2
+ self
+ parse: 'falseBinding'
+ rule: #primary
+!
+
+testVariable3
+ self
+ parse: 'nilly'
+ rule: #primary
+!
+
+testVariable4
+ self
+ parse: 'selfish'
+ rule: #primary
+!
+
+testVariable5
+ self
+ parse: 'supernanny'
+ rule: #primary
+!
+
+testVariable6
+ PPSmalltalkGrammar allowUnderscoreAssignment ifFalse: [
+ self
+ parse: 'super_nanny'
+ rule: #primary ]
+!
+
+testVariable7
+ PPSmalltalkGrammar allowUnderscoreAssignment ifFalse: [
+ self
+ parse: '__gen_var_123__'
+ rule: #primary ]
+! !
+
+!PPCompiledSmalltalkParserTests methodsFor:'testing-blocks'!
+
+testArgumentsBlock1
+ self
+ parse: '[ :a | ]'
+ rule: #block
+!
+
+testArgumentsBlock2
+ self
+ parse: '[ :a :b | ]'
+ rule: #block
+!
+
+testArgumentsBlock3
+ self
+ parse: '[ :a :b :c | ]'
+ rule: #block
!
testBlock1
self
parse: '[]'
rule: #block
+!
+
+testComplexBlock1
+ self
+ parse: '[ :a | | b | c ]'
+ rule: #block
+!
+
+testComplexBlock2
+ self
+ parse: '[:a||b|c]'
+ rule: #block
+!
+
+testSimpleBlock1
+ self
+ parse: '[ ]'
+ rule: #block
+!
+
+testSimpleBlock2
+ self
+ parse: '[ nil ]'
+ rule: #block
+!
+
+testSimpleBlock3
+ self
+ parse: '[ :a ]'
+ rule: #block
+!
+
+testStatementBlock1
+ self
+ parse: '[ nil ]'
+ rule: #block
+!
+
+testStatementBlock2
+ self
+ parse: '[ | a | nil ]'
+ rule: #block
+!
+
+testStatementBlock3
+ self
+ parse: '[ | a b | nil ]'
+ rule: #block
! !
+!PPCompiledSmalltalkParserTests methodsFor:'testing-literals'!
+
+testArrayLiteral1
+ self
+ parse: '#()'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral10
+ self
+ parse: '#((1 2) #(1 2 3))'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral11
+ self
+ parse: '#([1 2] #[1 2 3])'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral2
+ self
+ parse: '#(1)'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral3
+ self
+ parse: '#(1 2)'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral4
+ self
+ parse: '#(true false nil)'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral5
+ self
+ parse: '#($a)'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral6
+ self
+ parse: '#(1.2)'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral7
+ self
+ parse: '#(size #at: at:put: #''=='')'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral8
+ self
+ parse: '#(''baz'')'
+ rule: #arrayLiteral
+!
+
+testArrayLiteral9
+ self
+ parse: '#((1) 2)'
+ rule: #arrayLiteral
+!
+
+testByteLiteral1
+ self
+ parse: '#[]'
+ rule: #byteLiteral
+!
+
+testByteLiteral2
+ self
+ parse: '#[0]'
+ rule: #byteLiteral
+!
+
+testByteLiteral3
+ self
+ parse: '#[255]'
+ rule: #byteLiteral
+!
+
+testByteLiteral4
+ self
+ parse: '#[ 1 2 ]'
+ rule: #byteLiteral
+!
+
+testByteLiteral5
+ self
+ parse: '#[ 2r1010 8r77 16rFF ]'
+ rule: #byteLiteral
+!
+
+testCharLiteral1
+ self
+ parse: '$a'
+ rule: #charLiteral
+!
+
+testCharLiteral2
+ self
+ parse: '$ '
+ rule: #charLiteral
+!
+
+testCharLiteral3
+ self
+ parse: '$$'
+ rule: #charLiteral
+!
+
+testNumberLiteral1
+ self
+ parse: '0'
+ rule: #numberLiteral
+!
+
+testNumberLiteral10
+ self
+ parse: '10r10'
+ rule: #numberLiteral
+!
+
+testNumberLiteral11
+ self
+ parse: '8r777'
+ rule: #numberLiteral
+!
+
+testNumberLiteral12
+ self
+ parse: '16rAF'
+ rule: #numberLiteral
+!
+
+testNumberLiteral13
+ self
+ parse: '16rCA.FE'
+ rule: #numberLiteral
+!
+
+testNumberLiteral14
+ self
+ parse: '3r-22.2'
+ rule: #numberLiteral
+!
+
+testNumberLiteral15
+ self
+ parse: '0.50s2'
+ rule: #numberLiteral
+!
+
+testNumberLiteral2
+ self
+ parse: '0.1'
+ rule: #numberLiteral
+!
+
+testNumberLiteral3
+ self
+ parse: '123'
+ rule: #numberLiteral
+!
+
+testNumberLiteral4
+ self
+ parse: '123.456'
+ rule: #numberLiteral
+!
+
+testNumberLiteral5
+ self
+ parse: '-0'
+ rule: #numberLiteral
+!
+
+testNumberLiteral6
+ self
+ parse: '-0.1'
+ rule: #numberLiteral
+!
+
+testNumberLiteral7
+ self
+ parse: '-123'
+ rule: #numberLiteral
+!
+
+testNumberLiteral8
+ self
+ parse: '-125'
+ rule: #numberLiteral
+!
+
+testNumberLiteral9
+ self
+ parse: '-123.456'
+ rule: #numberLiteral
+!
+
+testSpecialLiteral1
+ self
+ parse: 'true'
+ rule: #trueLiteral
+!
+
+testSpecialLiteral2
+ self
+ parse: 'false'
+ rule: #falseLiteral
+!
+
+testSpecialLiteral3
+ self
+ parse: 'nil'
+ rule: #nilLiteral
+!
+
+testStringLiteral1
+ self
+ parse: ''''''
+ rule: #stringLiteral
+!
+
+testStringLiteral2
+ self
+ parse: '''ab'''
+ rule: #stringLiteral
+!
+
+testStringLiteral3
+ self
+ parse: '''ab''''cd'''
+ rule: #stringLiteral
+!
+
+testSymbolLiteral1
+ self
+ parse: '#foo'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral2
+ self
+ parse: '#+'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral3
+ self
+ parse: '#key:'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral4
+ self
+ parse: '#key:value:'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral5
+ self
+ parse: '#''testing-result'''
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral6
+ PPSmalltalkGrammar allowUnderscoreAssignment ifFalse: [
+ self
+ parse: '#__gen__binding'
+ rule: #symbolLiteral ]
+!
+
+testSymbolLiteral7
+ self
+ parse: '# fucker'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral8
+ self
+ parse: '##fucker'
+ rule: #symbolLiteral
+!
+
+testSymbolLiteral9
+ self
+ parse: '## fucker'
+ rule: #symbolLiteral
+! !
+
+!PPCompiledSmalltalkParserTests methodsFor:'testing-messages'!
+
+testBinaryExpression1
+ self
+ parse: '1 + 2'
+ rule: #expression
+!
+
+testBinaryExpression2
+ self
+ parse: '1 + 2 + 3'
+ rule: #expression
+!
+
+testBinaryExpression3
+ self
+ parse: '1 // 2'
+ rule: #expression
+!
+
+testBinaryExpression4
+ self
+ parse: '1 -- 2'
+ rule: #expression
+!
+
+testBinaryExpression5
+ self
+ parse: '1 ==> 2'
+ rule: #expression.
+!
+
+testBinaryMethod1
+ self
+ parse: '+ a'
+ rule: #method
+!
+
+testBinaryMethod2
+ self
+ parse: '+ a | b |'
+ rule: #method
+!
+
+testBinaryMethod3
+ self
+ parse: '+ a b'
+ rule: #method
+!
+
+testBinaryMethod4
+ self
+ parse: '+ a | b | c'
+ rule: #method
+!
+
+testBinaryMethod5
+ self
+ parse: '-- a'
+ rule: #method
+!
+
+testCascadeExpression1
+ self
+ parse: '1 abs; negated'
+ rule: #expression
+!
+
+testCascadeExpression2
+ self
+ parse: '1 abs negated; raisedTo: 12; negated'
+ rule: #expression
+!
+
+testCascadeExpression3
+ self
+ parse: '1 + 2; - 3'
+ rule: #expression
+!
+
+testIdentifierToken
+ self
+ parse: 'foo'
+ rule: #identifierToken
+!
+
+testIdentifierToken2
+ self
+ parse: ' foo'
+ rule: #identifierToken
+!
+
+testKeywordExpression1
+ self
+ parse: '1 to: 2'
+ rule: #expression
+!
+
+testKeywordExpression2
+ self
+ parse: '1 to: 2 by: 3'
+ rule: #expression
+!
+
+testKeywordExpression3
+ self
+ parse: '1 to: 2 by: 3 do: 4'
+ rule: #expression
+!
+
+testKeywordMethod1
+ self
+ parse: 'to: a'
+ rule: #method
+!
+
+testKeywordMethod2
+ self
+ parse: 'to: a do: b | c |'
+ rule: #method
+!
+
+testKeywordMethod3
+ self
+ parse: 'to: a do: b by: c d'
+ rule: #method
+!
+
+testKeywordMethod4
+ self
+ parse: 'to: a do: b by: c | d | e'
+ rule: #method
+!
+
+testUnaryExpression1
+ self
+ parse: '1 abs'
+ rule: #expression
+!
+
+testUnaryExpression2
+ self
+ parse: '1 abs negated'
+ rule: #expression
+!
+
+testUnaryMethod1
+ self
+ parse: 'abs'
+ rule: #method
+!
+
+testUnaryMethod2
+ self
+ parse: 'abs | a |'
+ rule: #method
+!
+
+testUnaryMethod3
+ self
+ parse: 'abs a'
+ rule: #method
+!
+
+testUnaryMethod4
+ self
+ parse: 'abs | a | b'
+ rule: #method
+!
+
+testUnaryMethod5
+ self
+ parse: 'abs | a |'
+ rule: #method
+! !
+
+!PPCompiledSmalltalkParserTests methodsFor:'testing-pragmas'!
+
+testPragma1
+ self
+ parse: 'method <foo>'
+ rule: #method
+!
+
+testPragma10
+ self
+ parse: 'method <foo: bar>'
+ rule: #method
+!
+
+testPragma11
+ self
+ parse: 'method <foo: true>'
+ rule: #method
+!
+
+testPragma12
+ self
+ parse: 'method <foo: false>'
+ rule: #method
+!
+
+testPragma13
+ self
+ parse: 'method <foo: nil>'
+ rule: #method
+!
+
+testPragma14
+ self
+ parse: 'method <foo: ()>'
+ rule: #method
+!
+
+testPragma15
+ self
+ parse: 'method <foo: #()>'
+ rule: #method
+!
+
+testPragma16
+ self
+ parse: 'method < + 1 >'
+ rule: #method
+!
+
+testPragma2
+ self
+ parse: 'method <foo> <bar>'
+ rule: #method
+!
+
+testPragma3
+ self
+ parse: 'method | a | <foo>'
+ rule: #method
+!
+
+testPragma4
+ self
+ parse: 'method <foo> | a |'
+ rule: #method
+!
+
+testPragma5
+ self
+ parse: 'method <foo> | a | <bar>'
+ rule: #method
+!
+
+testPragma6
+ self
+ parse: 'method <foo: 1>'
+ rule: #method
+!
+
+testPragma7
+ self
+ parse: 'method <foo: 1.2>'
+ rule: #method
+!
+
+testPragma8
+ self
+ parse: 'method <foo: ''bar''>'
+ rule: #method
+!
+
+testPragma9
+ self
+ parse: 'method <foo: #''bar''>'
+ rule: #method
+! !
+