--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SmallSense__UnionType.st Wed Jan 14 08:28:46 2015 +0000
@@ -0,0 +1,306 @@
+"
+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_HG
+
+ ^ '$Changeset: <not expanded> $'
+!
+
+version_SVN
+ ^ '$Id$'
+! !
+