--- a/DoWhatIMeanSupport.st Sun May 08 07:00:52 2016 +0200
+++ b/DoWhatIMeanSupport.st Mon May 09 06:39:05 2016 +0200
@@ -4657,15 +4657,15 @@
addClassesFromAssignmentTo:varName in:aTree to:setOfTypes
"/ assignments...
+
aTree allAssignmentNodesDo:[:eachAssignmentNode |
- |exprCls leftSide|
+ |leftSide|
leftSide := eachAssignmentNode variable.
leftSide name = varName ifTrue:[
- exprCls := self classOfNode:eachAssignmentNode value.
- exprCls notNil ifTrue:[
- setOfTypes add:exprCls
- ]
+ self
+ addClassesOfExpression:eachAssignmentNode value
+ inClass:classOrNil to:setOfTypes.
]
].
^ setOfTypes.
@@ -4698,10 +4698,7 @@
!
addClassesOfExpression:expr inClass:classOrNil to:setOfTypes
- |cls exprSelector exprVal varName varScope instVarClass valClass
- msgSelector msgReceiver msgArg1
- receiverClasses receiverClass
- arg1Classes mthd|
+ |cls exprVal varName varScope instVarClass sym|
expr isLiteral ifTrue:[
exprVal := expr value.
@@ -4761,147 +4758,41 @@
setOfTypes addAll:(self classesOfInstVarNamed:varName inClass:instVarClass).
].
].
+ varName isUppercaseFirst ifTrue:[
+ sym := varName asSymbolIfInterned.
+ sym notNil ifTrue:[
+ exprVal := (Smalltalk at:sym).
+ exprVal notNil ifTrue:[
+ setOfTypes addAll:(exprVal class).
+ ]
+ ].
+ ].
^ setOfTypes
].
expr isMessage ifTrue:[
- 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 knowlegde here
- receiverClasses := self classesOfNode:msgReceiver.
- receiverClass := receiverClasses size == 1 ifTrue:[receiverClasses anElement] ifFalse:[nil].
-
- receiverClass notNil ifTrue:[
- ( #(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 arg1.
- 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
- ].
- ].
- ].
+ self addClassesOfMessage:expr inClass:classOrNil to:setOfTypes.
+ ^ setOfTypes
+ ].
+
^ setOfTypes
!
addClassesOfInstVarNamed:varName inClass:aClass to:setOfTypes
- |instIndex|
+ |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|
@@ -4969,6 +4860,157 @@
^ 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 arg1.
+ 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)
@@ -5001,6 +5043,59 @@
^ 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.
@@ -5086,7 +5181,7 @@
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 method impl|
+ |nodeSelector nodeReceiver isNonDestructive receiverValue arg1Value|
aNode isLiteral ifTrue:[
^ aNode value
@@ -5099,7 +5194,7 @@
nodeSelector := aNode selector.
nodeReceiver := aNode receiver.
- "/ some hardwired knowlegde here
+ "/ some hardwired knowledge here
classOrNil notNil ifTrue:[
(nodeReceiver isSelf and:[nodeSelector = #'class']) ifTrue:[
^ classOrNil
@@ -5108,33 +5203,17 @@
receiverValue := self valueOfNode:nodeReceiver.
receiverValue notNil ifTrue:[
- isNonDestructive := false.
-
- "/ some are wellknown
- nodeSelector == #size ifTrue:[
- "/ mhm - be conservative; someone might have redefined #size
- impl := receiverValue class whichClassIncludesSelector:nodeSelector.
- "/ more hardwired stuff.
- ((impl == Object) or:[(impl == String) or:[impl isSubclassOf:Collection]]) ifTrue:[
- isNonDestructive := true.
- ].
- ].
-
- ( #( basicSize
- class theMetaclass theNonMetaclass ) includes:nodeSelector) ifTrue:[
- isNonDestructive := true.
- ] ifFalse:[
- "/ follow non-destructive accessors
- method := receiverValue class lookupMethodFor:nodeSelector.
- method notNil ifTrue:[
- (ParseTreeSearcher methodIsJustReturningSomething:method) ifTrue:[
- "/ we can savely call that method to get the current value
- isNonDestructive := true.
- ].
- ].
- ].
+ isNonDestructive := self isNonDestructive:aNode whenSentTo:receiverValue.
isNonDestructive ifTrue:[
- ^ receiverValue perform: nodeSelector.
+ nodeSelector argumentCount == 1 ifTrue:[
+ arg1Value := self valueOfNode:(aNode arg1).
+ [
+ ^ receiverValue perform: nodeSelector with: arg1Value.
+ ] on:Error do:[
+ ^ nil
+ ]
+ ].
+ ^ receiverValue perform: nodeSelector.
].
].
].