"{ Package: 'jv:tea/compiler' }"
"{ NameSpace: Smalltalk }"
TProgramNodeVisitor subclass:#TCompilerPass
instanceVariableNames:'context currentClass currentMethod currentScope'
classVariableNames:''
poolDictionaries:''
category:'Languages-Tea-Compiler-Internals'
!
!TCompilerPass class methodsFor:'running'!
runOn: anObject
^ self new runOn: anObject
"Created: / 14-09-2015 / 13:57:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
runOn: anObject inContext: aTCompilerContext
^ self new runOn: anObject inContext: aTCompilerContext
"Created: / 14-09-2015 / 13:57:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
runOn: anObject inEnvironment: aTEnvironment
^ self new runOn: anObject inEnvironment: aTEnvironment
"Created: / 14-09-2015 / 13:57:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TCompilerPass methodsFor:'accessing'!
context
^ context
!
context:aTCompilerContext
context := aTCompilerContext.
! !
!TCompilerPass methodsFor:'running'!
run
self runOn: context unit
"Created: / 31-08-2015 / 11:52:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 14-09-2015 / 13:54:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
runOn: anObject
context isNil ifTrue:[
context := TCompilerContext new.
context environment: TEnvironment new.
context unit: anObject.
].
anObject isRingObject
ifTrue:[ self visitDefinition: anObject ]
ifFalse:[ self visitNode: anObject ]
"Created: / 14-09-2015 / 13:54:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
runOn: anObject inContext: aTCompilerContext
self context: aTCompilerContext.
self runOn: anObject
"Created: / 14-09-2015 / 13:55:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
runOn: anObject inEnvironment: aTEnvironment
context isNil ifTrue:[
context := TCompilerContext new.
context unit: anObject.
].
context environment: aTEnvironment.
self runOn: anObject
"Created: / 14-09-2015 / 13:59:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TCompilerPass methodsFor:'visiting'!
visitDefinition: definition
^ definition acceptVisitor: self
"Created: / 29-08-2015 / 21:50:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TCompilerPass methodsFor:'visitor-double dispatching'!
acceptBlockNode: aBlockNode
currentScope := aBlockNode scope.
super acceptBlockNode: aBlockNode
"Created: / 02-09-2015 / 07:20:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
acceptClassDefinition: aTClassDefinition
self visitDefinition: aTClassDefinition theMetaclass.
currentClass := aTClassDefinition.
aTClassDefinition methodDictionary do:[:each |
self visitDefinition: each
].
currentClass := nil.
"Created: / 29-08-2015 / 21:50:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 31-08-2015 / 11:03:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
acceptCompilationUnitDefinition: aTCompilationUnitDefinition
aTCompilationUnitDefinition classes do:[:class |
self visitDefinition: class.
].
"Created: / 14-09-2015 / 10:31:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
acceptIfTrueIfFalseNode: node
^ self acceptMessageNode: node.
"Created: / 14-09-2015 / 14:09:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-09-2015 / 11:59:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
acceptIfTrueNode: node
self acceptMessageNode: node
"Created: / 14-09-2015 / 14:09:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
acceptInlineAssemblyNode: aMethodNode
"Created: / 02-09-2015 / 07:03:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
acceptMetaclassDefinition: aTClassDefinition
currentClass := aTClassDefinition.
aTClassDefinition methodDictionary do:[:each |
self visitDefinition: each
].
currentClass := nil.
"Created: / 29-08-2015 / 21:54:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 31-08-2015 / 11:03:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
acceptMethodDefinition: aTMethodDefinition
currentMethod := aTMethodDefinition.
self visitNode: aTMethodDefinition parseTree.
currentMethod := nil.
"Created: / 29-08-2015 / 21:55:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 31-08-2015 / 11:03:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
acceptMethodNode: aMethodNode
currentScope := aMethodNode scope.
self visitArguments: aMethodNode arguments.
self visitNode: aMethodNode returnTypeSpec.
"/ If method node contains inline assembly, then visit that inline assembly
"/ node but nothing else!!
aMethodNode body statements first isInlineAssembly ifTrue:[
self visitNode: aMethodNode body statements first
] ifFalse:[
self visitNode: aMethodNode body
].
"Created: / 02-09-2015 / 07:16:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
acceptSpecialFormNode:aTSpecialFormNode
aTSpecialFormNode selector = #ifTrue: ifTrue:[
^ self acceptIfTrueNode:aTSpecialFormNode.
].
aTSpecialFormNode selector = #ifTrue:ifFalse: ifTrue:[
^ self acceptIfTrueIfFalseNode:aTSpecialFormNode.
].
aTSpecialFormNode selector = #whileTrue: ifTrue:[
^ self acceptWhileTrueNode:aTSpecialFormNode.
].
^ self error:'Unsupported special form: #' , aTSpecialFormNode selector
"Created: / 14-09-2015 / 14:09:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
acceptWhileTrueNode: node
self acceptMessageNode: node
"Created: / 14-09-2015 / 14:09:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !