"{ 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>"
!

acceptSequenceNode: aSequenceNode 
    | last |
    self passByNode:aSequenceNode.
    self visitArguments: aSequenceNode temporaries.
    aSequenceNode statements do: [:each | last := self visitNode: each].
    ^ last

    "Created: / 18-09-2015 / 06:10:20 / 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>"
! !