#UI_ENHANCEMENT by cg
class: Explainer
changed: #explain:in:forClass:short:
minor hack to show some instvar types.
--- a/Explainer.st Fri Apr 29 00:45:44 2016 +0200
+++ b/Explainer.st Fri Apr 29 00:46:48 2016 +0200
@@ -586,7 +586,8 @@
Also, there could be much more detailed explanations."
|explainer variables c string explanation tmp1
- spc sym sel stringText cls clsName val valString|
+ spc sym sel stringText cls clsName val valString
+ instIndex setOfTypes toRemove toAdd|
string := someText string withoutSeparators.
string isEmpty ifTrue:[ ^ nil ].
@@ -637,9 +638,119 @@
clsName := c name.
shortText ifTrue:[
- ^ stringText , ': an instVar in ' , clsName , '.'
+ stringText := stringText , ': an instVar in ' , clsName , '.'
+ ] ifFalse:[
+ stringText := stringText , ': an instance variable inherited from ' , clsName , '.'
].
- ^ stringText , ': an instance variable inherited from ' , clsName , '.'
+ "/ look for instances
+ setOfTypes := IdentitySet new.
+ instIndex := c instVarIndexFor:string.
+ c allSubInstancesDo:[:i |
+ |varClass|
+ varClass := (i instVarAt:instIndex) class.
+ setOfTypes add:varClass.
+ ].
+ "/ TODO: look for assignments
+ c withAllSubclassesDo:[:cls |
+ cls methodDictionary do:[:m |
+ |tree code visitor|
+
+ "/ quick check
+ code := m source.
+ (code notNil and:[code includesString:string]) ifTrue:[
+ tree := Parser parse:code class:cls.
+ (tree notNil and:[tree ~~ #Error]) ifTrue:[
+ visitor := PluggableParseNodeVisitor new.
+ visitor
+ actionForNodeClass:AssignmentNode
+ put:[:node |
+ |val|
+
+ node variable name = string ifTrue:[
+ "/ only look for wellknown types on the right side.
+ node expression isConstant ifTrue:[
+ val := node expression evaluate.
+ val isArray ifTrue:[
+ setOfTypes add:Array
+ ] ifFalse:[
+ setOfTypes add:val class
+ ].
+ ] ifFalse:[
+ node expression isMessage ifTrue:[
+ ( #(+ - * /) includes:node expression selector ) ifTrue:[
+ setOfTypes add:Number
+ ] ifFalse:[
+ ( #(// size) includes:node expression selector ) ifTrue:[
+ setOfTypes add:Integer
+ ] ifFalse:[
+ ( #(copy shallowCopy) includes:node expression selector ) ifTrue:[
+ ] ifFalse:[
+ ( #(new new: basicNew basicNew:) includes:node expression selector ) ifTrue:[
+ node expression receiver isGlobal ifTrue:[
+ setOfTypes add:node expression receiver evaluate
+ ].
+ ] ifFalse:[
+self breakPoint:#cg.
+ ]
+ ]
+ ]
+ ]
+ ].
+ ].
+ ].
+ true "/ yes - visit subnodes
+ ].
+ visitor visit:tree.
+ ].
+ ]
+ ]
+ ].
+
+ "/ reduce...
+ toAdd := Set new.
+ toRemove := Set new.
+ setOfTypes do:[:type1 |
+ setOfTypes do:[:type2 |
+ |common|
+
+ type1 superclass == type2 ifTrue:[
+ toRemove add:type1.
+ ] ifFalse:[
+ type2 superclass == type1 ifTrue:[
+ toRemove add:type2.
+ ] ifFalse:[
+ common := type1 commonSuperclass:type2.
+ common ~~ Object ifTrue:[
+ toRemove add:type1.
+ toRemove add:type2.
+ toAdd add:common.
+ ].
+ ].
+ ].
+ ]
+ ].
+ setOfTypes removeAll:toRemove.
+ setOfTypes addAll:toRemove.
+ setOfTypes := setOfTypes collect:#name as:OrderedCollection.
+ setOfTypes sort.
+ setOfTypes size == 1 ifTrue:[
+ stringText := stringText,' (',setOfTypes first,')'
+ ] ifFalse:[
+ setOfTypes size == 2 ifTrue:[
+ stringText := stringText,' (',setOfTypes first,' or ',setOfTypes second,')'
+ ] ifFalse:[
+ setOfTypes size == 3 ifTrue:[
+ stringText := stringText,' (',setOfTypes first,', ',setOfTypes second,' or ',setOfTypes third,')'
+ ] ifFalse:[
+ setOfTypes size == 0 ifTrue:[
+ stringText := stringText,(' (type unknown)' bindWith:setOfTypes size)
+ ] ifFalse:[
+ stringText := stringText,(' (one of %1 types)' bindWith:setOfTypes size)
+ ].
+ ].
+ ].
+ ].
+ ^ stringText
].
string isWideString ifFalse:[