#UI_ENHANCEMENT by cg expecco_2_9_0 expecco_2_9_0_win75_lx36 expecco_2_9_1
authorClaus Gittinger <cg@exept.de>
Fri, 29 Apr 2016 00:46:48 +0200
changeset 3795 dbb46a901a8e
parent 3794 ea706f2a101f
child 3796 c6ed7e9ad56a
child 3797 07a509cecbaf
#UI_ENHANCEMENT by cg class: Explainer changed: #explain:in:forClass:short: minor hack to show some instvar types.
Explainer.st
--- 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:[