[squeak-dev] The Inbox: System-fbs.529.mczcommits at source.squeak.org commits at source.squeak.orgSun May 12 10:10:14 UTC 2013
Frank Shearar uploaded a new version of System to project The Inbox: http://source.squeak.org/inbox/System-fbs.529.mcz ==================== Summary ==================== Name: System-fbs.529 Author: fbs Time: 12 May 2013, 11:08:45.885 am UUID: 2b265558-36f0-4e86-87e3-2e6324dc8c66 Ancestors: System-fbs.528 More work on make SystemNavigation Environmentally aware. It skirts the issue of what to do with Smalltalk specialSelectors and Smalltalk presumedSentMessages in #allSentMessagesWithout:. My own feeling is that these two might be fine for the "top level" Environment (even though eventually there ought not to be such a thing), but that it's wrong to add these selectors to #allSentMessagesWithout:'s result: a particular Environment might never send these messages. =============== Diff against System-fbs.528 =============== Item was changed: ----- Method: SystemNavigation>>allBehaviorsDo: (in category 'query') ----- allBehaviorsDo: aBlock "Evaluate the argument, aBlock, for each kind of Behavior in the system (that is, Object and its subclasses and Traits). ar 7/15/1999: The code below will not enumerate any obsolete or anonymous behaviors for which the following should be executed: Smalltalk allObjectsDo:[:obj| obj isBehavior ifTrue:[aBlock value: obj]]. but what follows is way faster than enumerating all objects." + self environment allClassesAndTraitsDo: aBlock.! - self environment rootClasses do: - [:root| - root withAllSubclassesDo: - [:class| - class isMeta ifFalse: "The metaclasses are rooted at Class; don't include them twice." - [aBlock value: class; value: class class]]]. - ClassDescription allTraitsDo: aBlock! Item was changed: ----- Method: SystemNavigation>>allClasses (in category 'query') ----- allClasses "currently returns all the classes defined in Smalltalk but could be customized for dealing with environments and in such a case would return on really all the classes" + ^ self environment allClasses! - ^ Smalltalk allClasses - - ! Item was changed: ----- Method: SystemNavigation>>allClassesAndTraits (in category 'query') ----- allClassesAndTraits + ^ self environment allClassesAndTraits - ^ Smalltalk allClassesAndTraits ! Item was changed: ----- Method: SystemNavigation>>allClassesDo: (in category 'query') ----- allClassesDo: aBlock "currently returns all the classes defined in Smalltalk but could be customized for dealing with environments and in such a case would work on really all the classes" + ^ self environment allClassesDo: aBlock - ^ Smalltalk allClassesDo: aBlock ! Item was changed: ----- Method: SystemNavigation>>allGlobalRefsWithout: (in category 'query') ----- allGlobalRefsWithout: classesAndMessagesPair "Answer a set of symbols that may be refs to Global names. In some sense we should only need the associations, but this will also catch, eg, HTML tag types. This method computes its result in the absence of specified classes and messages." "may be a problem if namespaces are introduced as for the moment only Smalltalk is queried. sd 29/4/03" | globalRefs absentClasses absentSelectors | globalRefs := IdentitySet new: CompiledMethod instanceCount. absentClasses := classesAndMessagesPair first. absentSelectors := classesAndMessagesPair second. - self flag: #shouldBeRewrittenUsingSmalltalkAllClassesDo:. "sd 29/04/03" Cursor execute + showWhile: [self environment allClassesDo: + [:cls | ((absentClasses includes: cls name) - showWhile: [Smalltalk classNames - do: [:cName | ((absentClasses includes: cName) ifTrue: [{}] + ifFalse: [{cls. cls class}]) - ifFalse: [{Smalltalk at: cName. (Smalltalk at: cName) class}]) do: [:cl | (absentSelectors isEmpty ifTrue: [cl selectors] ifFalse: [cl selectors copyWithoutAll: absentSelectors]) do: [:sel | "Include all capitalized symbols for good measure" (cl compiledMethodAt: sel) literalsDo: [:m | ((m isSymbol) and: [m size > 0 and: [m first canBeGlobalVarInitial]]) ifTrue: [globalRefs add: m]. (m isMemberOf: Array) ifTrue: [m do: [:x | ((x isSymbol) and: [x size > 0 and: [x first canBeGlobalVarInitial]]) ifTrue: [globalRefs add: x]]]. m isVariableBinding ifTrue: [m key ifNotNil: [globalRefs add: m key]]]]]]]. ^ globalRefs! Item was changed: ----- Method: SystemNavigation>>allImplementedMessagesWithout: (in category 'query') ----- allImplementedMessagesWithout: behaviorsAndSelectorsPair "Answer a set of all the selectors that are implemented in the system, computed in the absence of the supplied behaviors and selectors." | selectors behaviorsToReject | selectors := IdentitySet new. behaviorsToReject := behaviorsAndSelectorsPair first asIdentitySet. + self environment allClassesAndTraitsDo: [ :behavior | - Smalltalk allClassesAndTraitsDo: [ :behavior | (behaviorsToReject includes: behavior name) ifFalse: [ selectors addAll: behavior selectors; addAll: behavior classSide selectors ] ]. behaviorsAndSelectorsPair second do: [ :each | selectors remove: each ]. ^selectors! Item was changed: ----- Method: SystemNavigation>>allSentMessagesWithout: (in category 'query') ----- allSentMessagesWithout: classesAndMessagesPair "Answer the set of selectors which are sent somewhere in the system, computed in the absence of the supplied classes and messages." | sent absentClasses absentSelectors | sent := IdentitySet new: CompiledMethod instanceCount. absentClasses := classesAndMessagesPair first. absentSelectors := classesAndMessagesPair second. - self flag: #shouldBeRewrittenUsingSmalltalkAllClassesDo:. "sd 29/04/03" Cursor execute showWhile: [ + self environment allClassesAndTraitsDo: [:cls | + ((absentClasses includes: cls name) - Smalltalk classNames , Smalltalk traitNames do: [:name | - ((absentClasses includes: name) ifTrue: [{}] + ifFalse: [{cls. cls classSide}]) - ifFalse: [{Smalltalk at: name. (Smalltalk at: name) classSide}]) do: [:each | (absentSelectors isEmpty ifTrue: [each selectors] ifFalse: [each selectors copyWithoutAll: absentSelectors]) do: [:sel | "Include all sels, but not if sent by self" (each compiledMethodAt: sel) literalsDo: [:m | (m isSymbol) ifTrue: ["might be sent" m == sel ifFalse: [sent add: m]]. (m isMemberOf: Array) ifTrue: ["might be performed" m do: [:x | (x isSymbol) ifTrue: [x == sel + ifFalse: [sent add: x]]]]]]]]]. + "The following may be sent without being in any literal frame" + Smalltalk specialSelectors do: [:sel | sent add: sel]. + Smalltalk presumedSentMessages do: [:sel | sent add: sel]. + ^ sent.! - ifFalse: [sent add: x]]]]]]]]. - "The following may be sent without being in any literal frame" - 1 - to: Smalltalk specialSelectorSize - do: [:index | sent - add: (Smalltalk specialSelectorAt: index)]]. - Smalltalk presumedSentMessages - do: [:sel | sent add: sel]. - ^ sent! Item was changed: ----- Method: SystemNavigation>>allUnusedClassesWithout: (in category 'query') ----- allUnusedClassesWithout: classesAndMessagesPair "Enumerates all classes in the system and returns a list of those that are apparently unused. A class is considered in use if it (a) has subclasses or (b) is referred to by some method or (c) has its name in use as a literal." "SystemNavigation new unusedClasses" | unused | + unused := self environment classNames asIdentitySet - unused := Smalltalk classNames asIdentitySet copyWithoutAll: (self allGlobalRefsWithout: classesAndMessagesPair). ^ unused reject: [:cName | | cl | + cl := self environment at: cName. - cl := Smalltalk at: cName. cl subclasses isEmpty not or: [cl inheritsFrom: FileDirectory]]!
More information about the Squeak-dev mailing list |