"
    Copyright (C) 2015-now Jan Vrany

    This code is not an open-source (yet). You may use this code
    for your own experiments and projects, given that:

    * all modification to the code will be sent to the
      original author for inclusion in future releases
    * this is not used in any commercial software

    This license is provisional and may (will) change in
    a future.
"
"{ Package: 'jv:tea/compiler' }"

"{ NameSpace: Smalltalk }"

TCompilerPass subclass:#TTypechecker
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'Languages-Tea-Compiler-Internals'
!

!TTypechecker class methodsFor:'documentation'!

copyright
"
    Copyright (C) 2015-now Jan Vrany

    This code is not an open-source (yet). You may use this code
    for your own experiments and projects, given that:

    * all modification to the code will be sent to the
      original author for inclusion in future releases
    * this is not used in any commercial software

    This license is provisional and may (will) change in
    a future.
"
! !

!TTypechecker methodsFor:'visiting'!

visitArgument: anRBVariableNode
    | binding |


    super visitArgument: anRBVariableNode.
    binding := anRBVariableNode binding.
    binding type: (anRBVariableNode typeSpec asType)

    "Created: / 20-09-2015 / 07:19:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!TTypechecker methodsFor:'visitor-double dispatching'!

acceptBlockNode: aBlockNode 
    | formalType actualType  |

    super acceptBlockNode: aBlockNode.

    formalType := aBlockNode binding type.
    actualType := aBlockNode body statements last binding type.
    formalType isAutomaticType ifTrue:[ 
        aBlockNode binding returnType: actualType.
    ] ifFalse:[ 
        formalType = actualType ifFalse:[ 
            context reportTypeError: ('Block return type is specified as %1 but actually is %3' bindWith: formalType with: actualType).
        ].
    ].

    "Created: / 23-09-2015 / 16:44:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

acceptIfTrueIfFalseNode: node
    | receiverType booleanType |

    receiverType := node receiver binding type.
    booleanType := context environment binding lookupClassBoolean type.

    receiverType = booleanType ifFalse:[ 
        context reportTypeError: 'receiver of ifTrue:ifFalse: special form must be of type tBoolean (is ' , receiverType printString.
    ].

    "Created: / 14-09-2015 / 14:24:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 15-09-2015 / 08:29:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

acceptIfTrueNode: node
    | receiverType booleanType |

    receiverType := node binding type.
    booleanType := context environment binding lookupClassBoolean.

    receiverType = booleanType ifFalse:[ 
        context reportTypeError: 'receiver of ifTrue: special form must be of type tBoolean (is ' , receiverType printString.
    ].

    "Created: / 14-09-2015 / 14:18:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

acceptLiteralNode: aLiteralNode
    | binding value |

    binding := aLiteralNode binding.
    value := binding value.
    value isInteger ifTrue:[ 
        binding type: (context environment binding lookupClassSIntegerW) type.
        ^ self
    ].
    value isBoolean ifTrue:[ 
        binding type: (context environment binding lookupClassBoolean) type.
        ^ self.
    ].
    context reportTypeError: 'Unsupported constant type'.

    "Created: / 20-09-2015 / 07:13:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

acceptMessageNode: aMessageNode 
    | receiverType receiverBinding methodBinding |

    super acceptMessageNode: aMessageNode.
    receiverType := aMessageNode receiver binding type.
    receiverType isSimpleType ifTrue:[ 
        receiverBinding := context environment binding lookupClassNamed: receiverType name.
        methodBinding := receiverBinding lookupMethodNamed: aMessageNode selector.
        1 to: aMessageNode arguments size do:[:paramIdx |  
            | actualParamType formalParamType |    
            actualParamType := (aMessageNode arguments at: paramIdx) binding type.
            formalParamType := methodBinding parameterTypes at: paramIdx.
            (actualParamType isSubtypeOf: formalParamType) ifFalse:[ 
                context reportTypeError: ('Type mismatch for parameter %1 (expected %2, got %3)' bindWith: paramIdx with: formalParamType with: actualParamType).
                ^ self.
            ].
        ].
        aMessageNode binding: methodBinding.
        ^ self.
    ].
    self notYetImplemented

    "Created: / 02-09-2015 / 10:34:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 14-09-2015 / 14:22:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

acceptWhileTrueNode: node
    | receiverType booleanType |

    (node isCascaded not or: [node isFirstCascaded]) ifTrue: [
        self visitNode: node receiver
    ].
    node arguments do: [:each | self visitNode: each].

    receiverType := node receiver binding type.
    booleanType := context environment binding lookupClassBoolean type.

    receiverType = booleanType ifFalse:[ 
        context reportTypeError: 'receiver of ifTrue:ifFalse: special form must be of type tBoolean (is ' , receiverType printString.
    ].

    "Created: / 23-09-2015 / 14:06:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 23-09-2015 / 16:46:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!TTypechecker class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'
! !