"{ Encoding: utf8 }"

"

stx:goodies/smallsense - A productivity plugin for Smalltalk/X IDE

Copyright (C) 2013-2014 Jan Vrany

This library is free software; you can redistribute it and/or

modify it under the terms of the GNU Lesser General Public

License as published by the Free Software Foundation; either

version 2.1 of the License. 

This library is distributed in the hope that it will be useful,

but WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public

License along with this library; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

"

"{ Package: 'stx:goodies/smallsense' }"

"{ NameSpace: SmallSense }"

Type subclass:#UnionType

	instanceVariableNames:'types trustfullness trustfullnessBonus'

	classVariableNames:''

	poolDictionaries:'SmallSense::SmalltalkInferencerParameters'

	category:'SmallSense-Smalltalk-Types'

!

!UnionType class methodsFor:'documentation'!

copyright

"

stx:goodies/smallsense - A productivity plugin for Smalltalk/X IDE

Copyright (C) 2013-2014 Jan Vrany

This library is free software; you can redistribute it and/or

modify it under the terms of the GNU Lesser General Public

License as published by the Free Software Foundation; either

version 2.1 of the License. 

This library is distributed in the hope that it will be useful,

but WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public

License along with this library; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

"

! !

!UnionType methodsFor:'accessing'!

trustfullness

    "Return an integer value in <1..100>, higher value

     means the object is more likely of that type."

    trustfullness isNil ifTrue:[

        self updateTrustfullness

    ].

    ^ trustfullness

    "Modified: / 18-09-2013 / 01:16:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

trustfullness: anInteger

    "Remember the bonus/malus given by an inferences"

    trustfullnessBonus := anInteger - trustfullness.

    trustfullness := anInteger min: 100.

    "Created: / 17-05-2012 / 19:43:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

trustfullnessAdd: anInteger

    trustfullnessBonus := (trustfullnessBonus ? 0) + anInteger.

    trustfullness := trustfullness + anInteger.

    "Created: / 17-05-2012 / 19:47:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

types

    ^ types ? #()

    "Modified: / 16-12-2011 / 02:01:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

types:something

    types := something.

    self updateTrustfullness

    "Modified: / 17-05-2012 / 19:23:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!UnionType methodsFor:'adding & removing'!

addType: typeOrHolder

   self basicAddType: typeOrHolder.

   self prune

    "Created: / 16-12-2011 / 01:50:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

addTypes: typeOrHolder

   self basicAddTypes: typeOrHolder.

   self prune

    "Created: / 16-12-2011 / 01:51:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!UnionType methodsFor:'adding & removing-private'!

basicAddType: typeOrHolder

    | type |

    typeOrHolder isTypeHolder ifTrue:[

        type := typeOrHolder type

    ] ifFalse:[

        type := typeOrHolder

    ].

    types isNil ifTrue:[types := OrderedCollection new].

    type isUnionType ifTrue:[

        self basicAddTypes: type types.

    ] ifFalse:[

        type isUnknownType ifFalse:[

            | existing |

            existing := types detect:[:each | each = type ] ifNone:[nil].

            existing isNil ifTrue:[

                types add: type.

            ] ifFalse:[

                existing trustfullness: (existing trustfullness max: type trustfullness)

            ]

        ]

    ].

    "Created: / 17-05-2012 / 19:27:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 18-09-2013 / 01:14:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

basicAddTypes: someTypes

    someTypes do:[:each|self basicAddType: each ].

    "Created: / 17-05-2012 / 19:28:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!UnionType methodsFor:'comparing'!

= another

    "superclass SmallSenseType says that I am responsible to implement this method"

    ^self class == another class 

        and:[types size == another types size 

            and:[types = another types]]

    "Modified: / 16-12-2011 / 13:38:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

hash

    "superclass SmallSenseType says that I am responsible to implement this method"

    ^types hash

    "Modified: / 16-12-2011 / 13:39:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!UnionType methodsFor:'enumerating'!

classesDo:aBlock

    "Enumerate all classes that this type represents"

    types notNil ifTrue:[

        types do:[:t|t classesDo: aBlock]    

    ].

    "Modified: / 16-12-2011 / 13:34:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

typesDo: aBlock

    (types ? #()) do:[:each|

        each typesDo: aBlock

    ].

    "Created: / 16-12-2011 / 02:17:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!UnionType methodsFor:'operations'!

classSide

    "superclass SmallSenseType says that I am responsible to implement this method"

    ^ self class new 

        types: (types ? #() collect:[:t|t classSide])

    "Modified: / 16-12-2011 / 13:22:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

instanceSide

    "superclass SmallSenseType says that I am responsible to implement this method"

    ^ self class new 

        types: (types ? #() collect:[:t|t instanceSide])

    "Modified: / 16-12-2011 / 13:22:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!UnionType methodsFor:'printing & storing'!

printWithoutAnglesOn:aStream

    "superclass SmallSenseType says that I am responsible to implement this method"

    types isNil ifTrue:[ 

        aStream nextPut: $?

    ] ifFalse:[

        types 

            do:[:each|each printWithoutAnglesOn:aStream]

            separatedBy:[aStream space; nextPut:$|; space.]

    ]

    "Modified: / 24-09-2013 / 13:47:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!UnionType methodsFor:'private'!

prune

    "Prune the types - remove less likely types."

    self updateTrustfullness.   

    types size < 1 ifTrue:[ ^ self ].

    "Experimental - remove those with trustfullness less than mine"    

    types := types reject:[:type|type trustfullness < trustfullness ].      

    (UnionTypeReduceThreshold notNil or:[types size > UnionTypeMaxSize]) ifTrue:[

        "/ Try to find common superclass...

        types size > (UnionTypeReduceThreshold ? 5) ifTrue:[

            | reduced |    

            reduced := types reduce:[ :a :b | ClassType new klass: (a klass commonSuperclass: b klass)].

            ((reduced klass ~~ Object) and:[reduced klass ~~ Object class]) ifTrue:[ 

                types  := OrderedCollection with: reduced. 

            ] ifFalse:[ 

                "/ If the size of types exeeds limit, make it Object anyway.

                types size > UnionTypeMaxSize ifTrue:[ 

                    types  := OrderedCollection with: reduced. 

                ].

            ].

        ].     

    ].

    "Created: / 17-05-2012 / 19:38:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 01-03-2014 / 23:28:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

updateTrustfullness

    "Recompute the trustfullness, This is subject to tuning"

    "Average if individual types"

    "/ cg: taking the average is probably incorrect...

    |sum|

    types isEmpty ifTrue: [

        trustfullness := 1.

        ^ self.

    ].

    sum := types inject: 0 into: [:a :type | a + type trustfullness ].

    trustfullness := sum / types size.

    trustfullness := trustfullness + (trustfullnessBonus ? 0).

    "Created: / 17-05-2012 / 19:22:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 18-09-2013 / 01:08:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 14-07-2017 / 13:40:48 / cg"

! !

!UnionType methodsFor:'testing'!

isUnionType

    ^true

    "Created: / 16-12-2011 / 02:01:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

isUnknownType

    "Union type is consireded unknown iff types are empty or all

     unknown"

    ^types isEmptyOrNil or:[types allSatisfy:[:t|t isUnknownType]]

    "Created: / 24-07-2013 / 13:07:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!UnionType class methodsFor:'documentation'!

version_CVS

    ^ '$Header$'

!

version_HG

    ^ '$Changeset: <not expanded> $'

!

version_SVN

    ^ '$Id$'

! !