"{ Package: 'jv:smallsense' }"

SmallSenseAbstractInstvarInterfaceExtractor subclass:#SmallSenseInstvarInterfaceExtractor

	instanceVariableNames:'assingmentsDictionary assigmentsTypeDictionary'

	classVariableNames:''

	poolDictionaries:''

	category:'SmallSense-Roel Typer'

!

!SmallSenseInstvarInterfaceExtractor methodsFor:'assignmentParsing'!

addAssignment:value to:node index:index 

    |assignments|

    "Test if it is tmp or not tmp. Tmp variable returns nil"

    (node respondsTo:#variable) ifTrue:[

        "if we receive node"

        assignments := self assignmentsTo:node variable asString.

    ] ifFalse:[

        "if we receive string"

        assignments := self assignmentsTo:node asString.

    ].

    (assignments notNil) ifTrue:[

        "not tmp"

        collector addAssignment:value to:index.

    ] ifFalse:[

        "tmp"

        (node respondsTo:#variable) ifTrue:[

            "if we receive node"

            collector addAssignment:value toTmp:node variable asString.

        ] ifFalse:[

            "if we receive string"

            collector addAssignment:value toTmp:node asString.

        ].

    ].

    "Created: / 09-11-2010 / 18:32:05 / Jakub <zelenja7@fel.cvut.cz>"

    "Modified: / 15-02-2011 / 13:11:16 / Jakub <zelenja7@fel.cvut.cz>"

!

assignmentsTo:node 

    |assignments|

    assignments := collector assignmentsTo:node asString.

    (assignments isNil)ifTrue:[

      ^nil.

    ].

    ^ assignments.

    "Created: / 01-12-2010 / 15:41:40 / Jakub <zelenja7@fel.cvut.cz>"

    "Modified: / 17-03-2011 / 15:40:37 / Jakub <zelenja7@fel.cvut.cz>"

!

assignmentsToTmp:nodeIndex

    |assignments|

    assignments:=collector assignmentsTmpTo:nodeIndex.

    (assignments isNil)ifTrue:[

      ^nil.

    ].

    ^ assignments.

    "Created: / 01-12-2010 / 16:04:10 / Jakub <zelenja7@fel.cvut.cz>"

!

createIndexFromNode:node 

    "Creates index of node or string for roelTyper"

    (node respondsTo:#index) ifTrue:[

        ^ node index.

    ].

    (node respondsTo:#variable) ifTrue:[

        ^ node variable index.

    ] ifFalse:[

        ^ collector absoluteIndexForVar:node asString.

    ].

    "Created: / 14-12-2010 / 22:25:22 / Jakub <zelenja7@fel.cvut.cz>"

!

handleAssignmentToNode:nodeAssignment receiverNode:nodeReceiver 

    |assignments nodeReceiverIndex nodeAssignmentIndex|

    nodeReceiverIndex := self createIndexFromNode:nodeReceiver.

    nodeAssignmentIndex := self createIndexFromNode:nodeAssignment.

     "b:=true. a:=b.

     nodeAssignment - node which can have some type (b)

     nodeReceiver - node, which contains nodeAssignment (a) 

     nodeReceiverIndex - node receiver index

     nodeAssignmentIndex - node assignmentIndex"

    assignments := self assignmentsTo:nodeAssignment asString.

    (assignments isNil) ifTrue:[

        assignments := self assignmentsToTmp:nodeAssignment asString.

    ].

    (assignments size = 0) ifTrue:[

        assignments := nil.

    ].

     "All assgnments to specific node"

    (assignments isNil) ifTrue:[

        ^ nil

    ].

    assignments do:[:assinment | 

        self 

            addAssignment:assinment

            to:nodeReceiver

            index:nodeReceiverIndex.

    ]

    "Created: / 01-12-2010 / 15:53:05 / Jakub <zelenja7@fel.cvut.cz>"

    "Modified: / 15-02-2011 / 13:14:38 / Jakub <zelenja7@fel.cvut.cz>"

!

handleAssignmentToNode:node type:type 

    |set|

    (node respondsTo:#variable)ifTrue:[

    set := assingmentsDictionary at:node variable asString ifAbsent:nil.

    ]ifFalse:[

        set := assingmentsDictionary at:node asString ifAbsent:nil.

     ].

     "if some variable(a) is initialized(a:=2,a:=true...) then the other variables, which refers b:=a can have similar type."

    (set isNil) ifTrue:[

        ^ nil.

    ].

    set do:[:refNode | 

        self 

            addAssignment:type

            to:node

            index:(self createIndexFromNode:refNode).

    ]

    "Created: / 04-11-2010 / 19:44:46 / Jakub <zelenja7@fel.cvut.cz>"

    "Modified: / 14-12-2010 / 22:29:35 / Jakub <zelenja7@fel.cvut.cz>"

