--- a/Explainer.st Wed May 04 23:04:58 2016 +0200
+++ b/Explainer.st Fri May 06 04:56:29 2016 +0200
@@ -56,10 +56,11 @@
!Explainer class methodsFor:'explaining'!
explainLiteralNode:node in:code forClass:cls short:short interval:intervalIfKnown
- |expl literalValue findInnerMost elementIndex codeOfCharacterBeforeCursor|
+ |expl literalValue literalsClass findInnerMost elementIndex codeOfCharacterBeforeCursor|
literalValue := node value.
- expl := literalValue class name "allBold" , '-constant'.
+ literalsClass := literalValue class.
+ expl := (self asClassLink:literalsClass name "allBold") , '-constant'.
(literalValue isInteger) ifTrue:[
(literalValue ~~ 0 and:[literalValue ~~ 1]) ifTrue:[
@@ -151,7 +152,7 @@
bestMatches hint|
selector := node buildSelectorString.
- selectorString := selector printString contractTo:30.
+ selectorString := selector printString contractTo:50.
selector := selector asSymbolIfInterned. "/ avoid creating new symbols.
selector isNil ifTrue:[
^ '%1 is NOWHERE impemented.' bindWith:boldSelectorString
@@ -258,10 +259,10 @@
clsName := implClass name.
clsName := clsName actionForAll:(self actionToBrowseClass:implClass selector:selector).
info := '%1 >> %2' bindWith:clsName "allBold" with:selectorString.
- (srchClass isNil and:[(cls includesBehavior:implClass) not]) ifTrue:[
- "/ info := 'guess: ', info.
- info := info , ' (guess)'.
- ].
+"/ (srchClass isNil and:[(cls includesBehavior:implClass) not]) ifTrue:[
+"/ "/ info := 'guess: ', info.
+"/ info := info , ' (guess)'.
+"/ ].
] ifFalse:[
info := Explainer explainSelector:selector inClass:cls short:short.
].
@@ -307,7 +308,7 @@
selector := node selector.
selector := selector asSymbolIfInterned. "/ avoid creating new symbols.
- selectorString := selector printString contractTo:30.
+ selectorString := selector printString contractTo:50.
boldSelectorString := selectorString "allBold".
(srchClass := cls superclass) notNil ifTrue:[
@@ -425,7 +426,7 @@
!
explainVariableNode:node in:code forClass:cls short:short interval:intervalIfKnown
- |expl nm nmBold definingNode namePart|
+ |expl nm nmBold definingNode namePart argNode argClass argClassSet|
nm := node name.
@@ -439,8 +440,14 @@
definingNode notNil ifTrue:[
namePart := '''' , nmBold , ''''.
definingNode isMethod ifTrue:[
- (definingNode arguments contains:[:arg | arg name = nm]) ifTrue:[
- expl := namePart , ' is a method argument.'
+ argNode := definingNode arguments detect:[:arg | arg name = nm] ifNone:nil.
+ argNode notNil ifTrue:[
+ expl := namePart , ' is a method argument.'.
+
+ argClassSet := self guessPossibleImplementorClassesFor:argNode in:code forClass:cls.
+ argClassSet size == 1 ifTrue:[
+ argClass := argClassSet first.
+ ].
].
].
expl isNil ifTrue:[
@@ -647,7 +654,7 @@
c isMeta ifTrue:[
clsName := c theNonMetaclass name.
shortText ifTrue:[
- clsName := (clsName actionForAll:(self actionToBrowseClass:c selector:nil)).
+ clsName := (clsName actionForAll:(self actionToBrowseClass:c)).
stringText := stringText , ': a class instVar in ' , clsName
] ifFalse:[
stringText := stringText, ': a class instance variable inherited from ' , clsName
@@ -665,7 +672,7 @@
c notNil ifTrue:[
clsName := c name.
shortText ifTrue:[
- clsName := (clsName actionForAll:(self actionToBrowseClass:c selector:nil)).
+ clsName := (clsName actionForAll:(self actionToBrowseClass:c)).
stringText := stringText , ': a classVar in ' , clsName
] ifFalse:[
stringText := stringText , ': a class variable in ' , clsName
@@ -681,7 +688,7 @@
c privateClasses do:[:pClass |
(pClass name = string
or:[pClass nameWithoutPrefix = string]) ifTrue:[
- stringText := (stringText actionForAll:(self actionToBrowseClass:pClass selector:nil)).
+ stringText := (stringText actionForAll:(self actionToBrowseClass:pClass)).
stringText := stringText , ': a private class in ''' , c name , '''.'.
shortText ifFalse:[
stringText := (stringText , '\\It is only visible locally.') withCRs
@@ -702,7 +709,7 @@
].
(sharedPool includesKey:sharedPoolSym) ifTrue:[
poolName := sharedPool name.
- poolName := (poolName actionForAll:(self actionToBrowseClass:sharedPool selector:nil)).
+ poolName := (poolName actionForAll:(self actionToBrowseClass:sharedPool)).
stringText := stringText , ': a pool variable in ',poolName.
val := sharedPool at:sharedPoolSym.
valString := self valueStringFor:val.
@@ -717,7 +724,7 @@
sym := (spc name , '::' , string) asSymbolIfInterned.
sym notNil ifTrue:[
(cls := Smalltalk at:sym) isBehavior ifTrue:[
- stringText := (stringText actionForAll:(self actionToBrowseClass:cls selector:nil)).
+ stringText := (stringText actionForAll:(self actionToBrowseClass:cls)).
string := stringText , ': '.
cls name = sym ifFalse:[
string := string , 'refers to ',cls name,', '
@@ -1134,15 +1141,19 @@
tmp := ' is a selector implemented in '.
].
s := "'#' ," string allBold.
- s := s actionForAll:(self actionToBrowseImplementorsOf:selector).
+ listOfImplementingClassNames size > 1 ifTrue:[
+ s := s actionForAll:(self actionToOpenMethodFinderFor:selector).
+ ] ifFalse:[
+ s := s actionForAll:(self actionToBrowseImplementorsOf:selector).
+ ].
shortText ifTrue:[
|typesDescription|
msg := s , tmp.
- typesDescription := (self typeDescriptionFor:listOfImplementingClasses andSelector:selector).
+ typesDescription := self typeDescriptionFor:listOfImplementingClasses andSelector:selector wordBetween:'and'.
typesDescription notNil ifTrue:[
- msg := msg,' (',typesDescription,')'
+ msg := msg,typesDescription
].
] ifFalse:[
(count == 1) ifTrue:[
@@ -1402,7 +1413,7 @@
superName := aClass superclass name.
shortText ifTrue:[
- ^ '"super" - message lookup starts in superclass "%1" (call redefined method).' bindWith:superName
+ ^ '"super" - message lookup starts in superclass "%1" (call redefined method).' bindWith:(self asClassLink:superName)
].
^ 'like "self", "','super'allBold,'" refers to the object which received the message.
@@ -1422,11 +1433,15 @@
!
explainSyntax:string short:shortText
- "try syntax ...; return explanation or nil"
+ "try syntax ...; return explanation or nil.
+ This is meant for beginners..."
((string = ':=') or:[string = '_']) ifTrue:[
shortText ifTrue:[
- ^ '":=" - assign to variable on the left (syntax)'.
+ string = '_' ifTrue:[
+ ^ '"_" - old style for assignment. Consider changing to ":=".'
+ ].
+ ^ '":=" - assign to variable on the left (syntax).'.
].
^ '<variable> := <expression>
@@ -1471,7 +1486,7 @@
(string startsWith:'$' ) ifTrue:[
shortText ifTrue:[
- ^ '"$x" - character literal (syntax)'.
+ ^ '"$x" - ',(self asClassLink:'Character'),' literal (syntax)'.
].
^ 'is a Character literal constant.
@@ -1484,7 +1499,7 @@
(string startsWith:'#' ) ifTrue:[
(string startsWith:'#(' ) ifTrue:[
shortText ifTrue:[
- ^ '"#(..)" - array literal (syntax)'.
+ ^ '"#(..)" - ',(self asClassLink:'Array'),' literal (syntax)'.
].
^ 'is a constant Array (literal).
@@ -1498,7 +1513,7 @@
(string startsWith:'#[') ifTrue:[
shortText ifTrue:[
- ^ '"#[..]" - byteArray literal (syntax)'.
+ ^ '"#[..]" - ',(self asClassLink:'ByteArray'),' literal (syntax)'.
].
^ 'is a constant ByteArray (literal).
@@ -1509,7 +1524,7 @@
(string startsWith:'#''') ifTrue:[
shortText ifTrue:[
- ^ '"#''..''" - symbol literal (syntax)'.
+ ^ '"#''..''" - ',(self asClassLink:'Symbol'),' literal (syntax)'.
].
^ 'is a constant symbol containing non-alphanumeric characters.
@@ -1520,7 +1535,7 @@
].
shortText ifTrue:[
- ^ '"#.." - symbol literal (syntax)'.
+ ^ '"#.." - ',(self asClassLink:'Symbol'),' literal (syntax)'.
].
^ 'is a constant symbol.
@@ -1541,7 +1556,7 @@
((string startsWith:'[') or:[string endsWith:']']) ifTrue:[
shortText ifTrue:[
- ^ '"[..]" - a block (aka lambda/closure for experts)'.
+ ^ '"[..]" - a ',(self asClassLink:'Block'),' (aka lambda/closure for experts)'.
].
^ '[:arg1 .. :argN | statements]
@@ -1557,7 +1572,7 @@
((string startsWith:'{') or:[string endsWith:'}']) ifTrue:[
shortText ifTrue:[
- ^ '"{..}" array instantiation (syntax)'.
+ ^ '"{..}" ',(self asClassLink:'Array'),' instantiation (syntax)'.
].
^ '{ <expr1>. .. <exprN> }
@@ -1661,6 +1676,12 @@
typeDescriptionFor:setOfTypes andSelector:selectorOrNil
"up to 3 types are shown by name; more are simply counted"
+ ^ self typeDescriptionFor:setOfTypes andSelector:selectorOrNil wordBetween:'or'
+!
+
+typeDescriptionFor:setOfTypes andSelector:selectorOrNil wordBetween:wordbetween
+ "up to 3 types are shown by name; more are simply counted"
+
|types numTypes
type1 type2 type3
nm1 nm2 nm3|
@@ -1679,15 +1700,16 @@
numTypes == 1 ifTrue:[
^ nm1
].
+
type2 := types second.
nm2 := type2 name actionForAll:(self actionToBrowseClass:type2 selector:selectorOrNil).
numTypes == 2 ifTrue:[
- ^ nm1,' or ',nm2
+ ^ nm1,' ',wordbetween,' ',nm2
].
type3 := types third.
nm3 := type3 name actionForAll:(self actionToBrowseClass:type3 selector:selectorOrNil).
numTypes == 3 ifTrue:[
- ^ nm1,', ',nm2,' or ',nm3
+ ^ nm1,', ',nm2,' ',wordbetween,' ',nm3
].
^ ('one of %1 classes' bindWith:numTypes) actionForAll:(self actionToBrowseClasses:types).
!
@@ -1729,7 +1751,11 @@
!Explainer class methodsFor:'naive type inferer'!
addTypeOfExpressionNode:expr forAssignmentTo:varName to:setOfTypes
- |val valClass msgSelector msgReceiver|
+ "pick up low hanging type information.
+ This is far from being complete, but often gives a hint good enough for code completion
+ and info in the browser."
+
+ |val valClass|
"/ only look for wellknown types on the right side.
expr isLiteral ifTrue:[
@@ -1743,78 +1769,96 @@
].
expr isMessage ifTrue:[
- msgSelector := expr selector.
- msgReceiver := expr receiver.
-
- msgSelector == #? ifTrue:[
- self addTypeOfExpressionNode:(expr arg1) forAssignmentTo:varName to:setOfTypes.
- ^ setOfTypes
- ].
- "/ really really only low hanging fruit...
- "/ ignore / here, because of filename
- ( #(+ - *) includes:msgSelector ) ifTrue:[
- "/ ignore foo := foo OP expr
- "/ ignore foo := expr OP foo
- (msgReceiver isVariable and:[msgReceiver name = varName]) ifFalse:[
- (expr arg1 isVariable and:[expr arg1 name = varName]) ifFalse:[
- self rememberType:Number in:setOfTypes.
- ]
- ].
- ^ setOfTypes.
- ].
-
- ( #(// size hash identityHash) includes:msgSelector ) ifTrue:[
- self rememberType:Integer in:setOfTypes.
- ^ setOfTypes.
- ].
- ( #(next next:) includes:msgSelector ) ifTrue:[
- |rcvrTypes|
-
- rcvrTypes := self addTypeOfExpressionNode:msgReceiver forAssignmentTo:nil to:Set new.
- rcvrTypes notEmpty ifTrue:[
-self halt.
- self rememberType:Character in:setOfTypes.
- ].
- ^ setOfTypes.
- ].
- ( msgSelector startsWith:'as') ifTrue:[
- valClass := Smalltalk classNamed:(msgSelector copyFrom:3).
- valClass notNil ifTrue:[
- self rememberType:valClass in:setOfTypes.
- ^ setOfTypes.
- ].
- ].
- ( #(copy shallowCopy) includes:msgSelector ) ifTrue:[
- msgReceiver isLiteral ifTrue:[
- self addTypeOfExpressionNode:msgReceiver forAssignmentTo:varName to:setOfTypes.
- ].
- ^ setOfTypes
- ].
-
- msgReceiver isGlobal ifTrue:[
- |globalValue|
-
- globalValue := msgReceiver value.
- globalValue isBehavior ifTrue:[
- ( #(new new: basicNew basicNew:) includes:msgSelector ) ifTrue:[
- self rememberType:globalValue in:setOfTypes.
- ^ setOfTypes.
- ].
- ].
-self breakPoint:#cg.
- ] ifFalse:[
-self breakPoint:#cg.
- ]
+ self addTypeOfMessageNode:expr forAssignmentTo:varName to:setOfTypes.
+ ^ setOfTypes.
].
+
^ setOfTypes
"Created: / 30-04-2016 / 15:28:59 / cg"
"Modified: / 30-04-2016 / 20:17:35 / cg"
!
+addTypeOfMessageNode:expr forAssignmentTo:varName to:setOfTypes
+ "pick up low hanging type information.
+ This is far from being complete, but often gives a hint good enough for code completion
+ and info in the browser."
+
+ |valClass msgSelector msgReceiver|
+
+ msgSelector := expr selector.
+ msgReceiver := expr receiver.
+
+ msgSelector == #? ifTrue:[
+ self addTypeOfExpressionNode:(expr arg1) forAssignmentTo:varName to:setOfTypes.
+ ^ setOfTypes
+ ].
+
+ "/ really really only very low hanging fruit...
+ "/ ignore #/ here, because of filename
+ ( #(+ - *) includes:msgSelector ) ifTrue:[
+ "/ ignore foo := foo OP expr
+ "/ ignore foo := expr OP foo
+ (msgReceiver isVariable and:[msgReceiver name = varName]) ifFalse:[
+ (expr arg1 isVariable and:[expr arg1 name = varName]) ifFalse:[
+ self rememberType:Number in:setOfTypes.
+ ]
+ ].
+ ^ setOfTypes.
+ ].
+
+ ( #(// size hash identityHash) includes:msgSelector ) ifTrue:[
+ self rememberType:Integer in:setOfTypes.
+ ^ setOfTypes.
+ ].
+
+ ( #(next next:) includes:msgSelector ) ifTrue:[
+ |rcvrTypes|
+
+ rcvrTypes := self addTypeOfExpressionNode:msgReceiver forAssignmentTo:nil to:Set new.
+ rcvrTypes notEmpty ifTrue:[
+self halt.
+ self rememberType:Character in:setOfTypes.
+ ].
+ ^ setOfTypes.
+ ].
+
+ ( msgSelector startsWith:'as') ifTrue:[
+ valClass := Smalltalk classNamed:(msgSelector copyFrom:3).
+ valClass notNil ifTrue:[
+ self rememberType:valClass in:setOfTypes.
+ ^ setOfTypes.
+ ].
+ ].
+
+ ( #(copy shallowCopy) includes:msgSelector ) ifTrue:[
+ msgReceiver isLiteral ifTrue:[
+ self addTypeOfExpressionNode:msgReceiver forAssignmentTo:varName to:setOfTypes.
+ ].
+ ^ setOfTypes
+ ].
+
+ msgReceiver isGlobal ifTrue:[
+ |globalValue|
+
+ globalValue := msgReceiver value.
+ globalValue isBehavior ifTrue:[
+ ( #(new new: basicNew basicNew:) includes:msgSelector ) ifTrue:[
+ self rememberType:globalValue in:setOfTypes.
+ ^ setOfTypes.
+ ].
+ ].
+ self breakPoint:#cg.
+ ^ setOfTypes
+ ].
+
+self breakPoint:#cg.
+ ^ setOfTypes
+!
+
addTypesAssignedToInstvar:instVarName inClass:aClass method:aMethod to:setOfTypes
"look to asssignments to an instance variable, and pick up low hanging class information.
- This is far from being complete, but gives a hint good enough for code completion
+ This is far from being complete, but often gives a hint good enough for code completion
and info in the browser."
| code |
@@ -1829,7 +1873,7 @@
addTypesAssignedToInstvar:instVarName inClass:aClass source:code to:setOfTypes
"look to asssignments to an instance variable, and pick up low hanging class information.
- This is far from being complete, but gives a hint good enough for code completion
+ This is far from being complete, but often gives a hint good enough for code completion
and info in the browser."
|tree|
@@ -1847,7 +1891,7 @@
addTypesAssignedToInstvar:instVarName inClass:aClass to:setOfTypes
"look to asssignments to an instance variable, and pick up low hanging class information.
- This is far from being complete, but gives a hint good enough for code completion
+ This is far from being complete, but often gives a hint good enough for code completion
and info in the browser."
aClass methodDictionary do:[:m |
@@ -1859,7 +1903,7 @@
addTypesAssignedToInstvar:instVarName inTree:tree to:setOfTypes
"look to asssignments to an instance variable, and pick up low hanging class information.
- This is far from being complete, but gives a hint good enough for code completion
+ This is far from being complete, but often gives a hint good enough for code completion
and info in the browser."
|visitor|
@@ -1881,8 +1925,8 @@
!
addTypesAssignedToLocal:localName inTree:tree to:setOfTypes
- "look to asssignments to an instance variable, and pick up low hanging class information.
- This is far from being complete, but gives a hint good enough for code completion
+ "look to asssignments to a local variable, and pick up low hanging class information.
+ This is far from being complete, but often gives a hint good enough for code completion
and info in the browser."
|visitor|
@@ -1995,6 +2039,10 @@
!Explainer class methodsFor:'utilities'!
+actionToBrowseClass:class
+ ^ self actionToBrowseClass:class selector:nil.
+!
+
actionToBrowseClass:class selector:selectorOrNil
selectorOrNil isNil ifTrue:[
^ [Tools::NewSystemBrowser openInClass:class]
@@ -2008,11 +2056,103 @@
!
actionToBrowseImplementorsOf:selector
+ ^ [UserPreferences systemBrowserClass browseImplementorsOf:selector]
+!
+
+actionToBrowseMethod:mthd
+ ^ self actionToBrowseClass:(mthd mclass) selector:(mthd selector).
+!
+
+actionToOpenMethodFinderFor:selector
MethodFinderWindow notNil ifTrue:[
^ [MethodFinderWindow openOnSelectorPattern:selector].
].
+ ^ self actionToBrowseImplementorsOf:selector
+!
+
+asClassLink:nameOfClass
+ "return text with a hyperlink to browse a class by that name"
- ^ [UserPreferences systemBrowserClass browseImplementorsOf:selector]
+ |cls|
+
+ cls := Smalltalk classNamed:nameOfClass string asUppercaseFirst.
+ cls isNil ifTrue:[^ nameOfClass].
+
+ ^ nameOfClass actionForAll:(self actionToBrowseClass:cls)
+!
+
+infoStringForMethods:aCollectionOfMethods withPrefix:prefix
+ "get a nice user readable list for some methods.
+ Up to 3 are named, otherwise the count is presented.
+ The prefix can be sth like ' other', ' sender', ' implementor',
+ Or it can be an empty string.
+ Result is meant to be shown in the info line at the bottom of a browser."
+
+ |nMethodNames sortedByName methodNames|
+
+ aCollectionOfMethods isEmpty ifTrue:[
+ ^ 'No %1' bindWith:prefix.
+ ].
+
+ methodNames := aCollectionOfMethods asOrderedCollection
+ collect:[:each | each whoString].
+
+ nMethodNames := methodNames size.
+
+ nMethodNames <= 3 ifTrue:[
+ nMethodNames == 1 ifTrue:[
+ ^ '%2' "'1 %1class: %2'" bindWith:prefix with:(methodNames first allBold).
+ ].
+ sortedByName := methodNames sort.
+ nMethodNames == 2 ifTrue:[
+ ^ '%2 and %3' "'2 %1classes: %2 and %3'" bindWith:prefix
+ with:(sortedByName first allBold)
+ with:(sortedByName second allBold).
+ ].
+ nMethodNames == 3 ifTrue:[
+ ^ '%2, %3 and %4' "'3 %1classes: %2, %3 and %4'" bindWith:prefix
+ with:(sortedByName first allBold)
+ with:(sortedByName second allBold)
+ with:(sortedByName third allBold).
+ ].
+ nMethodNames == 4 ifTrue:[
+ ^ '%2, %3, %4 and %5' "'4 %1classes: %2, %3, %4 and %5'" bindWith:prefix
+ with:(sortedByName first allBold)
+ with:(sortedByName second allBold)
+ with:(sortedByName third allBold)
+ with:(sortedByName fourth allBold).
+ ].
+ ].
+ ^ '%1 %2methods' bindWith:nMethodNames printString allBold with:prefix.
+
+ "
+ Time millisecondsToRun:[
+ self infoStringForMethods:(SystemBrowser allCallsOn:#'at:put:') withPrefix:''
+ ].
+ Time millisecondsToRun:[
+ self infoStringForMethods:(SystemBrowser allCallsOn:#'actionToBrowseClasses:') withPrefix:''
+ ].
+ "
+!
+
+methodSendersInfoFor:selector inEnvironment:environment
+ "get something about the senders of a message.
+ to be shown in the info line at the bottom.
+ This may be slow; so think about doing it in background..."
+
+ |senders|
+
+ senders := SystemBrowser
+ findSendersOf:selector
+ in:(environment allClasses)
+ ignoreCase:false
+ match:false.
+
+ senders notEmpty ifTrue:[
+ ^ 'Sent from ' , senders size printString, ' methods.'.
+ ] ifFalse:[
+ ^ 'No senders.'.
+ ].
! !
!Explainer class methodsFor:'documentation'!