--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCInliningVisitor.st Thu Apr 30 23:43:14 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
+! !
+