DoWhatIMeanSupport.st
changeset 5070 8277d17c3e50
parent 5064 6a358957f3fd
child 5071 976ed2a22e27
equal deleted inserted replaced
5069:fac483ef2664 5070:8277d17c3e50
  1624 	codeCompletionForSmalltalkMethod:methodOrNilArg orClass:classOrNilArg context:contextOrNilArg codeView:codeViewArg into:actionBlock
  1624 	codeCompletionForSmalltalkMethod:methodOrNilArg orClass:classOrNilArg context:contextOrNilArg codeView:codeViewArg into:actionBlock
  1625 ! !
  1625 ! !
  1626 
  1626 
  1627 !DoWhatIMeanSupport methodsFor:'code completion-helpers'!
  1627 !DoWhatIMeanSupport methodsFor:'code completion-helpers'!
  1628 
  1628 
  1629 addClassesOfExpression:expr inClass:classOrNil to:setOfTypes
       
  1630     |cls exprSelector exprVal varName instVarClass valClass
       
  1631      msgSelector msgReceiver msgArg1
       
  1632      receiverClasses receiverClass 
       
  1633      arg1Classes mthd|
       
  1634     
       
  1635     expr isLiteral ifTrue:[
       
  1636         exprVal := expr value.
       
  1637         cls := exprVal class.         
       
  1638         (exprVal isArray or:[ exprVal isByteArray or:[ exprVal isString ]]) ifTrue:[
       
  1639             exprVal isImmutable ifTrue:[
       
  1640                 setOfTypes add:cls mutableClass.
       
  1641                 ^ self.    
       
  1642             ]
       
  1643         ].
       
  1644         setOfTypes add:cls. 
       
  1645         ^ self.    
       
  1646     ].
       
  1647     
       
  1648     expr isBlock ifTrue:[
       
  1649         setOfTypes add:Block. 
       
  1650         ^ self.
       
  1651     ].
       
  1652     (exprVal := self valueOfNode:expr) notNil ifTrue:[
       
  1653         "/ knowing the value is always great!!
       
  1654         setOfTypes add:exprVal class.
       
  1655         ^ self.
       
  1656     ].
       
  1657 
       
  1658     expr isVariable ifTrue:[
       
  1659         varName := expr name.
       
  1660         varName = 'self' ifTrue:[
       
  1661             setOfTypes add:(classOrNil ? UndefinedObject).
       
  1662             ^ self
       
  1663         ].
       
  1664         varName = 'super' ifTrue:[
       
  1665             classOrNil isNil 
       
  1666                 ifTrue:[setOfTypes add:Object]
       
  1667                 ifFalse:[setOfTypes add:classOrNil superclass].
       
  1668             ^ self.    
       
  1669         ].
       
  1670         varName = 'thisContext' ifTrue:[
       
  1671             setOfTypes add:Context.
       
  1672             ^ self
       
  1673         ].
       
  1674 
       
  1675         classOrNil notNil ifTrue:[
       
  1676             instVarClass := classOrNil whichClassDefinesInstVar:varName.
       
  1677             instVarClass notNil ifTrue:[
       
  1678                 setOfTypes addAll:(self classesOfInstVarNamed:varName inClass:instVarClass).
       
  1679             ].    
       
  1680         ].
       
  1681         ^ self
       
  1682     ].
       
  1683 
       
  1684     expr isMessage ifTrue:[
       
  1685         msgSelector := expr selector.
       
  1686 
       
  1687         "/ heuristic: quickly assume boolean for some:
       
  1688         (
       
  1689             #( 
       
  1690                 isNil notNil isEmpty isEmptyOrNil notEmpty notEmptyOrNil
       
  1691                 > >= < <= = == ~ ~=
       
  1692                 knownAsSymbol
       
  1693                 isMeta 
       
  1694                 includes: contains:
       
  1695                 not and: or:
       
  1696                 exists atEnd positive negative odd even
       
  1697             ) includes:msgSelector
       
  1698         ) ifTrue:[
       
  1699             setOfTypes add:True. "/ use True, because boolean does not include the full protocol
       
  1700             ^ self    
       
  1701         ].
       
  1702 
       
  1703         msgReceiver := expr receiver.
       
  1704 
       
  1705         "/ some hardwired knowlegde here
       
  1706         receiverClasses := self classesOfNode:msgReceiver.
       
  1707         receiverClass := receiverClasses size == 1 ifTrue:[receiverClasses anElement] ifFalse:[nil].
       
  1708 
       
  1709         receiverClass notNil ifTrue:[
       
  1710             ( #(copy shallowCopy) includes:exprSelector ) ifTrue:[
       
  1711                 setOfTypes addAll:receiverClasses.
       
  1712                 ^ self.
       
  1713             ].
       
  1714 
       
  1715             msgSelector == #theNonMetaclass ifTrue:[  
       
  1716                 setOfTypes add:receiverClass theNonMetaclass class.
       
  1717                 ^ self            
       
  1718             ].
       
  1719             msgSelector == #theMetaclass ifTrue:[  
       
  1720                 setOfTypes add:receiverClass theMetaclass class.
       
  1721                 ^ self
       
  1722             ].
       
  1723             msgSelector == #class ifTrue:[
       
  1724                 setOfTypes add:receiverClass class.
       
  1725                 ^ self.
       
  1726             ].
       
  1727 
       
  1728             receiverClass isBehavior ifTrue:[
       
  1729                 mthd := receiverClass lookupMethodFor:msgSelector.
       
  1730                 receiverClass isMeta ifTrue:[
       
  1731                     ( #( #'new' #'basicNew' #'new:' #'basicNew:' #'with:' #'with:with:') includes: msgSelector ) ifTrue:[
       
  1732                         setOfTypes add:receiverClass theNonMetaclass.
       
  1733                         ^ self.
       
  1734                     ].
       
  1735                     "/ if that method sends one of new/basicNew/new:/basicNew:, assume it returns an instance of itself
       
  1736                     mthd notNil ifTrue:[
       
  1737                         ( mthd sendsAny:#( #'new' #'basicNew' #'new:' #'basicNew:' )) ifTrue:[
       
  1738                             setOfTypes add:receiverClass theNonMetaclass.
       
  1739                             ^ self
       
  1740                         ].
       
  1741                     ].
       
  1742                 ] ifFalse:[
       
  1743                     mthd notNil ifTrue:[
       
  1744                         (ParseTreeSearcher methodIsSetterMethod:mthd) ifTrue:[
       
  1745                             setOfTypes add:receiverClass.
       
  1746                             ^ self
       
  1747                         ]
       
  1748                     ]
       
  1749                 ]
       
  1750             ].
       
  1751         ].
       
  1752 
       
  1753         ((msgSelector startsWith:'as')
       
  1754         and:[ (valClass := Smalltalk classNamed:(msgSelector copyFrom:3)) notNil ]
       
  1755         ) ifTrue:[
       
  1756             setOfTypes add:valClass.
       
  1757             ^ self
       
  1758         ].    
       
  1759 
       
  1760         ((msgSelector startsWith:'is')
       
  1761         and:[ (valClass := Smalltalk classNamed:(msgSelector copyFrom:3)) notNil ]
       
  1762         ) ifTrue:[
       
  1763             setOfTypes add:True. "/ Boolean - not boolean; it does not contain the full protocol (would not find ifTrue:)
       
  1764             ^ self.
       
  1765         ].    
       
  1766 
       
  1767         #(
       
  1768             size                    SmallInteger
       
  1769             hash                    SmallInteger
       
  1770             identityHash            SmallInteger
       
  1771             class                   Class
       
  1772             theMetaclass            Metaclass
       
  1773             theNonMetaclass         Class
       
  1774             fork                    Process
       
  1775             newProcess              Process
       
  1776         ) pairWiseDo:[:sel :clsName |
       
  1777             msgSelector == sel ifTrue:[ 
       
  1778                 setOfTypes add:(Smalltalk at:clsName).
       
  1779                 ^ self.
       
  1780             ].
       
  1781         ].
       
  1782 
       
  1783         ( #( bitAnd: bitOr: bitShift: rightShift: >> << highBit lowBit ) includes:msgSelector) ifTrue:[
       
  1784             "/ assume integer
       
  1785 
       
  1786             setOfTypes add:Integer.
       
  1787             ^ self
       
  1788         ].
       
  1789         ( #( + - * // \\ ) includes:msgSelector) ifTrue:[
       
  1790             "/ assume numeric
       
  1791 
       
  1792             setOfTypes add:Number.
       
  1793             ^ self
       
  1794         ].
       
  1795         msgSelector == #/ ifTrue:[
       
  1796             ((receiverClasses ? #()) contains:[:cls | cls includesBehavior:Number]) ifTrue:[
       
  1797                 setOfTypes add:Number.
       
  1798                 ^ self.
       
  1799             ].
       
  1800             msgArg1 := expr arg1.
       
  1801             arg1Classes := ((self classesOfNode:msgArg1) ? #()).
       
  1802             (arg1Classes contains:[:cls | cls includesBehavior:Number]) ifTrue:[
       
  1803                 setOfTypes add:Number.
       
  1804                 ^ self
       
  1805             ].    
       
  1806         ].    
       
  1807         ( #( construct: / ) includes:msgSelector) ifTrue:[
       
  1808             ((receiverClasses ? #()) contains:[:cls | cls includesBehavior:Filename]) ifTrue:[
       
  1809                 setOfTypes add:Filename.
       
  1810                 ^ self
       
  1811             ].
       
  1812         ].    
       
  1813     ].
       
  1814     ^ nil
       
  1815 !
       
  1816 
       
  1817 askUserForCompletion:what for:codeView at:position from:allTheBest
  1629 askUserForCompletion:what for:codeView at:position from:allTheBest
  1818     |list choice lastChoice|
  1630     |list choice lastChoice|
  1819 
  1631 
  1820     "/ cg: until the new stuff works,...
  1632     "/ cg: until the new stuff works,...
  1821     ^ self old_askUserForCompletion:what for:codeView from:allTheBest.
  1633     ^ self old_askUserForCompletion:what for:codeView from:allTheBest.
  1898     ].
  1710     ].
  1899     LastChoices at:what put:choice.
  1711     LastChoices at:what put:choice.
  1900     ^ choice
  1712     ^ choice
  1901 
  1713 
  1902     "Created: / 10-11-2006 / 14:00:53 / cg"
  1714     "Created: / 10-11-2006 / 14:00:53 / cg"
  1903 !
       
  1904 
       
  1905 classOfNode:aNode
       
  1906     "returns the class of a receiver, if it is well-known.
       
  1907      Otherwise nil (either unknown, or multiple possibilities)
       
  1908      When showing possible completions for a message,
       
  1909      it is a good idea to know what the kind receiver is."
       
  1910 
       
  1911     | classes |
       
  1912 
       
  1913     classes := self classesOfNode:aNode.
       
  1914     classes size == 1 ifTrue:[
       
  1915         ^ classes anElement
       
  1916     ].
       
  1917     ^ nil
       
  1918 !
       
  1919 
       
  1920 classesFromAssignmentTo:varName in:aTree
       
  1921     |classesFromAssignments|
       
  1922     
       
  1923     classesFromAssignments := Set new.
       
  1924     "/ assignments...
       
  1925     aTree allAssignmentNodesDo:[:eachAssignmentNode |
       
  1926         |exprCls leftSide|
       
  1927 
       
  1928         leftSide := eachAssignmentNode variable.
       
  1929         leftSide name = varName ifTrue:[
       
  1930             exprCls := self classOfNode:eachAssignmentNode value.
       
  1931             exprCls notNil ifTrue:[ 
       
  1932                 classesFromAssignments add:exprCls
       
  1933             ]
       
  1934         ]
       
  1935     ].
       
  1936     ^ classesFromAssignments.
       
  1937 !
       
  1938 
       
  1939 classesOfInstVarNamed:varName inClass:aClass
       
  1940     |setOfTypes instIndex|
       
  1941     
       
  1942     setOfTypes := IdentitySet new.
       
  1943     instIndex := aClass instVarIndexFor:varName.
       
  1944 
       
  1945     "/ look for instances
       
  1946     aClass allSubInstancesDo:[:i |
       
  1947         |varClass|
       
  1948         varClass := (i instVarAt:instIndex) class.
       
  1949         setOfTypes add:varClass.
       
  1950     ].  
       
  1951     
       
  1952     "/ look for assignments in code
       
  1953     aClass withAllSubclassesDo:[:eachClass |
       
  1954         eachClass methodDictionary do:[:m |
       
  1955             |tree code visitor|
       
  1956 
       
  1957             "/ quick check
       
  1958             code := m source.
       
  1959             (code notNil and:[code includesString:varName]) ifTrue:[
       
  1960                 tree := Parser parse:code class:eachClass.
       
  1961                 (tree notNil and:[tree ~~ #Error]) ifTrue:[
       
  1962                     visitor := PluggableParseNodeVisitor new. 
       
  1963                     visitor 
       
  1964                         actionForNodeClass:AssignmentNode 
       
  1965                         put:[:node |
       
  1966                             |val expr exprSelector|
       
  1967 
       
  1968                             node variable name = varName ifTrue:[
       
  1969                                 expr := node expression.
       
  1970                                 "/ only look for wellknown types on the right side.
       
  1971                                 expr isLiteral ifTrue:[
       
  1972                                     val := expr evaluate.
       
  1973                                     val isArray ifTrue:[
       
  1974                                         setOfTypes add:Array 
       
  1975                                     ] ifFalse:[
       
  1976                                         setOfTypes add:val class
       
  1977                                     ].
       
  1978                                 ] ifFalse:[
       
  1979                                     expr isMessage ifTrue:[
       
  1980                                         exprSelector := expr selector. 
       
  1981                                         ( #(+ - * /) includes:exprSelector ) ifTrue:[
       
  1982                                             setOfTypes add:Number
       
  1983                                         ] ifFalse:[    
       
  1984                                             ( #(// size) includes:exprSelector ) ifTrue:[
       
  1985                                                 setOfTypes add:Integer
       
  1986                                             ] ifFalse:[    
       
  1987                                                 ( #(copy shallowCopy) includes:exprSelector ) ifTrue:[
       
  1988                                                 ] ifFalse:[    
       
  1989                                                     ( #(new new: basicNew basicNew:) includes:exprSelector ) ifTrue:[
       
  1990                                                         expr receiver isGlobal ifTrue:[
       
  1991                                                             setOfTypes add:expr receiver evaluate
       
  1992                                                         ].    
       
  1993                                                     ] ifFalse:[    
       
  1994 self breakPoint:#cg.
       
  1995                                                     ]
       
  1996                                                 ]
       
  1997                                             ]
       
  1998                                         ]
       
  1999                                     ].    
       
  2000                                 ].    
       
  2001                             ].
       
  2002                             true "/ yes - visit subnodes
       
  2003                         ].        
       
  2004                     visitor visit:tree.
       
  2005                 ].    
       
  2006             ]    
       
  2007         ]
       
  2008     ].
       
  2009     ^ setOfTypes
       
  2010 !
       
  2011 
       
  2012 classesOfNode:aNode
       
  2013     "returns the set of possible classes of a receiver.
       
  2014      or nil if unknown.
       
  2015      When showing possible completions for a message,
       
  2016      it is a good idea to know what the kind receiver is."
       
  2017 
       
  2018     | setOfTypes|
       
  2019 
       
  2020     setOfTypes := Set new.
       
  2021     self addClassesOfExpression:aNode inClass:classOrNil to:setOfTypes.
       
  2022     ^ setOfTypes
       
  2023 !
  1715 !
  2024 
  1716 
  2025 codeCompletionForLiteralSymbol:nodeOrNil element:tokenOrNil considerAll:considerAll into:actionBlock
  1717 codeCompletionForLiteralSymbol:nodeOrNil element:tokenOrNil considerAll:considerAll into:actionBlock
  2026     "looking for all symbols is way too much and inprecise;
  1718     "looking for all symbols is way too much and inprecise;
  2027      experiment: only present symbols which are used by the class,
  1719      experiment: only present symbols which are used by the class,
  3943 	findNodeForInterval:interval in:source allowErrors:allowErrors
  3635 	findNodeForInterval:interval in:source allowErrors:allowErrors
  3944 	mustBeMethod:mustBeMethod mustBeExpression:false
  3636 	mustBeMethod:mustBeMethod mustBeExpression:false
  3945 !
  3637 !
  3946 
  3638 
  3947 findNodeForInterval:interval in:source allowErrors:allowErrors mustBeMethod:mustBeMethod mustBeExpression:mustBeExpression
  3639 findNodeForInterval:interval in:source allowErrors:allowErrors mustBeMethod:mustBeMethod mustBeExpression:mustBeExpression
  3948     "parse source, and find the node which is in the given interval (typically a selection or a word in the source).
  3640     "parse source, and find the node which is in the given interval 
       
  3641      (typically a selection or a word in the source).
  3949 
  3642 
  3950      parse it as expression or method;
  3643      parse it as expression or method;
  3951         if mustBeMethod is true, do not try as expression;
  3644         if mustBeMethod is true, do not try as expression;
  3952         if mustBeExpression is true, do not try as method
  3645         if mustBeExpression is true, do not try as method
  3953      expression syntax parsing is done in workspaces (doIt).
  3646      expression syntax parsing is done in workspaces (doIt).
  3955      Big hack as workaround a limitation of RBParser:
  3648      Big hack as workaround a limitation of RBParser:
  3956      in case of an error, the parent chain of a node is usually not yet set.
  3649      in case of an error, the parent chain of a node is usually not yet set.
  3957      (because the code is written as: 
  3650      (because the code is written as: 
  3958         parentNode addChild:(self parseChild)
  3651         parentNode addChild:(self parseChild)
  3959      and the parent-chain of the parsed child is set in addChild).
  3652      and the parent-chain of the parsed child is set in addChild).
  3960      But:
  3653      However:
  3961         when doing code completion, having invalid syntax to parse is the normal case.
  3654         when doing code completion, having invalid syntax to parse is the normal case.
       
  3655 
  3962      Workaround:
  3656      Workaround:
  3963         remember created nodes as the parse proceeds, and remember them.
  3657         remember created nodes as the parse proceeds.
  3964         Thus, I have the parent chain.
  3658         Thus, I can construct a partial the parent chain.
  3965     "
  3659     "
  3966 
  3660 
  3967     |intersectingNodes smallestIntersectingNode firstIntersectingNode
  3661     |intersectingNodes smallestIntersectingNode firstIntersectingNode
  3968      lastIntersectingNode onErrorBlock
  3662      lastIntersectingNode onErrorBlock
  3969      nodeGenerationHook parserClass parser currentScopeNodes bestNode|
  3663      nodeGenerationHook parserClass parser currentScopeNodes bestNode|
  4629 
  4323 
  4630     "Modified: / 04-07-2006 / 18:48:26 / fm"
  4324     "Modified: / 04-07-2006 / 18:48:26 / fm"
  4631     "Modified: / 01-05-2016 / 19:00:33 / cg"
  4325     "Modified: / 01-05-2016 / 19:00:33 / cg"
  4632 !
  4326 !
  4633 
  4327 
       
  4328 withoutSelectorsUnlikelyFor:aClass from:selectorsArg forPartial:partialSelector
       
  4329     "some heuristics;
       
  4330      as best selectors has been chosen by implemented methods for aClass,
       
  4331      some of them should be filtered (for example, at:/at:put:, which are
       
  4332      found in object, but only make sense for variable objects or those which do
       
  4333      implement at:put: themself.
       
  4334      I have currently no better idea than hardcoding stuff I found irritating..."
       
  4335 
       
  4336     |selectors noNilChecks noIsXXXChecks noNoXXXChecks noBecome 
       
  4337      noIndexedSetters noIndexedGetters noSizeQueries|
       
  4338 
       
  4339     aClass isNil ifTrue:[ ^ selectorsArg ].
       
  4340 
       
  4341     noNilChecks := noIsXXXChecks := noNoXXXChecks := noBecome := false.
       
  4342     noIndexedSetters := noIndexedGetters := noSizeQueries := false.
       
  4343 
       
  4344     selectors := (selectorsArg ? #()) asOrderedCollection.
       
  4345 
       
  4346     self tracePoint:#cg message:aClass.
       
  4347 
       
  4348     "/ actually meaning booleans here
       
  4349     (aClass == True or:[aClass == False]) ifTrue:[
       
  4350         noNilChecks := noBecome := true.
       
  4351         (partialSelector startsWith:'is') ifFalse:[ noIsXXXChecks := true ].
       
  4352         (partialSelector startsWith:'no') ifFalse:[ noNoXXXChecks := true ].
       
  4353     ].
       
  4354 
       
  4355     (aClass includesBehavior: ArithmeticValue) ifTrue:[ noNilChecks := true ].
       
  4356     (aClass includesBehavior: Symbol) ifTrue:[ noNilChecks := noBecome := noIndexedSetters := true ].
       
  4357     (aClass includesBehavior: Number) ifTrue:[ noBecome := true ].
       
  4358     (aClass includesBehavior: Block) ifTrue:[ noNilChecks := noIsXXXChecks := noNoXXXChecks := noBecome := true ].
       
  4359 
       
  4360     (aClass isMeta) ifTrue:[
       
  4361         noNilChecks := noBecome := true.
       
  4362         "/ remove messages which are only defined in Object and non-meta classes.
       
  4363         selectors := selectors reject:
       
  4364             [:sel |
       
  4365                 (Object implements:sel)
       
  4366                 and:[ (Smalltalk allImplementorsOf:sel) conform:[:impl | impl isMeta not]]
       
  4367             ].
       
  4368     ].
       
  4369 
       
  4370     aClass isVariable ifFalse:[
       
  4371         noIndexedGetters := noIndexedSetters := noSizeQueries := true.
       
  4372     ].
       
  4373 
       
  4374     noIndexedSetters ifTrue:[
       
  4375         #( #'at:put:' #'basicAt:put:') do:[:indexAccessSelector |
       
  4376             (aClass whichClassIncludesSelector:indexAccessSelector) == Object ifTrue:[
       
  4377                 selectors := selectors copyWithout:indexAccessSelector.
       
  4378             ].
       
  4379         ].
       
  4380     ].
       
  4381     noIndexedGetters ifTrue:[
       
  4382         #( #'at:' #'basicAt:') do:[:indexAccessSelector |
       
  4383             (aClass whichClassIncludesSelector:indexAccessSelector) == Object ifTrue:[
       
  4384                 selectors := selectors copyWithout:indexAccessSelector.
       
  4385             ].
       
  4386         ].
       
  4387     ].
       
  4388     noSizeQueries ifTrue:[
       
  4389         #( #size #basicSize ) do:[:indexAccessSelector |
       
  4390             (aClass whichClassIncludesSelector:indexAccessSelector) == Object ifTrue:[
       
  4391                 selectors := selectors copyWithout:indexAccessSelector.
       
  4392             ].
       
  4393         ].
       
  4394     ].
       
  4395 
       
  4396     noNilChecks ifTrue:[
       
  4397         selectors removeAllFoundIn:#(
       
  4398                     'isNil' 'notNil'
       
  4399                     'ifNil:' 'ifNotNil:' 'ifNil:ifNotNil:' 'ifNotNil:ifNil:' 'ifNotNilDo:'
       
  4400                     'ifEmpty:' 'ifNotEmpty:' 'ifNotEmptyDo:' 'ifEmpty:ifNotEmpty:'
       
  4401                     'ifEmpty:ifNotEmptyDo:' 'ifNotEmptyDo:ifEmpty:' 'ifEmptyDo:ifNotEmpty:'
       
  4402                   ).
       
  4403     ].
       
  4404     noIsXXXChecks ifTrue:[
       
  4405         "/ get rid of all isXXX selectors
       
  4406         selectors := selectors reject:[:sel | sel startsWith:'is'].
       
  4407     ].
       
  4408     noNoXXXChecks ifTrue:[
       
  4409         "/ get rid of all notXXX selectors
       
  4410         selectors := selectors reject:[:sel | sel startsWith:'no'].
       
  4411     ].
       
  4412     noBecome ifTrue:[
       
  4413         "/ get rid of all become* selectors
       
  4414         selectors := selectors reject:[:sel | sel startsWith:'become'].
       
  4415         selectors remove:#oneWayBecome: ifAbsent:[].
       
  4416         selectors := selectors reject:[:sel | sel startsWith:'changeClassTo'].
       
  4417     ].
       
  4418 
       
  4419     "/ actually: directly implemented selectors are more likely, so move them to top
       
  4420     selectors := (selectors select:[:sel | aClass implements:sel])
       
  4421                  ,
       
  4422                  (selectors reject:[:sel | aClass implements:sel]).
       
  4423 
       
  4424     ^ selectors
       
  4425 ! !
       
  4426 
       
  4427 !DoWhatIMeanSupport methodsFor:'code completion-helpers-naive type inference'!
       
  4428 
       
  4429 addClassesOfExpression:expr inClass:classOrNil to:setOfTypes
       
  4430     |cls exprSelector exprVal varName instVarClass valClass
       
  4431      msgSelector msgReceiver msgArg1
       
  4432      receiverClasses receiverClass 
       
  4433      arg1Classes mthd|
       
  4434     
       
  4435     expr isLiteral ifTrue:[
       
  4436         exprVal := expr value.
       
  4437         cls := exprVal class.         
       
  4438         (exprVal isArray or:[ exprVal isByteArray or:[ exprVal isString ]]) ifTrue:[
       
  4439             exprVal isImmutable ifTrue:[
       
  4440                 setOfTypes add:cls mutableClass.
       
  4441                 ^ self.    
       
  4442             ]
       
  4443         ].
       
  4444         setOfTypes add:cls. 
       
  4445         ^ self.    
       
  4446     ].
       
  4447     
       
  4448     expr isBlock ifTrue:[
       
  4449         setOfTypes add:Block. 
       
  4450         ^ self.
       
  4451     ].
       
  4452     (exprVal := self valueOfNode:expr) notNil ifTrue:[
       
  4453         "/ knowing the value is always great!!
       
  4454         setOfTypes add:exprVal class.
       
  4455         ^ self.
       
  4456     ].
       
  4457 
       
  4458     expr isVariable ifTrue:[
       
  4459         varName := expr name.
       
  4460         varName = 'self' ifTrue:[
       
  4461             setOfTypes add:(classOrNil ? UndefinedObject).
       
  4462             ^ self
       
  4463         ].
       
  4464         varName = 'super' ifTrue:[
       
  4465             classOrNil isNil 
       
  4466                 ifTrue:[setOfTypes add:Object]
       
  4467                 ifFalse:[setOfTypes add:classOrNil superclass].
       
  4468             ^ self.    
       
  4469         ].
       
  4470         varName = 'thisContext' ifTrue:[
       
  4471             setOfTypes add:Context.
       
  4472             ^ self
       
  4473         ].
       
  4474 
       
  4475         classOrNil notNil ifTrue:[
       
  4476             instVarClass := classOrNil whichClassDefinesInstVar:varName.
       
  4477             instVarClass notNil ifTrue:[
       
  4478                 setOfTypes addAll:(self classesOfInstVarNamed:varName inClass:instVarClass).
       
  4479             ].    
       
  4480         ].
       
  4481         ^ self
       
  4482     ].
       
  4483 
       
  4484     expr isMessage ifTrue:[
       
  4485         msgSelector := expr selector.
       
  4486 
       
  4487         "/ heuristic: quickly assume boolean for some:
       
  4488         (
       
  4489             #( 
       
  4490                 isNil notNil isEmpty isEmptyOrNil notEmpty notEmptyOrNil
       
  4491                 > >= < <= = == ~ ~=
       
  4492                 knownAsSymbol
       
  4493                 isMeta 
       
  4494                 includes: contains:
       
  4495                 not and: or:
       
  4496                 exists atEnd positive negative odd even
       
  4497             ) includes:msgSelector
       
  4498         ) ifTrue:[
       
  4499             setOfTypes add:True. "/ use True, because boolean does not include the full protocol
       
  4500             ^ self    
       
  4501         ].
       
  4502 
       
  4503         msgReceiver := expr receiver.
       
  4504 
       
  4505         "/ some hardwired knowlegde here
       
  4506         receiverClasses := self classesOfNode:msgReceiver.
       
  4507         receiverClass := receiverClasses size == 1 ifTrue:[receiverClasses anElement] ifFalse:[nil].
       
  4508 
       
  4509         receiverClass notNil ifTrue:[
       
  4510             ( #(copy shallowCopy) includes:exprSelector ) ifTrue:[
       
  4511                 setOfTypes addAll:receiverClasses.
       
  4512                 ^ self.
       
  4513             ].
       
  4514 
       
  4515             msgSelector == #theNonMetaclass ifTrue:[  
       
  4516                 setOfTypes add:receiverClass theNonMetaclass class.
       
  4517                 ^ self            
       
  4518             ].
       
  4519             msgSelector == #theMetaclass ifTrue:[  
       
  4520                 setOfTypes add:receiverClass theMetaclass class.
       
  4521                 ^ self
       
  4522             ].
       
  4523             msgSelector == #class ifTrue:[
       
  4524                 setOfTypes add:receiverClass class.
       
  4525                 ^ self.
       
  4526             ].
       
  4527 
       
  4528             receiverClass isBehavior ifTrue:[
       
  4529                 mthd := receiverClass lookupMethodFor:msgSelector.
       
  4530                 receiverClass isMeta ifTrue:[
       
  4531                     ( #( #'new' #'basicNew' #'new:' #'basicNew:' #'with:' #'with:with:') includes: msgSelector ) ifTrue:[
       
  4532                         setOfTypes add:receiverClass theNonMetaclass.
       
  4533                         ^ self.
       
  4534                     ].
       
  4535                     "/ if that method sends one of new/basicNew/new:/basicNew:, assume it returns an instance of itself
       
  4536                     mthd notNil ifTrue:[
       
  4537                         ( mthd sendsAny:#( #'new' #'basicNew' #'new:' #'basicNew:' )) ifTrue:[
       
  4538                             setOfTypes add:receiverClass theNonMetaclass.
       
  4539                             ^ self
       
  4540                         ].
       
  4541                     ].
       
  4542                 ] ifFalse:[
       
  4543                     mthd notNil ifTrue:[
       
  4544                         (ParseTreeSearcher methodIsSetterMethod:mthd) ifTrue:[
       
  4545                             setOfTypes add:receiverClass.
       
  4546                             ^ self
       
  4547                         ]
       
  4548                     ]
       
  4549                 ]
       
  4550             ].
       
  4551         ].
       
  4552 
       
  4553         ((msgSelector startsWith:'as')
       
  4554         and:[ (valClass := Smalltalk classNamed:(msgSelector copyFrom:3)) notNil ]
       
  4555         ) ifTrue:[
       
  4556             setOfTypes add:valClass.
       
  4557             ^ self
       
  4558         ].    
       
  4559 
       
  4560         ((msgSelector startsWith:'is')
       
  4561         and:[ (valClass := Smalltalk classNamed:(msgSelector copyFrom:3)) notNil ]
       
  4562         ) ifTrue:[
       
  4563             setOfTypes add:True. "/ Boolean - not boolean; it does not contain the full protocol (would not find ifTrue:)
       
  4564             ^ self.
       
  4565         ].    
       
  4566 
       
  4567         #(
       
  4568             size                    SmallInteger
       
  4569             hash                    SmallInteger
       
  4570             identityHash            SmallInteger
       
  4571             class                   Class
       
  4572             theMetaclass            Metaclass
       
  4573             theNonMetaclass         Class
       
  4574             fork                    Process
       
  4575             newProcess              Process
       
  4576         ) pairWiseDo:[:sel :clsName |
       
  4577             msgSelector == sel ifTrue:[ 
       
  4578                 setOfTypes add:(Smalltalk at:clsName).
       
  4579                 ^ self.
       
  4580             ].
       
  4581         ].
       
  4582 
       
  4583         ( #( bitAnd: bitOr: bitShift: rightShift: >> << highBit lowBit ) includes:msgSelector) ifTrue:[
       
  4584             "/ assume integer
       
  4585 
       
  4586             setOfTypes add:Integer.
       
  4587             ^ self
       
  4588         ].
       
  4589         ( #( + - * // \\ ) includes:msgSelector) ifTrue:[
       
  4590             "/ assume numeric
       
  4591 
       
  4592             setOfTypes add:Number.
       
  4593             ^ self
       
  4594         ].
       
  4595         msgSelector == #/ ifTrue:[
       
  4596             ((receiverClasses ? #()) contains:[:cls | cls includesBehavior:Number]) ifTrue:[
       
  4597                 setOfTypes add:Number.
       
  4598                 ^ self.
       
  4599             ].
       
  4600             msgArg1 := expr arg1.
       
  4601             arg1Classes := ((self classesOfNode:msgArg1) ? #()).
       
  4602             (arg1Classes contains:[:cls | cls includesBehavior:Number]) ifTrue:[
       
  4603                 setOfTypes add:Number.
       
  4604                 ^ self
       
  4605             ].    
       
  4606         ].    
       
  4607         ( #( construct: / ) includes:msgSelector) ifTrue:[
       
  4608             ((receiverClasses ? #()) contains:[:cls | cls includesBehavior:Filename]) ifTrue:[
       
  4609                 setOfTypes add:Filename.
       
  4610                 ^ self
       
  4611             ].
       
  4612         ].    
       
  4613     ].
       
  4614     ^ nil
       
  4615 !
       
  4616 
       
  4617 classOfNode:aNode
       
  4618     "returns the class of a receiver, if it is well-known.
       
  4619      Otherwise nil (either unknown, or multiple possibilities)
       
  4620      When showing possible completions for a message,
       
  4621      it is a good idea to know what the kind receiver is."
       
  4622 
       
  4623     | classes |
       
  4624 
       
  4625     classes := self classesOfNode:aNode.
       
  4626     classes size == 1 ifTrue:[
       
  4627         ^ classes anElement
       
  4628     ].
       
  4629     ^ nil
       
  4630 !
       
  4631 
       
  4632 classesFromAssignmentTo:varName in:aTree
       
  4633     |classesFromAssignments|
       
  4634     
       
  4635     classesFromAssignments := Set new.
       
  4636     "/ assignments...
       
  4637     aTree allAssignmentNodesDo:[:eachAssignmentNode |
       
  4638         |exprCls leftSide|
       
  4639 
       
  4640         leftSide := eachAssignmentNode variable.
       
  4641         leftSide name = varName ifTrue:[
       
  4642             exprCls := self classOfNode:eachAssignmentNode value.
       
  4643             exprCls notNil ifTrue:[ 
       
  4644                 classesFromAssignments add:exprCls
       
  4645             ]
       
  4646         ]
       
  4647     ].
       
  4648     ^ classesFromAssignments.
       
  4649 !
       
  4650 
       
  4651 classesOfInstVarNamed:varName inClass:aClass
       
  4652     |setOfTypes instIndex|
       
  4653     
       
  4654     setOfTypes := IdentitySet new.
       
  4655     instIndex := aClass instVarIndexFor:varName.
       
  4656 
       
  4657     "/ look for instances
       
  4658     aClass allSubInstancesDo:[:i |
       
  4659         |varClass|
       
  4660         varClass := (i instVarAt:instIndex) class.
       
  4661         setOfTypes add:varClass.
       
  4662     ].  
       
  4663     
       
  4664     "/ look for assignments in code
       
  4665     aClass withAllSubclassesDo:[:eachClass |
       
  4666         eachClass methodDictionary do:[:m |
       
  4667             |tree code visitor|
       
  4668 
       
  4669             "/ quick check
       
  4670             code := m source.
       
  4671             (code notNil and:[code includesString:varName]) ifTrue:[
       
  4672                 tree := Parser parse:code class:eachClass.
       
  4673                 (tree notNil and:[tree ~~ #Error]) ifTrue:[
       
  4674                     visitor := PluggableParseNodeVisitor new. 
       
  4675                     visitor 
       
  4676                         actionForNodeClass:AssignmentNode 
       
  4677                         put:[:node |
       
  4678                             |val expr exprSelector|
       
  4679 
       
  4680                             node variable name = varName ifTrue:[
       
  4681                                 expr := node expression.
       
  4682                                 "/ only look for wellknown types on the right side.
       
  4683                                 expr isLiteral ifTrue:[
       
  4684                                     val := expr evaluate.
       
  4685                                     val isArray ifTrue:[
       
  4686                                         setOfTypes add:Array 
       
  4687                                     ] ifFalse:[
       
  4688                                         setOfTypes add:val class
       
  4689                                     ].
       
  4690                                 ] ifFalse:[
       
  4691                                     expr isMessage ifTrue:[
       
  4692                                         exprSelector := expr selector. 
       
  4693                                         ( #(+ - * /) includes:exprSelector ) ifTrue:[
       
  4694                                             setOfTypes add:Number
       
  4695                                         ] ifFalse:[    
       
  4696                                             ( #(// size) includes:exprSelector ) ifTrue:[
       
  4697                                                 setOfTypes add:Integer
       
  4698                                             ] ifFalse:[    
       
  4699                                                 ( #(copy shallowCopy) includes:exprSelector ) ifTrue:[
       
  4700                                                 ] ifFalse:[    
       
  4701                                                     ( #(new new: basicNew basicNew:) includes:exprSelector ) ifTrue:[
       
  4702                                                         expr receiver isGlobal ifTrue:[
       
  4703                                                             setOfTypes add:expr receiver evaluate
       
  4704                                                         ].    
       
  4705                                                     ] ifFalse:[    
       
  4706 self breakPoint:#cg.
       
  4707                                                     ]
       
  4708                                                 ]
       
  4709                                             ]
       
  4710                                         ]
       
  4711                                     ].    
       
  4712                                 ].    
       
  4713                             ].
       
  4714                             true "/ yes - visit subnodes
       
  4715                         ].        
       
  4716                     visitor visit:tree.
       
  4717                 ].    
       
  4718             ]    
       
  4719         ]
       
  4720     ].
       
  4721     ^ setOfTypes
       
  4722 !
       
  4723 
       
  4724 classesOfNode:aNode
       
  4725     "returns the set of possible classes of a receiver.
       
  4726      or nil if unknown.
       
  4727      When showing possible completions for a message,
       
  4728      it is a good idea to know what the kind receiver is."
       
  4729 
       
  4730     | setOfTypes|
       
  4731 
       
  4732     setOfTypes := Set new.
       
  4733     self addClassesOfExpression:aNode inClass:classOrNil to:setOfTypes.
       
  4734     ^ setOfTypes
       
  4735 !
       
  4736 
  4634 valueAndKindOfVariable:aVariableName
  4737 valueAndKindOfVariable:aVariableName
  4635     "when showing possible completions for a variable,
  4738     "when showing possible completions for a variable,
  4636      it is a good idea to know what the reveiver's value is.
  4739      it is a good idea to know what the reveiver's value is.
  4637      Sigh - returns nil both if unknown AND if a real nil is there."
  4740      Sigh - returns nil both if unknown AND if a real nil is there."
  4638 
  4741 
  4770         ^ valueAndKind first.
  4873         ^ valueAndKind first.
  4771     ].
  4874     ].
  4772     ^ nil
  4875     ^ nil
  4773 
  4876 
  4774     "Modified: / 01-05-2016 / 12:41:30 / cg"
  4877     "Modified: / 01-05-2016 / 12:41:30 / cg"
  4775 !
       
  4776 
       
  4777 withoutSelectorsUnlikelyFor:aClass from:selectorsArg forPartial:partialSelector
       
  4778     "some heuristics;
       
  4779      as best selectors has been chosen by implemented methods for aClass,
       
  4780      some of them should be filtered (for example, at:/at:put:, which are
       
  4781      found in object, but only make sense for variable objects or those which do
       
  4782      implement at:put: themself.
       
  4783      I have currently no better idea than hardcoding stuff I found irritating..."
       
  4784 
       
  4785     |selectors noNilChecks noIsXXXChecks noNoXXXChecks noBecome 
       
  4786      noIndexedSetters noIndexedGetters noSizeQueries|
       
  4787 
       
  4788     aClass isNil ifTrue:[ ^ selectorsArg ].
       
  4789 
       
  4790     noNilChecks := noIsXXXChecks := noNoXXXChecks := noBecome := false.
       
  4791     noIndexedSetters := noIndexedGetters := noSizeQueries := false.
       
  4792 
       
  4793     selectors := (selectorsArg ? #()) asOrderedCollection.
       
  4794 
       
  4795     self tracePoint:#cg message:aClass.
       
  4796 
       
  4797     "/ actually meaning booleans here
       
  4798     (aClass == True or:[aClass == False]) ifTrue:[
       
  4799         noNilChecks := noBecome := true.
       
  4800         (partialSelector startsWith:'is') ifFalse:[ noIsXXXChecks := true ].
       
  4801         (partialSelector startsWith:'no') ifFalse:[ noNoXXXChecks := true ].
       
  4802     ].
       
  4803 
       
  4804     (aClass includesBehavior: ArithmeticValue) ifTrue:[ noNilChecks := true ].
       
  4805     (aClass includesBehavior: Symbol) ifTrue:[ noNilChecks := noBecome := noIndexedSetters := true ].
       
  4806     (aClass includesBehavior: Number) ifTrue:[ noBecome := true ].
       
  4807     (aClass includesBehavior: Block) ifTrue:[ noNilChecks := noIsXXXChecks := noNoXXXChecks := noBecome := true ].
       
  4808 
       
  4809     (aClass isMeta) ifTrue:[
       
  4810         noNilChecks := noBecome := true.
       
  4811         "/ remove messages which are only defined in Object and non-meta classes.
       
  4812         selectors := selectors reject:
       
  4813             [:sel |
       
  4814                 (Object implements:sel)
       
  4815                 and:[ (Smalltalk allImplementorsOf:sel) conform:[:impl | impl isMeta not]]
       
  4816             ].
       
  4817     ].
       
  4818 
       
  4819     aClass isVariable ifFalse:[
       
  4820         noIndexedGetters := noIndexedSetters := noSizeQueries := true.
       
  4821     ].
       
  4822 
       
  4823     noIndexedSetters ifTrue:[
       
  4824         #( #'at:put:' #'basicAt:put:') do:[:indexAccessSelector |
       
  4825             (aClass whichClassIncludesSelector:indexAccessSelector) == Object ifTrue:[
       
  4826                 selectors := selectors copyWithout:indexAccessSelector.
       
  4827             ].
       
  4828         ].
       
  4829     ].
       
  4830     noIndexedGetters ifTrue:[
       
  4831         #( #'at:' #'basicAt:') do:[:indexAccessSelector |
       
  4832             (aClass whichClassIncludesSelector:indexAccessSelector) == Object ifTrue:[
       
  4833                 selectors := selectors copyWithout:indexAccessSelector.
       
  4834             ].
       
  4835         ].
       
  4836     ].
       
  4837     noSizeQueries ifTrue:[
       
  4838         #( #size #basicSize ) do:[:indexAccessSelector |
       
  4839             (aClass whichClassIncludesSelector:indexAccessSelector) == Object ifTrue:[
       
  4840                 selectors := selectors copyWithout:indexAccessSelector.
       
  4841             ].
       
  4842         ].
       
  4843     ].
       
  4844 
       
  4845     noNilChecks ifTrue:[
       
  4846         selectors removeAllFoundIn:#(
       
  4847                     'isNil' 'notNil'
       
  4848                     'ifNil:' 'ifNotNil:' 'ifNil:ifNotNil:' 'ifNotNil:ifNil:' 'ifNotNilDo:'
       
  4849                     'ifEmpty:' 'ifNotEmpty:' 'ifNotEmptyDo:' 'ifEmpty:ifNotEmpty:'
       
  4850                     'ifEmpty:ifNotEmptyDo:' 'ifNotEmptyDo:ifEmpty:' 'ifEmptyDo:ifNotEmpty:'
       
  4851                   ).
       
  4852     ].
       
  4853     noIsXXXChecks ifTrue:[
       
  4854         "/ get rid of all isXXX selectors
       
  4855         selectors := selectors reject:[:sel | sel startsWith:'is'].
       
  4856     ].
       
  4857     noNoXXXChecks ifTrue:[
       
  4858         "/ get rid of all notXXX selectors
       
  4859         selectors := selectors reject:[:sel | sel startsWith:'no'].
       
  4860     ].
       
  4861     noBecome ifTrue:[
       
  4862         "/ get rid of all become* selectors
       
  4863         selectors := selectors reject:[:sel | sel startsWith:'become'].
       
  4864         selectors remove:#oneWayBecome: ifAbsent:[].
       
  4865         selectors := selectors reject:[:sel | sel startsWith:'changeClassTo'].
       
  4866     ].
       
  4867 
       
  4868     "/ actually: directly implemented selectors are more likely, so move them to top
       
  4869     selectors := (selectors select:[:sel | aClass implements:sel])
       
  4870                  ,
       
  4871                  (selectors reject:[:sel | aClass implements:sel]).
       
  4872 
       
  4873     ^ selectors
       
  4874 ! !
  4878 ! !
  4875 
  4879 
  4876 !DoWhatIMeanSupport methodsFor:'code completion-helpers-old'!
  4880 !DoWhatIMeanSupport methodsFor:'code completion-helpers-old'!
  4877 
  4881 
  4878 codeCompletionForLiteralSymbol:node inClass:classOrNil codeView:codeView
  4882 codeCompletionForLiteralSymbol:node inClass:classOrNil codeView:codeView