--- a/DoWhatIMeanSupport.st Sun May 15 06:58:51 2016 +0200
+++ b/DoWhatIMeanSupport.st Tue May 17 14:38:21 2016 +0100
@@ -1869,7 +1869,7 @@
|selector lcSelector bestSelectors parentSelector newParentSelector bestSelectors2 bestWithParenthesis allBest numArgs
newParts nSelParts oldLen newLen selectorParts
- findBest parentNode nodeReceiver "selectorsSentInCode" selectorsImplementedInClass
+ parentNode nodeReceiver "selectorsSentInCode" selectorsImplementedInClass
editAction parentNodeClassIfKnown
receiverNodeClassIfKnown
offerParenthisationAroundNode parenthesisAroundIndex parentNodeToParenthesize
@@ -1877,71 +1877,14 @@
classesFromAssignmentsToReceiver otherMessagesToReceiver
canParenthesize classesOfReceiver|
- "/ Transcript show:'node '; show:node; show:' ; '.
- "/ Transcript show:'msg in '; show:methodOrNil; show:' / '; showCR:classOrNil.
-
+ Verbose == true ifTrue:[
+ Transcript show:'node '; show:node; show:' ; '.
+ Transcript show:'msg in '; show:methodOrNil; show:' / '; showCR:classOrNil.
+ ].
+
offerParenthisationAroundNode := nil.
offerValueInsertion := false.
- "/ node at:1
-
- findBest :=
- [:node :selector |
- |srchClasses bestSelectors bestPrefixes
- allMessagesSentToVariable classesImplementingAllMessages|
-
- srchClasses := node==nodeReceiver
- ifTrue:[classesOfReceiver]
- ifFalse:[self classesOfNode:node].
-
- srchClasses isEmptyOrNil ifTrue:[
- node isVariable ifTrue:[
- allMessagesSentToVariable := Set new.
- rememberedNodes do:[:eachNode |
- eachNode allMessageNodesDo:[:eachMessage |
- |msgReceiver msgSelector|
-
- (msgReceiver := eachMessage receiver) isVariable ifTrue:[
- msgReceiver name = node name ifTrue:[
- (msgSelector := eachMessage selector) ~= selector ifTrue:[
- allMessagesSentToVariable add:msgSelector
- ]
- ]
- ]
- ]
- ].
- allMessagesSentToVariable notEmpty ifTrue:[
- "/ consider classes which implement all those messages.
- classesImplementingAllMessages := Smalltalk allImplementorsOf:(allMessagesSentToVariable first).
- allMessagesSentToVariable do:[:eachSelector |
- classesImplementingAllMessages := classesImplementingAllMessages
- select:[:cls | cls implements:eachSelector].
- ].
- srchClasses := classesImplementingAllMessages.
- ].
- ].
- ].
- bestSelectors := Set new.
- srchClasses isEmptyOrNil ifTrue:[
- bestSelectors addAll:( Parser findBest:50 selectorsFor:selector in:nil forCompletion:true ).
- ] ifFalse:[
- srchClasses do:[:srchClass |
- |bestForThisClass|
-
- bestForThisClass := Parser findBest:50 selectorsFor:selector in:srchClass forCompletion:true.
- bestForThisClass := self
- withoutSelectorsUnlikelyFor:srchClass
- from:bestForThisClass
- forPartial:selector.
- bestSelectors addAll:bestForThisClass.
- ].
- ].
- "/ remove the already typed-in selector itself, in case.
- bestSelectors remove:selector ifAbsent:[].
- bestSelectors := bestSelectors asOrderedCollection.
- bestSelectors
- ].
-
selector := node selector.
lcSelector := selector asLowercase.
parentNode := node parent.
@@ -1949,9 +1892,11 @@
nodeReceiver notNil ifTrue:[
classesOfReceiver := self classesOfNode:nodeReceiver.
].
-Transcript show:node; show:' -> '; showCR:classesOfReceiver.
-( node isVariable and:[node name = 'self']) ifTrue:[self halt].
-
+ Verbose == true ifTrue:[
+ Transcript show:node; show:' -> '; showCR:classesOfReceiver.
+ ( node isVariable and:[node name = 'self']) ifTrue:[self halt].
+ ].
+
"/ if there is already space before the cursor, and the parent node is not a message,
"/ do not attempt to complete the current message.
"/ If it is a message, we will look for parent-message completion also below (best2 stuff)
@@ -1964,7 +1909,11 @@
"/ only do this if the node-message has no parents around
node parentheses isEmptyOrNil ifTrue:[
- bestSelectors := findBest value:nodeReceiver value:selector.
+ Verbose == true ifTrue:[
+ Transcript show:'try for: '; showCR:nodeReceiver
+ ].
+ bestSelectors := self findBest:nodeReceiver for:selector
+ inClasses:classesOfReceiver
] ifFalse:[
bestSelectors := OrderedCollection new.
].
@@ -2096,7 +2045,9 @@
"/ if its a unary message AND the parent is a keyword node, look for parent completion too.
"/ i.e. look if there is a longer keyword possible
newParentSelector := parentSelector,selector.
- bestSelectors2 := findBest value:(parentNode receiver) value:newParentSelector.
+ bestSelectors2 := self
+ findBest:(parentNode receiver) for:newParentSelector
+ inClasses:(self classesOfNode:parentNode receiver).
bestSelectors2 := bestSelectors2 select:[:sel | sel isKeyword and:[ sel startsWith:parentSelector]].
bestSelectors2 := bestSelectors2 asOrderedCollection sort:[:a :b | a size < b size].
bestSelectors := bestSelectors reject:[:sel | bestSelectors2 includes:sel].
@@ -2144,7 +2095,9 @@
"/ (i.e. into foo == shift <- more
"/ or into foo bar <- baz
codeView characterPositionOfCursor >= parentNode stop ifTrue:[
- kwSels := findBest value:parentNode value:selector.
+ kwSels := self
+ findBest:parentNode for:selector
+ inClasses:(self classesOfNode:parentNode).
kwSels := kwSels select:[:sel | sel isKeyword].
kwSels := kwSels asOrderedCollection sort:[:a :b | a size < b size].
@@ -2395,7 +2348,7 @@
"/
"/ info := best storeString.
"/ implClass notNil ifTrue:[
-"/ info := implClass name , ' » ' , info.
+"/ info := implClass name , ' ' , info.
"/ ].
"/ self information:info.
"/].
@@ -2625,11 +2578,14 @@
|knownClass suggestions selectorsImplementedInClass mostUseful editActions pos|
(knownClass := self classOfNode:node) isNil ifTrue:[
- self classOfNode:node.
+ self breakPoint:#cg.
+ "/ self classOfNode:node.
^ self
].
-Transcript show:node; show:' -> '; showCR:knownClass.
+ Verbose == true ifTrue:[
+ Transcript show:node; show:' -> '; showCR:knownClass.
+ ].
selectorsImplementedInClass := Set new.
knownClass withAllSuperclassesDo:[:cls |
@@ -3765,11 +3721,75 @@
!
editActionToReplaceNode:node byWordIn:suggestions
- ^ self editActionToReplaceCodeFrom:node start to:node stop byWordIn:suggestions
+ ^ self editActionToReplaceCodeFrom:(node start) to:(node stop) byWordIn:suggestions
"Created: / 01-05-2016 / 18:44:09 / cg"
!
+findBest:node for:selector inClasses:srchClassesArg
+ |srchClasses bestSelectors
+ allMessagesSentToVariable classesImplementingAllMessages|
+
+ srchClasses := srchClassesArg.
+ Verbose == true ifTrue:[
+ Transcript show:'node: '; showCR:node.
+ Transcript show:'srchClasses: '; showCR:srchClasses.
+ ].
+
+ srchClasses isEmptyOrNil ifTrue:[
+ node isVariable ifTrue:[
+ allMessagesSentToVariable := Set new.
+ rememberedNodes do:[:eachNode |
+ eachNode allMessageNodesDo:[:eachMessage |
+ |msgReceiver msgSelector|
+
+ (msgReceiver := eachMessage receiver) isVariable ifTrue:[
+ msgReceiver name = node name ifTrue:[
+ (msgSelector := eachMessage selector) ~= selector ifTrue:[
+ allMessagesSentToVariable add:msgSelector
+ ]
+ ]
+ ]
+ ]
+ ].
+ allMessagesSentToVariable notEmpty ifTrue:[
+ "/ consider classes which implement all those messages.
+ classesImplementingAllMessages := Smalltalk allImplementorsOf:(allMessagesSentToVariable first).
+ allMessagesSentToVariable do:[:eachSelector |
+ classesImplementingAllMessages := classesImplementingAllMessages
+ select:[:cls | cls implements:eachSelector].
+ ].
+ srchClasses := classesImplementingAllMessages.
+ ].
+ ].
+ ].
+ bestSelectors := Set new.
+ srchClasses isEmptyOrNil ifTrue:[
+ bestSelectors addAll:( Parser findBest:50 selectorsFor:selector in:nil forCompletion:true ).
+ Verbose == true ifTrue:[
+ Transcript show:'bestSelectors (1): '; showCR:bestSelectors.
+ ].
+ ] ifFalse:[
+ srchClasses do:[:srchClass |
+ |bestForThisClass|
+
+ bestForThisClass := Parser findBest:50 selectorsFor:selector in:srchClass forCompletion:true.
+ bestForThisClass := self
+ withoutSelectorsUnlikelyFor:srchClass
+ from:bestForThisClass
+ forPartial:selector.
+ Verbose == true ifTrue:[
+ Transcript show:'bestSelectors (2): '; showCR:bestForThisClass.
+ ].
+ bestSelectors addAll:bestForThisClass.
+ ].
+ ].
+ "/ remove the already typed-in selector itself, in case.
+ bestSelectors remove:selector ifAbsent:[].
+ bestSelectors := bestSelectors asOrderedCollection.
+ ^ bestSelectors
+!
+
findNodeForInterval:interval in:source
|tree node|
@@ -4545,6 +4565,8 @@
].
].
+ "/ characterBeforeCursor == $) ifTrue:[self halt].
+
"/ move outward, until we find a message-send node,
"/ or the method's selector pattern node.
checkedNode := node.
@@ -4594,7 +4616,7 @@
I have currently no better idea than hardcoding stuff I found irritating..."
|selectors noNilChecks noIsXXXChecks noNoXXXChecks noBecome
- noIndexedSetters noIndexedGetters noSizeQueries|
+ noIndexedSetters noIndexedGetters noSizeQueries docSelectors|
aClass isNil ifTrue:[ ^ selectorsArg ].
@@ -4605,6 +4627,12 @@
self tracePoint:#cg message:aClass.
+ aClass isMeta ifTrue:[
+ docSelectors := #(copyright documentation examples
+ version version_CVS version_SVN version_HG).
+ selectors := selectors reject:[:sel | docSelectors includes:sel].
+ ].
+
"/ actually meaning booleans here
(aClass == True or:[aClass == False]) ifTrue:[
noNilChecks := noBecome := true.
@@ -4684,670 +4712,6 @@
^ selectors
! !
-!DoWhatIMeanSupport methodsFor:'code completion-helpers-naive type inference'!
-
-addClassesFromAssignmentTo:varName in:aTree to:setOfTypes
- "/ assignments...
-
- aTree allAssignmentNodesDo:[:eachAssignmentNode |
- |leftSide|
-
- leftSide := eachAssignmentNode variable.
- leftSide name = varName ifTrue:[
- self
- addClassesOfExpression:eachAssignmentNode value
- inClass:classOrNil to:setOfTypes.
- ]
- ].
- ^ setOfTypes.
-!
-
-addClassesOfBlockVar:variableNode inScope:blockScope to:setOfTypes
- |blockParent blockParentSelector exNode isHandler|
-
- blockParent := blockScope parent.
- (blockParent notNil and:[blockParent isMessage]) ifFalse:[^ setOfTypes].
-
- blockParentSelector := blockParent selector.
-
- "/ if the parent of the block is an enumeration message, and the receiver is known,
- "/ we know the type of argument.
- ( #(do: keysAndValuesDo: select: collect:) includes:blockParent selector) ifTrue:[
- |collection|
-
- collection := self valueOfNode:blockParent receiver.
- collection notNil ifTrue:[
- (collection isKindOf:Collection) ifTrue:[
- collection notEmpty ifTrue:[
- |someElement|
- someElement := collection anElement.
- setOfTypes add:someElement class.
- ^ setOfTypes
- ].
- ].
- ].
- ].
-
- "/ because we type-in those so often, it is great to get
- "/ better info on the ex parameter... (and it's a low hanging fruit)
- ( blockParentSelector == #handle:do: ) ifTrue:[
- exNode := blockParent receiver.
- isHandler := (blockScope == (blockParent arguments at:1)).
- ].
- ( blockParentSelector == #on:do: ) ifTrue:[
- self halt.
- exNode := blockParent arg1.
- isHandler := (blockScope == (blockParent arguments at:2)).
- ].
- exNode notNil ifTrue:[
- |cls exClass|
-
- ((cls := (self valueOfNode:exNode)) notNil and:[cls isBehavior]) ifTrue:[
- exClass := cls
- ] ifFalse:[
- exClass := Exception
- ].
- setOfTypes add:exClass.
- ^ self
- ].
- ^ setOfTypes
-!
-
-addClassesOfExpression:expr inClass:classOrNil to:setOfTypes
- |cls exprVal varName varScope instVarClass classVarClass poolVarClass sym|
-
- expr isLiteral ifTrue:[
- exprVal := expr value.
- cls := exprVal class.
- (exprVal isArray or:[ exprVal isByteArray or:[ exprVal isString ]]) ifTrue:[
- exprVal isImmutable ifTrue:[
- setOfTypes add:cls mutableClass.
- ^ setOfTypes.
- ]
- ].
- setOfTypes add:cls.
- ^ setOfTypes.
- ].
-
- expr isBlock ifTrue:[
- setOfTypes add:Block.
- ^ setOfTypes.
- ].
-
- expr isVariable ifTrue:[
- varName := expr name.
- varName = 'self' ifTrue:[
- setOfTypes add:(classOrNil ? UndefinedObject).
- ^ setOfTypes
- ].
- varName = 'super' ifTrue:[
- classOrNil isNil
- ifTrue:[setOfTypes add:Object]
- ifFalse:[setOfTypes add:classOrNil superclass].
- ^ setOfTypes.
- ].
- varName = 'thisContext' ifTrue:[
- setOfTypes add:Context.
- ^ setOfTypes
- ].
-
- varScope := expr whoDefines: varName.
- (varScope notNil) ifTrue:[
- (varScope isBlock) ifTrue:[
- self addClassesOfBlockVar:expr inScope:varScope to:setOfTypes.
- ^ setOfTypes
- ].
- (varScope isMethod) ifTrue:[
- setOfTypes addAll:( self classesFromAssignmentTo:varName in:varScope ).
- ^ setOfTypes
- ].
- ].
-
- classOrNil notNil ifTrue:[
- "/ inst var
- instVarClass := classOrNil whichClassDefinesInstVar:varName.
- instVarClass notNil ifTrue:[
- setOfTypes addAll:(self classesOfInstVarNamed:varName inClass:instVarClass).
- ^ setOfTypes
- ].
-
- "/ class vars
- classVarClass := classOrNil theNonMetaclass whichClassDefinesClassVar:varName.
- classVarClass notNil ifTrue:[
- "/ see what is currently there
- setOfTypes add:(classVarClass classVarAt:varName asSymbol) class.
- ^ setOfTypes
- ].
- varName isUppercaseFirst ifTrue:[
- "/ private class
- varName knownAsSymbol ifTrue:[
- cls := classOrNil theNonMetaclass privateClassesAt:varName asSymbol.
- cls notNil ifTrue:[
- setOfTypes add:(cls theMetaclass).
- ^ setOfTypes
- ].
- ].
- ].
- "/ pool vars
- poolVarClass := classOrNil theNonMetaclass whichPoolDefinesPoolVar:varName.
- poolVarClass notNil ifTrue:[
- "/ see what is currently there
- setOfTypes add:(poolVarClass classVarAt:varName asSymbol) class.
- ^ setOfTypes
- ].
- ].
-
- varName isUppercaseFirst ifTrue:[
- sym := varName asSymbolIfInterned.
- sym notNil ifTrue:[
- exprVal := (Smalltalk at:sym).
- exprVal notNil ifTrue:[
- setOfTypes add:(exprVal class).
- ]
- ].
- ].
- ^ setOfTypes
- ].
-
- (exprVal := self valueOfNode:expr) notNil ifTrue:[
- "/ knowing the value is always great!!
- setOfTypes add:exprVal class.
- ^ setOfTypes.
- ].
-
- expr isMessage ifTrue:[
- self addClassesOfMessage:expr inClass:classOrNil to:setOfTypes.
- ^ setOfTypes
- ].
-
- ^ setOfTypes
-!
-
-addClassesOfInstVarNamed:varName inClass:aClass to:setOfTypes
- |instIndex type|
-
- instIndex := aClass instVarIndexFor:varName.
-
- "/ ask the class
- (type := aClass typeOfInstVarNamed:varName) notNil ifTrue:[
- type isCollection ifTrue:[
- setOfTypes addAll:type.
- ] ifFalse:[
- setOfTypes add:type.
- ].
- ^ setOfTypes
- ].
-
- "/ look for instances
- aClass allSubInstancesDo:[:i |
- |varClass|
- varClass := (i instVarAt:instIndex) class.
- setOfTypes add:varClass.
- ].
-
- "/ look for assignments in code
- aClass withAllSubclassesDo:[:eachClass |
- eachClass methodDictionary do:[:m |
- |tree code visitor|
-
- "/ quick check
- code := m source.
- (code notNil and:[code includesString:varName]) ifTrue:[
- tree := Parser parse:code class:eachClass.
- (tree notNil and:[tree ~~ #Error]) ifTrue:[
- visitor := PluggableParseNodeVisitor new.
- visitor
- actionForNodeClass:AssignmentNode
- put:[:node |
- |val expr exprSelector|
-
- node variable name = varName ifTrue:[
- expr := node expression.
- "/ only look for wellknown types on the right side.
- expr isLiteral ifTrue:[
- val := expr evaluate.
- val isArray ifTrue:[
- setOfTypes add:Array
- ] ifFalse:[
- setOfTypes add:val class
- ].
- ] ifFalse:[
- expr isMessage ifTrue:[
- exprSelector := expr selector.
- ( #(+ - * /) includes:exprSelector ) ifTrue:[
- setOfTypes add:Number
- ] ifFalse:[
- ( #(// size) includes:exprSelector ) ifTrue:[
- setOfTypes add:Integer
- ] ifFalse:[
- ( #(copy shallowCopy) includes:exprSelector ) ifTrue:[
- ] ifFalse:[
- ( #(new new: basicNew basicNew:) includes:exprSelector ) ifTrue:[
- expr receiver isGlobal ifTrue:[
- setOfTypes add:expr receiver evaluate
- ].
- ] ifFalse:[
-self breakPoint:#cg.
- ]
- ]
- ]
- ]
- ].
- ].
- ].
- true "/ yes - visit subnodes
- ].
- visitor visit:tree.
- ].
- ]
- ]
- ].
- ^ setOfTypes
-!
-
-addClassesOfMessage:expr inClass:classOrNil to:setOfTypes
- |exprSelector valClass
- msgSelector msgReceiver msgArg1
- receiverClasses receiverClass
- arg1Classes arg1Value mthd|
-
- msgSelector := expr selector.
-
- "/ heuristic: quickly assume boolean for some:
- (
- #(
- isNil notNil isEmpty isEmptyOrNil notEmpty notEmptyOrNil
- > >= < <= = == ~ ~=
- knownAsSymbol
- isMeta
- includes: contains:
- not and: or:
- exists atEnd positive negative odd even
- ) includes:msgSelector
- ) ifTrue:[
- setOfTypes add:True. "/ use True, because boolean does not include the full protocol
- ^ setOfTypes
- ].
-
- msgReceiver := expr receiver.
-
- "/ some hardwired knowledge here
- receiverClasses := self classesOfNode:msgReceiver.
- receiverClass := receiverClasses size == 1 ifTrue:[receiverClasses anElement] ifFalse:[nil].
-
- receiverClass notNil ifTrue:[
- receiverClass == Smalltalk ifTrue:[
- msgSelector == #at: ifTrue:[
- msgArg1 := expr arg1.
- msgArg1 isLiteralSymbol ifTrue:[
- arg1Value := Smalltalk at:msgArg1 value.
- arg1Value notNil ifTrue:[
- setOfTypes add:arg1Value class.
- ^ setOfTypes.
- ]
- ]
- ].
- ].
-
- ( #(copy shallowCopy) includes:exprSelector ) ifTrue:[
- setOfTypes addAll:receiverClasses.
- ^ setOfTypes.
- ].
-
- msgSelector == #theNonMetaclass ifTrue:[
- setOfTypes add:receiverClass theNonMetaclass class.
- ^ setOfTypes
- ].
- msgSelector == #theMetaclass ifTrue:[
- setOfTypes add:receiverClass theMetaclass class.
- ^ setOfTypes
- ].
- msgSelector == #class ifTrue:[
- setOfTypes add:receiverClass class.
- ^ setOfTypes.
- ].
-
- receiverClass isBehavior ifTrue:[
- mthd := receiverClass lookupMethodFor:msgSelector.
- receiverClass isMeta ifTrue:[
- ( #( #'new' #'basicNew' #'new:' #'basicNew:' #'with:' #'with:with:') includes: msgSelector ) ifTrue:[
- setOfTypes add:receiverClass theNonMetaclass.
- ^ setOfTypes.
- ].
- "/ if that method sends one of new/basicNew/new:/basicNew:, assume it returns an instance of itself
- mthd notNil ifTrue:[
- ( mthd sendsAny:#( #'new' #'basicNew' #'new:' #'basicNew:' )) ifTrue:[
- setOfTypes add:receiverClass theNonMetaclass.
- ^ setOfTypes
- ].
- ].
- ] ifFalse:[
- mthd notNil ifTrue:[
- (ParseTreeSearcher methodIsSetterMethod:mthd) ifTrue:[
- setOfTypes add:receiverClass.
- ^ setOfTypes
- ]
- ]
- ]
- ].
- ].
-
- ((msgSelector startsWith:'as')
- and:[ (valClass := Smalltalk classNamed:(msgSelector copyFrom:3)) notNil ]
- ) ifTrue:[
- setOfTypes add:valClass.
- ^ setOfTypes
- ].
-
- ((msgSelector startsWith:'is')
- and:[ (valClass := Smalltalk classNamed:(msgSelector copyFrom:3)) notNil ]
- ) ifTrue:[
- setOfTypes add:True. "/ Boolean - not boolean; it does not contain the full protocol (would not find ifTrue:)
- ^ setOfTypes.
- ].
-
- #(
- size SmallInteger
- hash SmallInteger
- identityHash SmallInteger
- class Class
- theMetaclass Metaclass
- theNonMetaclass Class
- fork Process
- newProcess Process
- ) pairWiseDo:[:sel :clsName |
- msgSelector == sel ifTrue:[
- setOfTypes add:(Smalltalk at:clsName).
- ^ setOfTypes.
- ].
- ].
-
- ( #( bitAnd: bitOr: bitShift: rightShift: >> << highBit lowBit ) includes:msgSelector) ifTrue:[
- "/ assume integer
-
- setOfTypes add:Integer.
- ^ setOfTypes
- ].
- ( #( + - * // \\ ) includes:msgSelector) ifTrue:[
- "/ assume numeric
-
- setOfTypes add:Number.
- ^ setOfTypes
- ].
- msgSelector == #/ ifTrue:[
- ((receiverClasses ? #()) contains:[:cls | cls includesBehavior:Number]) ifTrue:[
- setOfTypes add:Number.
- ^ setOfTypes.
- ].
- msgArg1 := expr arguments at:1 ifAbsent:nil.
- msgArg1 isNil ifTrue:[^ setOfTypes].
- arg1Classes := ((self classesOfNode:msgArg1) ? #()).
- (arg1Classes contains:[:cls | cls includesBehavior:Number]) ifTrue:[
- setOfTypes add:Number.
- ^ setOfTypes
- ].
- ].
- ( #( construct: / ) includes:msgSelector) ifTrue:[
- ((receiverClasses ? #()) contains:[:cls | cls includesBehavior:Filename]) ifTrue:[
- setOfTypes add:Filename.
- ^ setOfTypes
- ].
- ].
-
- ^ setOfTypes
-!
-
-classOfNode:aNode
- "returns the class of a receiver, if it is well-known.
- Otherwise nil (either unknown, or multiple possibilities)
- When showing possible completions for a message,
- it is a good idea to know what the kind receiver is."
-
- | classes |
-
- classes := self classesOfNode:aNode.
- classes size == 1 ifTrue:[
- ^ classes anElement
- ].
- ^ nil
-!
-
-classesFromAssignmentTo:varName in:aTree
- ^ self addClassesFromAssignmentTo:varName in:aTree to:IdentitySet new
-!
-
-classesOfInstVarNamed:varName inClass:aClass
- ^ self addClassesOfInstVarNamed:varName inClass:aClass to:(IdentitySet new)
-!
-
-classesOfNode:aNode
- "returns the set of possible classes of a parsenode.
- or nil if unknown.
- When showing possible completions for a message,
- it is a good idea to know what the kind receiver is."
-
- ^ self addClassesOfExpression:aNode inClass:classOrNil to:(IdentitySet new).
-!
-
-isNonDestructive:aMessageNode whenSentTo:receiverValue
- "return true, if it is safe to send aSelector to receiverValue
- (i.e. has no side effects)"
-
- |selector method impl arg1Value|
-
- selector := aMessageNode selector.
-
- impl := receiverValue class whichClassIncludesSelector:selector.
-
- ( #(
- basicSize basicAt:
- class theMetaclass theNonMetaclass ) includes:selector
- ) ifTrue:[
- ^ true.
- ].
-
- selector == #size ifTrue:[
- "/ mhm - be conservative; someone might have redefined #size
- "/ more hardwired stuff.
- ((impl == Object) or:[(impl == String) or:[impl isSubclassOf:Collection]]) ifTrue:[
- ^ true.
- ].
- ].
- selector == #at: ifTrue:[
- "/ mhm - be conservative; someone might have redefined #at: and do something there
- "/ more hardwired stuff.
- arg1Value := self valueOfNode:(aMessageNode arg1).
- arg1Value notNil ifTrue:[
- receiverValue == Smalltalk ifTrue:[
- ^ arg1Value isSymbol
- ].
-
- ((impl == Object) or:[(impl == String) or:[(impl isSubclassOf:Collection)]]) ifTrue:[
- ^ true.
- ].
- ].
- ].
-
- selector argumentCount == 0 ifTrue:[
- "/ follow non-destructive accessors
- method := receiverValue class lookupMethodFor:selector.
- method notNil ifTrue:[
- (ParseTreeSearcher methodIsJustReturningSomething:method) ifTrue:[
- "/ we can savely call that method to get the current value
- ^ true.
- ].
- ].
- ].
-
- ^ false
-!
-
-valueAndKindOfVariable:aVariableName
- "when showing possible completions for a variable,
- it is a good idea to know what the reveiver's value is.
- Sigh - returns nil as value both if unknown AND if a real nil is there"
-
- |nodeVal con classInstVarClass classVarClass privateClass pool sym nameSpace topNameSpace|
-
- aVariableName isUppercaseFirst ifTrue:[
- classOrNil notNil ifTrue:[
- classOrNil isMeta ifTrue:[
- "/ class instVars
- (classInstVarClass := classOrNil whichClassDefinesInstVar:aVariableName) notNil ifTrue:[
- nodeVal := classInstVarClass theNonMetaclass instVarNamed:aVariableName.
- ^ { nodeVal . #classInstVariable }
- ].
- ].
- "/ class vars
- (classVarClass := classOrNil theNonMetaclass whichClassDefinesClassVar:aVariableName) notNil ifTrue:[
- nodeVal := classVarClass classVarAt:aVariableName asSymbol.
- ^ { nodeVal . #classVariable }
- ].
-
- privateClass := classOrNil theNonMetaclass privateClasses detect:[:cls | cls nameWithoutPrefix = aVariableName] ifNone:nil.
- privateClass notNil ifTrue:[
- nodeVal := privateClass.
- ^ { nodeVal . #privateClass }
- ].
- pool := classOrNil theNonMetaclass whichPoolDefinesPoolVar:aVariableName.
- pool notNil ifTrue:[
- nodeVal := pool classVarAt:aVariableName.
- ^ { nodeVal . #poolVariable }
- ].
- ((nameSpace := classOrNil nameSpace) notNil and:[nameSpace ~~ Smalltalk]) ifTrue:[
- nameSpace isNameSpace ifTrue:[
- nodeVal := nameSpace at:aVariableName asSymbol.
- ^ { nodeVal . #nameSpaceVariable }
- ].
- nodeVal := nameSpace privateClassNamed:aVariableName asSymbol.
- ^ { nodeVal . #privateClass }
- ].
- ((topNameSpace := classOrNil topNameSpace) notNil
- and:[topNameSpace ~~ nameSpace
- and:[topNameSpace ~~ Smalltalk]]) ifTrue:[
- nodeVal := topNameSpace at:aVariableName asSymbol.
- ^ { nodeVal . #nameSpaceVariable }
- ].
- ].
- (sym := aVariableName asSymbolIfInterned) notNil ifTrue:[
- nodeVal := Smalltalk at:sym.
- (nodeVal notNil or:[Smalltalk includesKey:sym]) ifTrue:[
- ^ { nodeVal . #global }
- ]
- ].
-
- "/ 'evaluate' the variable (like in a browser's codeView)
- "/ mhmh - will we catch workspace vars then?
- Error handle:[:ex |
- ] do:[
- nodeVal := Parser new evaluate:aVariableName in:classOrNil receiver:classOrNil.
- ].
- nodeVal notNil ifTrue:[
- ^ { nodeVal . #global }
- ].
- ^ nil
- ].
-
- aVariableName = 'self' ifTrue:[
- contextOrNil notNil ifTrue:[
- ^ { contextOrNil receiver . #pseudoVar }
- ].
- (classOrNil notNil and:[classOrNil isMeta]) ifTrue:[
- "/ ^ { classOrNil . #pseudoVar }
- ^ { classOrNil theNonMetaclass . #pseudoVar }
- ].
- ^ nil
- ].
-
- contextOrNil notNil ifTrue:[
- "/ in the debugger, we know more
- con := contextOrNil.
- [ con notNil ] whileTrue:[
- "/ a local in the context?
- ((con argAndVarNames ? #()) includes:aVariableName) ifTrue:[
- nodeVal := con argsAndVars at:(con argAndVarNames indexOf:aVariableName) ifAbsent:nil.
- nodeVal notNil ifTrue:[
- ^ { nodeVal . #argument }
- ].
- ].
- con := con home.
- ].
- "/ an instvar
- (contextOrNil receiver class allInstVarNames includes:aVariableName) ifTrue:[
- nodeVal := contextOrNil receiver instVarNamed:aVariableName.
- nodeVal notNil ifTrue:[
- ^ { nodeVal . #instanceVariable }
- ].
- ].
- ].
- ^ nil
-
- "Created: / 01-05-2016 / 12:40:05 / cg"
-!
-
-valueOfNode:aNode
- "when showing possible completions for a message,
- it is a good idea to know what the reveiver's value is.
- Sigh - returns nil both if unknown AND if a real nil is there."
-
- |nodeSelector nodeReceiver isNonDestructive receiverValue arg1Value|
-
- aNode isLiteral ifTrue:[
- ^ aNode value
- ].
- aNode isVariable ifTrue:[
- ^ self valueOfVariable:aNode name.
- ].
-
- aNode isMessage ifTrue:[
- nodeSelector := aNode selector.
- nodeReceiver := aNode receiver.
-
- "/ some hardwired knowledge here
- classOrNil notNil ifTrue:[
- (nodeReceiver isSelf and:[nodeSelector = #'class']) ifTrue:[
- ^ classOrNil
- ].
- ].
-
- receiverValue := self valueOfNode:nodeReceiver.
- receiverValue notNil ifTrue:[
- isNonDestructive := self isNonDestructive:aNode whenSentTo:receiverValue.
- isNonDestructive ifTrue:[
- nodeSelector argumentCount == 1 ifTrue:[
- arg1Value := self valueOfNode:(aNode arg1).
- [
- ^ receiverValue perform: nodeSelector with: arg1Value.
- ] on:Error do:[
- ^ nil
- ]
- ].
- ^ receiverValue perform: nodeSelector.
- ].
- ].
- ].
-
- ^ nil
-
- "Created: / 28-08-2013 / 16:34:53 / cg"
-!
-
-valueOfVariable:aVariableName
- "when showing possible completions for a variable,
- it is a good idea to know what the reveiver's value is.
- Sigh - returns nil both if unknown AND if a real nil is there."
-
- |valueAndKind|
-
- (valueAndKind := self valueAndKindOfVariable:aVariableName) notNil ifTrue:[
- self assert:valueAndKind isArray.
- ^ valueAndKind first.
- ].
- ^ nil
-
- "Modified: / 01-05-2016 / 12:41:30 / cg"
-! !
-
!DoWhatIMeanSupport methodsFor:'code completion-helpers-old'!
codeCompletionForLiteralSymbol:node inClass:classOrNil codeView:codeView
@@ -5614,7 +4978,7 @@
"/
"/ info := best storeString.
"/ implClass notNil ifTrue:[
-"/ info := implClass name , ' » ' , info.
+"/ info := implClass name , ' ' , info.
"/ ].
"/ self information:info.
@@ -6073,6 +5437,723 @@
"Modified: / 28-08-2013 / 15:37:28 / cg"
! !
+!DoWhatIMeanSupport methodsFor:'helpers-naive type inference'!
+
+addClassesFromAssignmentTo:varName in:aTree to:setOfTypes
+ "/ assignments...
+
+ aTree allAssignmentNodesDo:[:eachAssignmentNode |
+ |leftSide|
+
+ leftSide := eachAssignmentNode variable.
+ leftSide name = varName ifTrue:[
+ self
+ addClassesOfExpression:eachAssignmentNode value
+ inClass:classOrNil to:setOfTypes.
+ ]
+ ].
+ ^ setOfTypes.
+!
+
+addClassesFromMessagesSentTo:varNode in:aTree to:setOfTypes
+ "/ from the set of messages sent at other places,
+ "/ try to find classes, which respond to all those.
+
+ |varName allSelectors candidates|
+
+ varName := varNode name.
+
+ allSelectors := IdentitySet new.
+ aTree allMessageNodesDo:[:eachMessageNode |
+ |rcvr|
+
+ rcvr := eachMessageNode receiver.
+ (rcvr isVariable and:[rcvr name = varName]) ifTrue:[
+ allSelectors add:eachMessageNode selector
+ ]
+ ].
+
+ "/ the selector beeing comleted must be ignored here
+ (varNode parent notNil and:[varNode parent isMessage]) ifTrue:[
+ allSelectors remove:(varNode parent selector) ifAbsent:[].
+ ].
+
+ "/ now look for classes which implement all of them
+ candidates := SystemBrowser findRespondersOfAll:allSelectors in:nil ignoreCase:false.
+ candidates remove:Object ifAbsent:[].
+ setOfTypes addAll:candidates.
+ ^ setOfTypes.
+!
+
+addClassesOfBlockVarForWellknownBlocks:variableNode inScope:blockScope to:setOfTypes
+ |blockParent blockParentSelector exNode isHandler|
+
+ blockParent := blockScope parent.
+ (blockParent notNil and:[blockParent isMessage]) ifFalse:[^ setOfTypes].
+
+ blockParentSelector := blockParent selector.
+
+ "/ if the parent of the block is an enumeration message, and the receiver is known,
+ "/ we know the type of argument.
+ ( #(do: keysAndValuesDo: select: collect:) includes:blockParent selector) ifTrue:[
+ |collection|
+
+ collection := self valueOfNode:blockParent receiver.
+ collection notNil ifTrue:[
+ (collection isKindOf:Collection) ifTrue:[
+ collection notEmpty ifTrue:[
+ |someElement|
+ someElement := collection anElement.
+ setOfTypes add:someElement class.
+ ^ setOfTypes
+ ].
+ ].
+ ].
+ ].
+
+ "/ because we type-in those so often, it is great to get
+ "/ better info on the ex parameter... (and it's a low hanging fruit)
+ ( blockParentSelector == #handle:do: ) ifTrue:[
+ exNode := blockParent receiver.
+ isHandler := (blockScope == (blockParent arguments at:1)).
+ ].
+ ( blockParentSelector == #on:do: ) ifTrue:[
+ self halt.
+ exNode := blockParent arg1.
+ isHandler := (blockScope == (blockParent arguments at:2)).
+ ].
+ exNode notNil ifTrue:[
+ |cls exClass|
+
+ ((cls := (self valueOfNode:exNode)) notNil and:[cls isBehavior]) ifTrue:[
+ exClass := cls
+ ] ifFalse:[
+ exClass := Exception
+ ].
+ setOfTypes add:exClass.
+ ^ self
+ ].
+ ^ setOfTypes
+!
+
+addClassesOfExpression:expr inClass:classOrNil to:setOfTypes
+ |cls exprVal varName varScope instVarClass classVarClass poolVarClass sym|
+
+ expr isLiteral ifTrue:[
+ exprVal := expr value.
+ cls := exprVal class.
+ (exprVal isArray or:[ exprVal isByteArray or:[ exprVal isString ]]) ifTrue:[
+ exprVal isImmutable ifTrue:[
+ setOfTypes add:cls mutableClass.
+ ^ setOfTypes.
+ ]
+ ].
+ setOfTypes add:cls.
+ ^ setOfTypes.
+ ].
+
+ expr isBlock ifTrue:[
+ setOfTypes add:Block.
+ ^ setOfTypes.
+ ].
+
+ expr isVariable ifTrue:[
+ varName := expr name.
+ varName = 'self' ifTrue:[
+ setOfTypes add:(classOrNil ? UndefinedObject).
+ ^ setOfTypes
+ ].
+ varName = 'super' ifTrue:[
+ classOrNil isNil
+ ifTrue:[setOfTypes add:Object]
+ ifFalse:[setOfTypes add:classOrNil superclass].
+ ^ setOfTypes.
+ ].
+ varName = 'thisContext' ifTrue:[
+ setOfTypes add:Context.
+ ^ setOfTypes
+ ].
+
+ varScope := expr whoDefines: varName.
+ (varScope notNil) ifTrue:[
+ varScope isSequence ifTrue:[
+ varScope := varScope parent.
+ ].
+
+ (varScope isBlock) ifTrue:[
+ self addClassesOfBlockVarForWellknownBlocks:expr inScope:varScope to:setOfTypes.
+ self addClassesFromAssignmentTo:varName in:varScope to:setOfTypes.
+ self addClassesFromMessagesSentTo:expr in:varScope to:setOfTypes.
+ ^ setOfTypes
+ ].
+ (varScope isMethod) ifTrue:[
+ self addClassesFromAssignmentTo:varName in:varScope to:setOfTypes.
+ self addClassesFromMessagesSentTo:expr in:varScope to:setOfTypes.
+ ^ setOfTypes
+ ].
+ ].
+
+ classOrNil notNil ifTrue:[
+ "/ inst var
+ instVarClass := classOrNil whichClassDefinesInstVar:varName.
+ instVarClass notNil ifTrue:[
+ setOfTypes addAll:(self classesOfInstVarNamed:varName inClass:instVarClass).
+ ^ setOfTypes
+ ].
+
+ "/ class vars
+ classVarClass := classOrNil theNonMetaclass whichClassDefinesClassVar:varName.
+ classVarClass notNil ifTrue:[
+ "/ see what is currently there
+ setOfTypes add:(classVarClass classVarAt:varName asSymbol) class.
+ ^ setOfTypes
+ ].
+ varName isUppercaseFirst ifTrue:[
+ "/ private class
+ varName knownAsSymbol ifTrue:[
+ cls := classOrNil theNonMetaclass privateClassesAt:varName asSymbol.
+ cls notNil ifTrue:[
+ setOfTypes add:(cls theMetaclass).
+ ^ setOfTypes
+ ].
+ ].
+ ].
+ "/ pool vars
+ poolVarClass := classOrNil theNonMetaclass whichPoolDefinesPoolVar:varName.
+ poolVarClass notNil ifTrue:[
+ "/ see what is currently there
+ setOfTypes add:(poolVarClass classVarAt:varName asSymbol) class.
+ ^ setOfTypes
+ ].
+ ].
+
+ varName isUppercaseFirst ifTrue:[
+ sym := varName asSymbolIfInterned.
+ sym notNil ifTrue:[
+ exprVal := (Smalltalk at:sym).
+ exprVal notNil ifTrue:[
+ setOfTypes add:(exprVal class).
+ ]
+ ].
+ ].
+ ^ setOfTypes
+ ].
+
+ (exprVal := self valueOfNode:expr) notNil ifTrue:[
+ "/ knowing the value is always great!!
+ setOfTypes add:exprVal class.
+ ^ setOfTypes.
+ ].
+
+ expr isMessage ifTrue:[
+ self addClassesOfMessage:expr inClass:classOrNil to:setOfTypes.
+ ^ setOfTypes
+ ].
+
+ ^ setOfTypes
+!
+
+addClassesOfInstVarNamed:varName inClass:aClass to:setOfTypes
+ |instIndex type|
+
+ instIndex := aClass instVarIndexFor:varName.
+
+ "/ ask the class
+ (type := aClass typeOfInstVarNamed:varName) notNil ifTrue:[
+ type isCollection ifTrue:[
+ setOfTypes addAll:type.
+ ] ifFalse:[
+ setOfTypes add:type.
+ ].
+ ^ setOfTypes
+ ].
+
+ "/ look for instances
+ aClass allSubInstancesDo:[:i |
+ |varClass|
+ varClass := (i instVarAt:instIndex) class.
+ setOfTypes add:varClass.
+ ].
+
+ "/ look for assignments in code
+ aClass withAllSubclassesDo:[:eachClass |
+ eachClass methodDictionary do:[:m |
+ |tree code visitor|
+
+ "/ quick check
+ code := m source.
+ (code notNil and:[code includesString:varName]) ifTrue:[
+ tree := Parser parse:code class:eachClass.
+ (tree notNil and:[tree ~~ #Error]) ifTrue:[
+ visitor := PluggableParseNodeVisitor new.
+ visitor
+ actionForNodeClass:AssignmentNode
+ put:[:node |
+ |val expr exprSelector|
+
+ node variable name = varName ifTrue:[
+ expr := node expression.
+ "/ only look for wellknown types on the right side.
+ expr isLiteral ifTrue:[
+ val := expr evaluate.
+ val isArray ifTrue:[
+ setOfTypes add:Array
+ ] ifFalse:[
+ setOfTypes add:val class
+ ].
+ ] ifFalse:[
+ expr isMessage ifTrue:[
+ exprSelector := expr selector.
+ ( #(+ - * /) includes:exprSelector ) ifTrue:[
+ setOfTypes add:Number
+ ] ifFalse:[
+ ( #(// size) includes:exprSelector ) ifTrue:[
+ setOfTypes add:Integer
+ ] ifFalse:[
+ ( #(copy shallowCopy) includes:exprSelector ) ifTrue:[
+ ] ifFalse:[
+ ( #(new new: basicNew basicNew:) includes:exprSelector ) ifTrue:[
+ expr receiver isGlobal ifTrue:[
+ setOfTypes add:expr receiver evaluate
+ ].
+ ] ifFalse:[
+self breakPoint:#cg.
+ ]
+ ]
+ ]
+ ]
+ ].
+ ].
+ ].
+ true "/ yes - visit subnodes
+ ].
+ visitor visit:tree.
+ ].
+ ]
+ ]
+ ].
+ ^ setOfTypes
+!
+
+addClassesOfMessage:expr inClass:classOrNil to:setOfTypes
+ |valClass
+ msgSelector msgReceiver msgArg1
+ receiverClasses receiverClass
+ arg1Classes arg1Value mthd|
+
+ msgSelector := expr selector.
+
+ "/ heuristic: quickly assume boolean for some:
+ (
+ #(
+ isNil notNil isEmpty isEmptyOrNil notEmpty notEmptyOrNil
+ > >= < <= = == ~ ~=
+ knownAsSymbol
+ isMeta
+ includes: contains:
+ not and: or:
+ exists atEnd positive negative odd even
+ ) includes:msgSelector
+ ) ifTrue:[
+ setOfTypes add:True. "/ use True, because Boolean does not include the full protocol
+ ^ setOfTypes
+ ].
+
+ msgReceiver := expr receiver.
+
+ "/ some hardwired knowledge here
+ receiverClasses := self classesOfNode:msgReceiver.
+ receiverClass := receiverClasses size == 1 ifTrue:[receiverClasses anElement] ifFalse:[nil].
+
+ receiverClass notNil ifTrue:[
+ "/ follow Smalltalk at: to see what is there
+ receiverClass == Smalltalk ifTrue:[
+ msgSelector == #at: ifTrue:[
+ msgArg1 := expr arg1.
+ msgArg1 isLiteralSymbol ifTrue:[
+ arg1Value := Smalltalk at:msgArg1 value.
+ arg1Value notNil ifTrue:[
+ setOfTypes add:arg1Value class.
+ ^ setOfTypes.
+ ]
+ ]
+ ].
+ ].
+
+ "/ usually return something of the receiver's type
+ ( #(copy shallowCopy copyWith: , ) includes:msgSelector ) ifTrue:[
+ setOfTypes addAll:receiverClasses.
+ ^ setOfTypes.
+ ].
+
+ ( msgSelector == #class ) ifTrue:[
+ setOfTypes add:(receiverClass class).
+ ^ setOfTypes
+ ].
+
+ receiverClass isBehavior ifTrue:[
+ ( #(compiledMethodAt:) includes:msgSelector) ifTrue:[
+ setOfTypes add:Method.
+ ^ setOfTypes
+ ].
+ ( #(superclass) includes:msgSelector) ifTrue:[
+ receiverClass isMeta ifTrue:[
+ setOfTypes add:Metaclass.
+ ] ifFalse:[
+ setOfTypes add:Class.
+ ].
+ ^ setOfTypes
+ ].
+ ( #(theNonMetaclass theMetaclass) includes:msgSelector) ifTrue:[
+ receiverClass isMeta ifTrue:[
+ setOfTypes add:Metaclass.
+ ^ setOfTypes
+ ].
+ setOfTypes add:(receiverClass perform:msgSelector) class.
+ ^ setOfTypes
+ ].
+
+ mthd := receiverClass lookupMethodFor:msgSelector.
+ receiverClass isMeta ifTrue:[
+ ( #( #'new' #'basicNew' #'new:' #'basicNew:' #'with:' #'with:with:') includes: msgSelector ) ifTrue:[
+ setOfTypes add:receiverClass theNonMetaclass.
+ ^ setOfTypes.
+ ].
+ "/ if that method sends one of new/basicNew/new:/basicNew:, assume it returns an instance of itself
+ mthd notNil ifTrue:[
+ ( mthd sendsAny:#( #'new' #'basicNew' #'new:' #'basicNew:' )) ifTrue:[
+ setOfTypes add:receiverClass theNonMetaclass.
+ ^ setOfTypes
+ ].
+ ].
+ ] ifFalse:[
+ mthd notNil ifTrue:[
+ (ParseTreeSearcher methodIsSetterMethod:mthd) ifTrue:[
+ setOfTypes add:receiverClass.
+ ^ setOfTypes
+ ]
+ ]
+ ]
+ ].
+ ].
+
+ ((msgSelector startsWith:'as')
+ and:[ (valClass := Smalltalk classNamed:(msgSelector copyFrom:3)) notNil ]
+ ) ifTrue:[
+ setOfTypes add:valClass.
+ ^ setOfTypes
+ ].
+
+ ((msgSelector startsWith:'is')
+ and:[ (valClass := Smalltalk classNamed:(msgSelector copyFrom:3)) notNil ]
+ ) ifTrue:[
+ setOfTypes add:True. "/ True - not boolean; it does not contain the full protocol (would not find ifTrue:)
+ ^ setOfTypes.
+ ].
+
+ #(
+ size SmallInteger
+ hash SmallInteger
+ identityHash SmallInteger
+ class Class
+ theMetaclass Metaclass
+ theNonMetaclass Class
+ fork Process
+ newProcess Process
+ ) pairWiseDo:[:sel :clsName |
+ msgSelector == sel ifTrue:[
+ setOfTypes add:(Smalltalk at:clsName).
+ ^ setOfTypes.
+ ].
+ ].
+
+ ( #( bitAnd: bitOr: bitShift: rightShift: >> << highBit lowBit ) includes:msgSelector) ifTrue:[
+ "/ assume integer
+
+ setOfTypes add:Integer.
+ ^ setOfTypes
+ ].
+ ( #( + - * // \\ ) includes:msgSelector) ifTrue:[
+ "/ assume numeric
+
+ setOfTypes add:Number.
+ ^ setOfTypes
+ ].
+ msgSelector == #/ ifTrue:[
+ ((receiverClasses ? #()) contains:[:cls | cls includesBehavior:Number]) ifTrue:[
+ setOfTypes add:Number.
+ ^ setOfTypes.
+ ].
+ msgArg1 := expr arguments at:1 ifAbsent:nil.
+ msgArg1 isNil ifTrue:[^ setOfTypes].
+ arg1Classes := ((self classesOfNode:msgArg1) ? #()).
+ (arg1Classes contains:[:cls | cls includesBehavior:Number]) ifTrue:[
+ setOfTypes add:Number.
+ ^ setOfTypes
+ ].
+ ].
+ ( #( construct: / ) includes:msgSelector) ifTrue:[
+ ((receiverClasses ? #()) contains:[:cls | cls includesBehavior:Filename]) ifTrue:[
+ setOfTypes add:Filename.
+ ^ setOfTypes
+ ].
+ ].
+
+ ^ setOfTypes
+!
+
+classOfNode:aNode
+ "returns the class of a receiver, if it is well-known.
+ Otherwise nil (either unknown, or multiple possibilities)
+ When showing possible completions for a message,
+ it is a good idea to know what the kind receiver is."
+
+ | classes |
+
+ classes := self classesOfNode:aNode.
+ classes size == 1 ifTrue:[
+ ^ classes anElement
+ ].
+ self breakPoint:#cg.
+ ^ nil
+!
+
+classesFromAssignmentTo:varName in:aTree
+ ^ self addClassesFromAssignmentTo:varName in:aTree to:IdentitySet new
+!
+
+classesOfInstVarNamed:varName inClass:aClass
+ ^ self addClassesOfInstVarNamed:varName inClass:aClass to:(IdentitySet new)
+!
+
+classesOfNode:aNode
+ "returns the set of possible classes of a parsenode.
+ or nil if unknown.
+ When showing possible completions for a message,
+ it is a good idea to know what the kind receiver is."
+
+ ^ self addClassesOfExpression:aNode inClass:classOrNil to:(IdentitySet new).
+!
+
+isNonDestructive:aMessageNode whenSentTo:receiverValue
+ "return true, if it is safe to send aSelector to receiverValue
+ (i.e. has no side effects)"
+
+ |selector method impl arg1Value|
+
+ selector := aMessageNode selector.
+
+ impl := receiverValue class whichClassIncludesSelector:selector.
+
+ ( #(
+ basicSize basicAt:
+ class theMetaclass theNonMetaclass ) includes:selector
+ ) ifTrue:[
+ ^ true.
+ ].
+
+ selector == #size ifTrue:[
+ "/ mhm - be conservative; someone might have redefined #size
+ "/ more hardwired stuff.
+ ((impl == Object) or:[(impl == String) or:[impl isSubclassOf:Collection]]) ifTrue:[
+ ^ true.
+ ].
+ ].
+ selector == #at: ifTrue:[
+ "/ mhm - be conservative; someone might have redefined #at: and do something there
+ "/ more hardwired stuff.
+ arg1Value := self valueOfNode:(aMessageNode arg1).
+ arg1Value notNil ifTrue:[
+ receiverValue == Smalltalk ifTrue:[
+ ^ arg1Value isSymbol
+ ].
+
+ ((impl == Object) or:[(impl == String) or:[(impl isSubclassOf:Collection)]]) ifTrue:[
+ ^ true.
+ ].
+ ].
+ ].
+
+ selector argumentCount == 0 ifTrue:[
+ "/ follow non-destructive accessors
+ method := receiverValue class lookupMethodFor:selector.
+ method notNil ifTrue:[
+ (ParseTreeSearcher methodIsJustReturningSomething:method) ifTrue:[
+ "/ we can savely call that method to get the current value
+ ^ true.
+ ].
+ ].
+ ].
+
+ ^ false
+!
+
+valueAndKindOfVariable:aVariableName
+ "when showing possible completions for a variable,
+ it is a good idea to know what the reveiver's value is.
+ Sigh - returns nil as value both if unknown AND if a real nil is there"
+
+ |nodeVal con classInstVarClass classVarClass privateClass pool sym nameSpace topNameSpace|
+
+ aVariableName isUppercaseFirst ifTrue:[
+ classOrNil notNil ifTrue:[
+ classOrNil isMeta ifTrue:[
+ "/ class instVars
+ (classInstVarClass := classOrNil whichClassDefinesInstVar:aVariableName) notNil ifTrue:[
+ nodeVal := classInstVarClass theNonMetaclass instVarNamed:aVariableName.
+ ^ { nodeVal . #classInstVariable }
+ ].
+ ].
+ "/ class vars
+ (classVarClass := classOrNil theNonMetaclass whichClassDefinesClassVar:aVariableName) notNil ifTrue:[
+ nodeVal := classVarClass classVarAt:aVariableName asSymbol.
+ ^ { nodeVal . #classVariable }
+ ].
+
+ privateClass := classOrNil theNonMetaclass privateClasses detect:[:cls | cls nameWithoutPrefix = aVariableName] ifNone:nil.
+ privateClass notNil ifTrue:[
+ nodeVal := privateClass.
+ ^ { nodeVal . #privateClass }
+ ].
+ pool := classOrNil theNonMetaclass whichPoolDefinesPoolVar:aVariableName.
+ pool notNil ifTrue:[
+ nodeVal := pool classVarAt:aVariableName.
+ ^ { nodeVal . #poolVariable }
+ ].
+ ((nameSpace := classOrNil nameSpace) notNil and:[nameSpace ~~ Smalltalk]) ifTrue:[
+ nameSpace isNameSpace ifTrue:[
+ nodeVal := nameSpace at:aVariableName asSymbol.
+ ^ { nodeVal . #nameSpaceVariable }
+ ].
+ nodeVal := nameSpace privateClassNamed:aVariableName asSymbol.
+ ^ { nodeVal . #privateClass }
+ ].
+ ((topNameSpace := classOrNil topNameSpace) notNil
+ and:[topNameSpace ~~ nameSpace
+ and:[topNameSpace ~~ Smalltalk]]) ifTrue:[
+ nodeVal := topNameSpace at:aVariableName asSymbol.
+ ^ { nodeVal . #nameSpaceVariable }
+ ].
+ ].
+ (sym := aVariableName asSymbolIfInterned) notNil ifTrue:[
+ nodeVal := Smalltalk at:sym.
+ (nodeVal notNil or:[Smalltalk includesKey:sym]) ifTrue:[
+ ^ { nodeVal . #global }
+ ]
+ ].
+
+ "/ 'evaluate' the variable (like in a browser's codeView)
+ "/ mhmh - will we catch workspace vars then?
+ Error handle:[:ex |
+ ] do:[
+ nodeVal := Parser new evaluate:aVariableName in:classOrNil receiver:classOrNil.
+ ].
+ nodeVal notNil ifTrue:[
+ ^ { nodeVal . #global }
+ ].
+ ^ nil
+ ].
+
+ aVariableName = 'self' ifTrue:[
+ contextOrNil notNil ifTrue:[
+ ^ { contextOrNil receiver . #pseudoVar }
+ ].
+ (classOrNil notNil and:[classOrNil isMeta]) ifTrue:[
+ "/ ^ { classOrNil . #pseudoVar }
+ ^ { classOrNil theNonMetaclass . #pseudoVar }
+ ].
+ ^ nil
+ ].
+
+ contextOrNil notNil ifTrue:[
+ "/ in the debugger, we know more
+ con := contextOrNil.
+ [ con notNil ] whileTrue:[
+ "/ a local in the context?
+ ((con argAndVarNames ? #()) includes:aVariableName) ifTrue:[
+ nodeVal := con argsAndVars at:(con argAndVarNames indexOf:aVariableName) ifAbsent:nil.
+ nodeVal notNil ifTrue:[
+ ^ { nodeVal . #argument }
+ ].
+ ].
+ con := con home.
+ ].
+ "/ an instvar
+ (contextOrNil receiver class allInstVarNames includes:aVariableName) ifTrue:[
+ nodeVal := contextOrNil receiver instVarNamed:aVariableName.
+ nodeVal notNil ifTrue:[
+ ^ { nodeVal . #instanceVariable }
+ ].
+ ].
+ ].
+ ^ nil
+
+ "Created: / 01-05-2016 / 12:40:05 / cg"
+!
+
+valueOfNode:aNode
+ "when showing possible completions for a message,
+ it is a good idea to know what the reveiver's value is.
+ Sigh - returns nil both if unknown AND if a real nil is there."
+
+ |nodeSelector nodeReceiver isNonDestructive receiverValue arg1Value|
+
+ aNode isLiteral ifTrue:[
+ ^ aNode value
+ ].
+ aNode isVariable ifTrue:[
+ ^ self valueOfVariable:aNode name.
+ ].
+
+ aNode isMessage ifTrue:[
+ nodeSelector := aNode selector.
+ nodeReceiver := aNode receiver.
+
+ "/ some hardwired knowledge here
+ classOrNil notNil ifTrue:[
+ (nodeReceiver isSelf and:[nodeSelector = #'class']) ifTrue:[
+ ^ classOrNil
+ ].
+ ].
+
+ receiverValue := self valueOfNode:nodeReceiver.
+ receiverValue notNil ifTrue:[
+ isNonDestructive := self isNonDestructive:aNode whenSentTo:receiverValue.
+ isNonDestructive ifTrue:[
+ nodeSelector argumentCount == 1 ifTrue:[
+ arg1Value := self valueOfNode:(aNode arg1).
+ [
+ ^ receiverValue perform: nodeSelector with: arg1Value.
+ ] on:Error do:[
+ ^ nil
+ ]
+ ].
+ ^ receiverValue perform: nodeSelector.
+ ].
+ ].
+ ].
+
+ ^ nil
+
+ "Created: / 28-08-2013 / 16:34:53 / cg"
+!
+
+valueOfVariable:aVariableName
+ "when showing possible completions for a variable,
+ it is a good idea to know what the reveiver's value is.
+ Sigh - returns nil both if unknown AND if a real nil is there."
+
+ |valueAndKind|
+
+ (valueAndKind := self valueAndKindOfVariable:aVariableName) notNil ifTrue:[
+ self assert:valueAndKind isArray.
+ ^ valueAndKind first.
+ ].
+ ^ nil
+
+ "Modified: / 01-05-2016 / 12:41:30 / cg"
+! !
+
!DoWhatIMeanSupport::InputCompletionResult class methodsFor:'instance creation'!
bestName:bestNameArg matchingNames:matchingNamesArg