PetitCommonMark/software/petitcompiler/PPCInliningVisitor.class.st

"
I mark nodes for inlining
"
Class {
	#name : 'PPCInliningVisitor',
	#superclass : 'PPCPassVisitor',
	#instVars : [
		'acceptedNodes'
	],
	#category : 'PetitCompiler-Visitors'
}

{ #category : 'hooks' }
PPCInliningVisitor >> beforeAccept: node [
	acceptedNodes := acceptedNodes + 1.
	super beforeAccept: node
]

{ #category : 'testing' }
PPCInliningVisitor >> canInline [
	^ acceptedNodes > 1
]

{ #category : 'initialization' }
PPCInliningVisitor >> initialize [
	super initialize.        
	acceptedNodes := 0

	"Modified (format): / 29-08-2015 / 07:40:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
]

{ #category : 'visiting' }
PPCInliningVisitor >> markForInline: node [
	self canInline ifTrue: [ 
		node markForInline.
	].
	^ node
]

{ #category : 'hooks' }
PPCInliningVisitor >> openDetected: node [
	"
		if someone is referring to the inlined node than we have a problem with cycle.
		Only non inlined nodes may start the cycle.
	"
	node unmarkForInline.
	^ super openDetected: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitActionNode: node [
	"Only mark unnamed sequence nodes for inlining.
	 Named nodes should not be inlined as they should make a method.
	 There's little point in inlining non-sequence nodes, so don't
	 enforce inlining on those. Some (JK :-) may prefer them non-inlined
	 (for debugging purposes)"

	self flag: 'JV: how is this supposed to work? Can you turn inlinin on and off?'.
	(node child isSequenceNode and:[node child name isNil]) 
		ifTrue: [ node child markForInline ].

	^ super visitActionNode: node.

	"Created: / 13-05-2015 / 16:25:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
	"Modified: / 31-07-2015 / 08:20:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitAndNode: node [
	^ super visitAndNode: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitAnyNode: node [
	^ self markForInline: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitCharSetPredicateNode: node [
	^ self markForInline: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitCharacterNode: node [
	^ self markForInline: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitColumnNode: node [
	^ self markForInline: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitIslandNode: node [
	super visitIslandNode: node.
	
	"island node children cannot be inlined, because they are referred from a PPCBridge"
	node children do: [ :child |
		| forward |
		child isMarkedForInline ifTrue: [ 
			forward := PPCForwardNode new
				child: child;
				yourself.
			node replace: child with: forward. 
		]
	].
	^ node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitLiteralNode: node [
	^ self markForInline: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitMessagePredicateNode: node [
	^ self markForInline: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitNilNode: node [
	^ self markForInline: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitNotCharSetPredicateNode: node [
	^ self markForInline: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitNotLiteralNode: node [
	^ self markForInline: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitNotMessagePredicateNode: node [
	^ self markForInline: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> 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>"
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitStarCharSetPredicateNode: node [
	^ self markForInline: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitStarMessagePredicateNode: node [
	^ self markForInline: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitTokenConsumeNode: node [
	"super visitTokenConsumeNode: node."

"	node name isNil ifTrue: [ 
		self markForInline: node
	]."
	self markForInline: node.
	
	^ node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitTokenStarCharSetPredicateNode: node [
	^ self markForInline: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitTokenStarMessagePredicateNode: node [
	^ self markForInline: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitTokenStarSeparatorNode: node [
	^ self markForInline: node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitTokenWhitespaceNode: node [
	super visitTokenWhitespaceNode: node.
	self markForInline: node.
	^ node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitTokenizingParserNode: node [
	"skip tokens"
	"skip whitespace"
	"self visit: node whitespace."

	self visit: node parser.
	
	^ node
]

{ #category : 'visiting' }
PPCInliningVisitor >> visitUnknownNode: node [
	super visitUnknownNode: node.
	
	"unknown node children cannot be inlined, because they are referred from a PPCBridge"
	node children do: [ :child |
		| forward |
		child isMarkedForInline ifTrue: [ 
			forward := PPCForwardNode new
				child: child;
				yourself.
			node replace: child with: forward. 
		]
	].
	^ node
]