[squeak-dev] The Inbox: System-fbs.529.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun 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
|