"
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"
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>"
"Modified: / 18-09-2013 / 01:08:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!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$'
! !