PetitCommonMark/software/petitcompiler/PPCInliningVisitor.class.st

224 lines
5.2 KiB
Smalltalk

"
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
]