compiler/PPCInliningVisitor.st
changeset 438 20598d7ce9fa
child 452 9f4558b3be66
--- /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
+! !
+