!

parseAssignmentNodeBinaryNode:node nodeExpression:expression 

    |helperNode|

    "v=3"

    helperNode := node.

    ((expression receiver) isKindOf:VariableNode) ifTrue:[

        ((expression selector) = #'=' 

            or:[

                (expression selector) = #'==' 

                    or:[

                        (expression selector) = #'>' 

                            or:[

                                (expression selector) = #'<' 

                                    or:[

                                        (expression selector) = #'<=' 

                                            or:[

                                                (expression selector) = #'>=' 

                                                    or:[ (expression selector) = #'=~' or:[ (expression selector) = #'~~' ] ]

                                            ]

                                    ]

                            ]

                    ]

            ]) 

                ifTrue:[

                    self 

                        addAssignment:(#Boolean sunitAsClass)

                        to:(node)

                        index:(self createIndexFromNode:node).

                    self handleAssignmentToNode:node type:(#Boolean sunitAsClass)

                ].

    ].

    ((expression receiver) isKindOf:MessageNode) ifTrue:[

        self parseAssignmentNodeMessageNode:node

            nodeExpression:expression receiver

    ].

    "Created: / 10-11-2010 / 14:51:11 / Jakub <zelenja7@fel.cvut.cz>"

    "Modified: / 31-03-2011 / 19:30:36 / Jakub <zelenja7@fel.cvut.cz>"

!

parseAssignmentNodeConstantNode:node nodeExpression: expression 

    |helperNode |

    helperNode := node.

    (expression isKindOf:ConstantNode) ifTrue:[

        "Check if expression has some type"

        (expression type notNil and:[expression type sunitAsClass notNil]) ifTrue:[

            "If True or false then superClass(only for to have the type boolean)"

            ((expression type sunitAsClass superclass) == Boolean) ifTrue:[

                self 

                    addAssignment:((expression type sunitAsClass) superclass)

                    to:(node)

                    index:(self createIndexFromNode:node).

                "add assignment to all nodes which refer this node"

                self handleAssignmentToNode:node

                    type:(expression type sunitAsClass superclass)

            ] ifFalse:[

                self 

                    addAssignment:(expression type sunitAsClass)

                    to:node

                    index:(self createIndexFromNode:node ).

                "add assignment to all nodes which refer this node"

                self handleAssignmentToNode:node type:(expression type sunitAsClass)

            ].

        ].

        ^ self.

    ].

    "Created: / 10-11-2010 / 14:53:09 / Jakub <zelenja7@fel.cvut.cz>"

    "Modified: / 14-12-2010 / 22:30:38 / Jakub <zelenja7@fel.cvut.cz>"

    "Modified: / 28-04-2011 / 23:10:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseAssignmentNodeMessageNode:node nodeExpression:expression 

    |helperNode|

    helperNode := node.

    (expression respondsTo:#receiver) ifTrue:[

        ((expression receiver) isKindOf:VariableNode) ifTrue:[

            ((expression receiver name) respondsTo:#sunitAsClass) ifTrue:[

                self 

                    addAssignment:(expression receiver name sunitAsClass)

                    to:(node)

                    index:(self createIndexFromNode:node).

            ]ifFalse:[

                self parseAssignmentNodeVariableNode:node nodeExpression: expression receiver.    

            ].

        ].

        ((expression receiver) isKindOf:ConstantNode) ifTrue:[

            self parseAssignmentNodeConstantNode:node

                nodeExpression:expression receiver.

        ].

        ((expression receiver) isKindOf:SelfNode) ifTrue:[

            self parseAssignmentNodeSelfNode:node

                nodeExpression:expression receiver.

        ].

    ].

    "Created: / 10-11-2010 / 14:55:13 / Jakub <zelenja7@fel.cvut.cz>"

    "Modified: / 14-12-2010 / 22:31:00 / Jakub <zelenja7@fel.cvut.cz>"

!

parseAssignmentNodeSelfNode:node nodeExpression:expression 

    |helperNode var ret|

    "indirect assignments check"

    helperNode := node.

    var := helperNode expression selector asString subString:1

                to:helperNode expression selector asString size - 1.

     "Check if selector is class Variable"

    ret := collector assignmentsTo:var.

    (ret notNil) ifTrue:[

        "Check if has only one argument"

        (helperNode expression argumentCount = 1) ifTrue:[

            "Check nil"

            (helperNode expression arg1 notNil) ifTrue:[

                "Test ConstantNode(u:=3 u:=true...)"

                (helperNode expression arg1 isKindOf:ConstantNode) ifTrue:[

                    self parseAssignmentNodeConstantNode:var

                        nodeExpression:helperNode expression arg1.

                ].

                 "Test VariableNode (u:=a)"

                (helperNode expression arg1 isKindOf:VariableNode) ifTrue:[

                    self parseAssignmentNodeVariableNode:var

                        nodeExpression:helperNode expression arg1.

                ].

                 "Test UnaryNode"

                (helperNode expression arg1 isKindOf:UnaryNode) ifTrue:[

                    self parseAssignmentNodeUnaryNode:var

                        nodeExpression:helperNode expression arg1.

                ].

                 "Test MessageNode"

                (helperNode expression arg1 isKindOf:MessageNode) ifTrue:[

                    self parseAssignmentNodeMessageNode:var

                        nodeExpression:helperNode expression arg1.

                ].

                 "Test binary node"

                (helperNode expression arg1 isKindOf:BinaryNode) ifTrue:[

                    self parseAssignmentNodeBinaryNode:var

                        nodeExpression:helperNode expression arg1.

                ].

            ].

        ].

    ].

    "Created: / 14-12-2010 / 22:04:07 / Jakub <zelenja7@fel.cvut.cz>"

!

parseAssignmentNodeToTypeCollector:node 

    |helperNode expression nodeName|

    "basic method to handle assignments"

    helperNode := node.

    expression := node expression.

     "Test ConstantNode(u:=3 u:=true...)"

    (expression isKindOf:ConstantNode) ifTrue:[

        self parseAssignmentNodeConstantNode:node nodeExpression:expression.

    ].

     "Test VariableNode (u:=a)"

    (expression isKindOf:VariableNode) ifTrue:[

        self parseAssignmentNodeVariableNode:node nodeExpression:expression.

    ].

     "Test AssignmentNode u:=a:=3"

    (expression isKindOf:AssignmentNode) ifTrue:[

        nodeName := self parseAssignmentNodeToTypeCollector:expression.

        self handleAssignmentToNode:nodeName receiverNode:node.

    ].

     "Test UnaryNode"

    (expression isKindOf:UnaryNode) ifTrue:[

        self parseAssignmentNodeUnaryNode:node nodeExpression:expression.

    ].

     "Test MessageNode"

    (expression isKindOf:MessageNode) ifTrue:[

        self parseAssignmentNodeMessageNode:node nodeExpression:expression.

    ].

     "Test binary node"

    (expression isKindOf:BinaryNode) ifTrue:[

        self parseAssignmentNodeBinaryNode:node nodeExpression:expression.

    ].

    (node respondsTo:#variable) ifTrue:[

        ^ node variable.

    ] ifFalse:[ ^ node. ].

    "Created: / 03-11-2010 / 23:00:17 / Jakub <zelenja7@fel.cvut.cz>"

    "Modified: / 14-12-2010 / 23:45:30 / Jakub <zelenja7@fel.cvut.cz>"

!

parseAssignmentNodeUnaryNode:node nodeExpression:expression 

    |helperNode|

    helperNode := node.

    "x asInteger. b floor"

    (expression respondsTo:#receiver) ifTrue:[

        ((expression receiver) isKindOf:VariableNode) ifTrue:[

            ((expression receiver name) respondsTo:#sunitAsClass) ifTrue:[ 

                self 

                    addAssignment:(expression receiver name sunitAsClass)

                    to:(node)

                    index:(self createIndexFromNode:node).

            "add assignment to all nodes which refer this node"

                self handleAssignmentToNode:node

                    type:(expression receiver name sunitAsClass)

            ].

        ].

    ].

    "Created: / 10-11-2010 / 14:54:26 / Jakub <zelenja7@fel.cvut.cz>"

    "Modified: / 30-03-2011 / 17:57:04 / Jakub <zelenja7@fel.cvut.cz>"

!

parseAssignmentNodeVariableNode:node nodeExpression:expression 

    |helperNode set|

    "Test VariableNode(u:=a.b:=a.c:=a)

     AssignMentDictionary will contain set nodes which assignment this node

       a->Set(u,b,c) if a will get some value we change assignment in all nodes"

    helperNode := node.

    ((expression type) = #GlobalVariable) ifTrue:[

        "checking assignments metaclass"

        ((expression name) respondsTo:#sunitAsClass) ifTrue:[

            self 

                addAssignment:expression name sunitAsClass class

                to:node variable

                index:(self createIndexFromNode:node).

             "add assignment to all nodes which refer this node"

            self handleAssignmentToNode:node type:(expression type sunitAsClass).

            ^ self.

        ].

    ].

    set := assingmentsDictionary at:(expression name) ifAbsent:nil.

    (set isNil) ifTrue:[

        set := Set new.

    ].

    set add:node variable.

     "Check if this index exists. if exists then remove it(to update dictionary)"

    (assingmentsDictionary includesKey:expression name) ifTrue:[

        assingmentsDictionary removeKey:expression name.

    ].

     "(updateDictionary"

    assingmentsDictionary at:(expression name) put:set.

     "Check if we can update this"

    self handleAssignmentToNode:expression receiverNode:node.

    ^ self

    "Created: / 10-11-2010 / 14:53:46 / Jakub <zelenja7@fel.cvut.cz>"

    "Modified: / 30-03-2011 / 18:09:05 / Jakub <zelenja7@fel.cvut.cz>"

! !

!SmallSenseInstvarInterfaceExtractor methodsFor:'extracting'!

extractInterfacesFrom:m addTo:aTypeCollector 

    |parser|

    method := m.

    saveStacks := Dictionary new.

    stack := OrderedCollection new.

     "0 to: method numTemps - 1 do: [:i | stack add: #temp -> i ]."

    initialStack := stack copy.

    collector := aTypeCollector.

    parser := SmalltalkXInstvarInterfaceExtractor new.

    parser setColector:aTypeCollector.

    input := parser 

                parseMethod:method source

                in:method mclass

                ignoreErrors:false

                ignoreWarnings:false.

    blockTraversal := false.

    blockArgs := 0.

    [ input isNil ] whileFalse:[

        self unaryExpressionFor:input.

        input :=input nextStatement.

    ]

    "Modified: / 24-11-2010 / 22:24:16 / Jakub <zelenja7@fel.cvut.cz>"

!

extractInterfacesFrom:sourc class:class addTo:aTypeCollector 

    |parser|

    saveStacks := Dictionary new.

    stack := OrderedCollection new.

     "0 to: method numTemps - 1 do: [:i | stack add: #temp -> i ]."

    initialStack := stack copy.

    collector := aTypeCollector.

    parser := SmallSenseInstvarInterfaceExtractor new.

    parser setColector:aTypeCollector.

    input := parser 

                parseMethod: sourc

                in:class

                ignoreErrors:false

                ignoreWarnings:false.

    blockTraversal := false.

    blockArgs := 0.

    [ input isNil ] whileFalse:[

        self unaryExpressionFor:input.

        input :=input nextStatement.

    ]

    "Created: / 17-03-2011 / 16:00:31 / Jakub <zelenja7@fel.cvut.cz>"

    "Modified: / 04-04-2011 / 22:31:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!SmallSenseInstvarInterfaceExtractor methodsFor:'initialization'!

initialize

    super initialize.

    assingmentsDictionary := Dictionary new.

    assigmentsTypeDictionary:=Dictionary new.

    "Created: / 04-11-2010 / 19:09:04 / Jakub <zelenja7@fel.cvut.cz>"

    "Modified: / 04-11-2010 / 23:46:36 / Jakub <zelenja7@fel.cvut.cz>"

! !

!SmallSenseInstvarInterfaceExtractor methodsFor:'opcodes-control'!

nativeSend: selector numArgs: na 

        | receiver args |

        args := stack removeLast: na.

        receiver := stack removeLast.

        receiver isInteger 

                ifTrue: 

                        [ collector 

                                addSend: selector

                                to: receiver ]

                ifFalse: 

                        [ receiver isVariableBinding ifTrue: 

                                [ receiver key = #temp 

                                        ifTrue: 

                                                [ collector 

                                                        addSend: selector

                                                        toTmp: receiver value ]

                                        ifFalse: 

                                                [ receiver key = #return ifTrue: 

                                                        [ collector 

                                                                addSend: selector

                                                                onReturnOfSelfMethod: receiver value ] ] ] ].

        (receiver = #self and: [ collector theClass methodDictionary includesKey: selector ]) ifTrue: 

                [ args doWithIndex: 

                        [ :arg :index | 

                        collector 

                                handleAssignment: arg

                                forTmp: index - 1

                                in: collector theClass >> selector ] ].

        stack add: (collector 

                        pushSendOf: selector

                        to: receiver

                        args: args)

    "Modified: / 18-05-2011 / 23:47:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

send: selector numArgs: na 

	^self 

		nativeSend: selector

		numArgs: na

! !

!SmallSenseInstvarInterfaceExtractor methodsFor:'opcodes-data movement'!

dupFirst

	stack add: stack last

!

pop

	stack removeLast

!

pushConstant: value

	value class == BlockClosure

		ifTrue:

			[self

				readBlock: value method

				copied: 0]

		ifFalse: [

			blockArgs := value.

			stack addLast: value class]

!

pushContext

	stack add: #context

!

pushInst: index

	stack add: index

!

pushReceiver

	stack addLast: #self

!

pushStatic: assoc

	"assoc can be an association OR a variable binding. I just push the complete association, since it does not interest me for the moment."