SmallSenseUnionType.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Thu, 25 Jul 2013 17:27:45 +0100
changeset 40 85eaf579889b
parent 36 935fcdb63171
permissions -rw-r--r--
Support for elecring blank line after smalltelk temporaries.

"{ Package: 'jv:smallsense' }"

SmallSenseType subclass:#SmallSenseUnionType
	instanceVariableNames:'types trustfullness trustfullnessBonus'
	classVariableNames:''
	poolDictionaries:''
	category:'SmallSense-Types'
!


!SmallSenseUnionType methodsFor:'accessing'!

trustfullness
    "Return an integer value in <1..100>, higher value
     means the object is more likely of that type."

    ^ self shouldImplement
!

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

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

!SmallSenseUnionType 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:[
            (types includes: type) ifFalse:[
                types add: type.
            ]
        ]
    ].

    "Created: / 17-05-2012 / 19:27:57 / 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>"
! !

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

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

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

!SmallSenseUnionType 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 nextPut:$|]
    ]

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

!SmallSenseUnionType 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 ].

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

updateTrustfullness
    "Recompute the trustfullness, This is subject to tuning"

                    "Average if individual types"
    types isEmpty ifTrue:[
        trustfullness := 1
    ] ifFalse:[
        trustfullness := (types inject:0 into:[:a :type|a + type trustfullness]) / types size.
        trustfullness := trustfullness + (trustfullnessBonus ? 0).
    ].

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

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

!SmallSenseUnionType class methodsFor:'documentation'!

version_HG

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

version_SVN
    ^ '$Id: SmallSenseUnionType.st 8000 2012-05-17 23:16:11Z vranyj1 $'
! !