--- a/Behavior.st Fri Jun 20 09:25:31 2003 +0200
+++ b/Behavior.st Fri Jun 20 09:32:25 2003 +0200
@@ -760,61 +760,6 @@
! !
-!Behavior class methodsFor:'private'!
-
-flushSubclassInfo
- "throw away (forget) the cached subclass information, as created
- by #subclassInfo.
- This is private protocol"
-
- SubclassInfo := nil.
-
- "
- Class flushSubclassInfo
- "
-
- "Modified: 22.1.1997 / 18:39:36 / cg"
-!
-
-subclassInfo
- "build & return a dictionary, containing the set of subclass
- for each class. This information is kept until explicitely flushed
- by #flushSubclassInfo.
- This cache is used internally, for enumerators like #allSubclasses
- or #allSubclassesDo:, to avoid repeated recursive walks over the class
- hierarchy.
- This is private protocol."
-
- |d|
-
- SubclassInfo notNil ifTrue:[^ SubclassInfo].
-
- d := IdentityDictionary new.
- Smalltalk allClassesDo:[:aClass |
- |superCls setToAddSubclass|
-
- aClass isMeta not ifTrue:[
- superCls := aClass superclass.
- superCls notNil ifTrue:[
- setToAddSubclass := d at:superCls ifAbsent:nil.
- setToAddSubclass isNil ifTrue:[
- d at:superCls put:(Set with:aClass).
- ] ifFalse:[
- setToAddSubclass add:aClass
- ]
- ]
- ].
- ].
- SubclassInfo := d.
- ^ d
-
- "
- Class subclassInfo
- "
-
- "Modified: 22.1.1997 / 18:44:59 / cg"
-! !
-
!Behavior class methodsFor:'queries'!
definitionSelectorFirstParts
@@ -881,7 +826,6 @@
"Modified: 23.4.1996 / 15:55:52 / cg"
! !
-
!Behavior methodsFor:'Compatibility-Dolphin'!
allSubinstances
@@ -1208,7 +1152,7 @@
|owner ns name|
- SubclassInfo := nil.
+ Class flushSubclassInfo.
"must flush caches since lookup chain changes"
ObjectMemory flushCaches.
@@ -1218,24 +1162,24 @@
"/ full name and answering with Smalltalk to a nameSpace query.
(owner := self owningClass) notNil ifTrue:[
- ns := owner.
- name := self nameWithoutPrefix asSymbol
+ ns := owner.
+ name := self nameWithoutPrefix asSymbol
] ifFalse:[
- ns := Smalltalk.
- name := self name
+ ns := Smalltalk.
+ name := self name
].
Class classRedefinitionSignal answer:#keep do:[
- Class nameSpaceQuerySignal answer:ns
- do:[
- aClass
- perform:(self definitionSelector)
- withArguments:(Array with:name
- with:(self instanceVariableString)
- with:(self classVariableString)
- with:'' "/ pool
- with:(self category)).
- ]
+ Class nameSpaceQuerySignal answer:ns
+ do:[
+ aClass
+ perform:(self definitionSelector)
+ withArguments:(Array with:name
+ with:(self instanceVariableString)
+ with:(self classVariableString)
+ with:'' "/ pool
+ with:(self category)).
+ ]
]
"Modified: / 20.6.1998 / 18:17:37 / cg"
@@ -1675,7 +1619,7 @@
toDo addAll:self theNonMetaclass subclasses.
[toDo notEmpty] whileTrue:[
cls := toDo removeFirst.
- toDo addAll:(cls subclasses).
+ toDo addAll:cls subclasses.
meta ifTrue:[
aBlock value:cls class.
] ifFalse:[
@@ -1698,8 +1642,8 @@
"/ ]
"
- Collection allSubclassesDo:[:c | Transcript showCR:(c name)]
- Collection class allSubclassesDo:[:c | Transcript showCR:(c name)]
+ Collection allSubclassesInOrderDo:[:c | Transcript showCR:(c name)]
+ Collection class allSubclassesInOrderDo:[:c | Transcript showCR:(c name)]
"
"Modified: / 25.10.1997 / 21:17:13 / cg"
@@ -1768,42 +1712,12 @@
This will only enumerate globally known classes - for anonymous
behaviors, you have to walk over all instances of Behavior."
- |coll|
-
- self isMeta ifTrue:[
- "/ metaclasses are not found via Smalltalk allClassesDo:
- "/ here, walk over classes and enumerate corresponding metas.
- self soleInstance subclassesDo:[:aSubClass |
- aBlock value:(aSubClass class)
- ].
- ^ self
- ].
-
- "/ use cached information (avoid class hierarchy search)
- "/ if possible
-
- SubclassInfo isNil ifTrue:[
- Behavior subclassInfo
- ].
- SubclassInfo notNil ifTrue:[
- coll := SubclassInfo at:self ifAbsent:nil.
- coll notNil ifTrue:[
- coll do:aBlock.
- ].
- ^ self
- ].
-
+ "Do it the hard way. Subclasses redefine this"
Smalltalk allClassesDo:[:aClass |
(aClass superclass == self) ifTrue:[
aBlock value:aClass
]
]
-
- "
- Collection subclassesDo:[:c | Transcript showCR:(c name)]
- "
-
- "Modified: 22.1.1997 / 18:44:01 / cg"
!
whichClassSatisfies: aBlock
@@ -1830,6 +1744,23 @@
Collection withAllSubclassesDo:[:c | Transcript showCR:(c name)]
Collection class withAllSubclassesDo:[:c | Transcript showCR:(c name)]
"
+!
+
+withAllSuperclassesDo:aBlock
+ "evaluate aBlock for the class and all of its superclasses"
+
+ |theSuperClass|
+
+ aBlock value:self.
+ theSuperClass := self superclass.
+ [theSuperClass notNil] whileTrue:[
+ aBlock value:theSuperClass.
+ theSuperClass := theSuperClass superclass
+ ].
+
+ "
+ String withAllSuperclassesDo:[:each| Transcript showCR:each]
+ "
! !
!Behavior methodsFor:'initialization'!
@@ -2768,18 +2699,6 @@
be correct, since no caches are flushed.
Therefore: do NOT use it; use Behavior>>superclass: (or flush the caches, at least)"
- |info|
-
- SubclassInfo notNil ifTrue:[
- "/ flush/update the subclass information
-
- "/ if my class is already contained
- (info := SubclassInfo at:aClass ifAbsent:nil) notNil ifTrue:[
- info add:self
- ] ifFalse:[
- SubclassInfo := nil. "/ flush it
- ]
- ].
superclass := aClass
"Modified: 3.3.1997 / 13:27:00 / cg"
@@ -3224,7 +3143,7 @@
"return true, if its allowed to create subclasses of the receiver.
This method is redefined in SmallInteger and UndefinedObject, since
instances are detected by their pointer-fields, i.e. they do not have
- a class entry (you dont have to understand this :-)"
+ a class entry (you don't have to understand this :-)"
^ true
!
@@ -3278,29 +3197,11 @@
|newColl|
- "/ use cached information (avoid class hierarchy search)
- "/ if possible
-
- SubclassInfo notNil ifTrue:[
- newColl := SubclassInfo at:self ifAbsent:nil.
- newColl notNil ifTrue:[^ newColl asOrderedCollection]
- ].
-
newColl := OrderedCollection new.
self subclassesDo:[:aClass |
newColl add:aClass
].
- SubclassInfo notNil ifTrue:[
- SubclassInfo at:self put:newColl.
- ].
- ^ newColl
-
- "
- Class flushSubclassInfo.
- Collection subclasses
- "
-
- "Modified: 22.1.1997 / 18:43:52 / cg"
+ ^ newColl.
!
superclasses
@@ -3345,23 +3246,6 @@
"
String withAllSuperclasses
"
-!
-
-withAllSuperclassesDo:aBlock
- "evaluate aBlock for the class and all of its superclasses"
-
- |theSuperClass|
-
- aBlock value:self.
- theSuperClass := self superclass.
- [theSuperClass notNil] whileTrue:[
- aBlock value:theSuperClass.
- theSuperClass := theSuperClass superclass
- ].
-
- "
- String withAllSuperclassesDo:[:each| Transcript showCR:each]
- "
! !
!Behavior methodsFor:'queries-instances'!
@@ -4422,5 +4306,5 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.227 2003-06-16 09:22:20 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.228 2003-06-20 07:31:14 stefan Exp $'
! !
--- a/Class.st Fri Jun 20 09:25:31 2003 +0200
+++ b/Class.st Fri Jun 20 09:32:25 2003 +0200
@@ -253,6 +253,59 @@
"Created: / 19.6.1998 / 02:09:06 / cg"
! !
+!Class class methodsFor:'private'!
+
+flushSubclassInfo
+ "throw away (forget) the cached subclass information, as created
+ by #subclassInfo.
+ This is private protocol"
+
+ SubclassInfo := nil.
+
+ "
+ Class flushSubclassInfo
+ "
+
+ "Modified: 22.1.1997 / 18:39:36 / cg"
+!
+
+subclassInfo
+ "build & return a dictionary, containing the set of subclass
+ for each class. This information is kept until explicitely flushed
+ by #flushSubclassInfo.
+ This cache is used internally, for enumerators like #allSubclasses
+ or #allSubclassesDo:, to avoid repeated recursive walks over the class
+ hierarchy.
+ This is private protocol."
+
+ |d|
+
+ SubclassInfo notNil ifTrue:[^ SubclassInfo].
+
+ d := IdentityDictionary new.
+ Smalltalk allClassesDo:[:aClass |
+ |superCls setToAddSubclass|
+
+ superCls := aClass superclass.
+ superCls notNil ifTrue:[
+ setToAddSubclass := d at:superCls ifAbsent:nil.
+ setToAddSubclass isNil ifTrue:[
+ d at:superCls put:(Set with:aClass).
+ ] ifFalse:[
+ setToAddSubclass add:aClass
+ ]
+ ]
+ ].
+ SubclassInfo := d.
+ ^ d
+
+ "
+ Class subclassInfo
+ "
+
+ "Modified: 22.1.1997 / 18:44:59 / cg"
+! !
+
!Class class methodsFor:'queries'!
isBuiltInClass
@@ -1976,6 +2029,40 @@
self privateClasses do:aBlock
!
+subclassesDo:aBlock
+ "evaluate the argument, aBlock for all immediate subclasses.
+ This will only enumerate globally known classes - for anonymous
+ behaviors, you have to walk over all instances of Behavior."
+
+ |coll|
+
+ "/ use cached information (avoid class hierarchy search)
+ "/ if possible
+
+ SubclassInfo isNil ifTrue:[
+ Class subclassInfo
+ ].
+ SubclassInfo notNil ifTrue:[
+ coll := SubclassInfo at:self ifAbsent:nil.
+ coll notNil ifTrue:[
+ coll do:aBlock.
+ ].
+ ^ self
+ ].
+
+ Smalltalk allClassesDo:[:aClass |
+ (aClass superclass == self) ifTrue:[
+ aBlock value:aClass
+ ]
+ ]
+
+ "
+ Collection subclassesDo:[:c | Transcript showCR:(c name)]
+ "
+
+ "Modified: 22.1.1997 / 18:44:01 / cg"
+!
+
withAllPrivateClassesDo:aBlock
"evaluate aBlock on myself and all of my private classes (if any).
This recurses into private classes of private classes.
@@ -3500,6 +3587,31 @@
"set the primitiveVariable string (no change notifications)"
^ self setAttribute:#primitiveVariables to:aString
+!
+
+setSuperclass:aClass
+ "set the superclass of the receiver.
+ this method is for special uses only - there will be no recompilation
+ and no change record written here. Also, if the receiver class has
+ already been in use, future operation of the system is not guaranteed to
+ be correct, since no caches are flushed.
+ Therefore: do NOT use it; use Behavior>>superclass: (or flush the caches, at least).
+
+ Redefined here to take care of subclass caching"
+
+ |info|
+
+ SubclassInfo notNil ifTrue:[
+ "/ flush/update the subclass information
+
+ "/ if my class is already contained
+ (info := SubclassInfo at:aClass ifAbsent:nil) notNil ifTrue:[
+ info add:self
+ ] ifFalse:[
+ SubclassInfo := nil. "/ flush it
+ ]
+ ].
+ super setSuperclass:aClass
! !
!Class methodsFor:'private-changes management'!
@@ -3726,6 +3838,36 @@
"Modified: 18.4.1997 / 20:55:34 / cg"
!
+subclasses
+ "return a collection of the direct subclasses of the receiver"
+
+ |newColl|
+
+ "/ use cached information (avoid class hierarchy search)
+ "/ if possible
+
+ SubclassInfo notNil ifTrue:[
+ newColl := SubclassInfo at:self ifAbsent:nil.
+ newColl notNil ifTrue:[^ newColl asOrderedCollection]
+ ].
+
+ newColl := OrderedCollection new.
+ self subclassesDo:[:aClass |
+ newColl add:aClass
+ ].
+ SubclassInfo notNil ifTrue:[
+ SubclassInfo at:self put:newColl.
+ ].
+ ^ newColl
+
+ "
+ Class flushSubclassInfo.
+ Collection subclasses
+ "
+
+ "Modified: 22.1.1997 / 18:43:52 / cg"
+!
+
wasAutoloaded
"return true, if this class came into the system via an
autoload; false otherwise.
@@ -4889,5 +5031,5 @@
!Class class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.437 2003-06-16 13:57:03 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.438 2003-06-20 07:32:25 stefan Exp $'
! !
--- a/Metaclass.st Fri Jun 20 09:25:31 2003 +0200
+++ b/Metaclass.st Fri Jun 20 09:32:25 2003 +0200
@@ -330,6 +330,19 @@
instAndClassSelectorsAndMethodsDo:aTwoArgBlock
myClass instAndClassSelectorsAndMethodsDo:aTwoArgBlock
+!
+
+subclassesDo:aBlock
+ "evaluate the argument, aBlock for all immediate subclasses.
+ This will only enumerate globally known classes - for anonymous
+ behaviors, you have to walk over all instances of Behavior."
+
+ "metaclasses are not found via Smalltalk allClassesDo:
+ here, walk over classes and enumerate corresponding metas"
+
+ self soleInstance subclassesDo:[:aSubClass |
+ aBlock value:aSubClass class
+ ].
! !
!Metaclass methodsFor:'fileOut'!
@@ -450,6 +463,15 @@
^ myClass
!
+subclasses
+
+ ^ myClass subclasses collect:[:theNonMetaClass| theNonMetaClass class].
+
+ "
+ Integer class subclasses
+ "
+!
+
theMetaclass
"return myself; also implemented in my class object, which also returns me."
@@ -508,7 +530,7 @@
!Metaclass class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.184 2003-05-07 14:31:03 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.185 2003-06-20 07:31:57 stefan Exp $'
! !
Metaclass initialize!