faster privateClassesSorted
authorClaus Gittinger <cg@exept.de>
Mon, 09 Feb 2004 23:44:13 +0100
changeset 7894 b803fe91b1cb
parent 7893 80df105ac17c
child 7895 28314109bb42
faster privateClassesSorted
Class.st
--- a/Class.st	Mon Feb 09 23:43:45 2004 +0100
+++ b/Class.st	Mon Feb 09 23:44:13 2004 +0100
@@ -1042,25 +1042,31 @@
     "return a collection of my private classes (if any).
      The classes are sorted by inheritance."
 
-    |classes|
+    |classes pivateClassesOf|
 
     classes := self privateClasses.
     (classes size > 0) ifTrue:[
-	classes := classes asOrderedCollection.
-	classes sort:[:a :b | a name < b name].
-	classes topologicalSort:[:a :b | 
-	    "/ a must come before b iff:
-	    "/    b is a subclass of a
-	    "/    b has a private class which is a subclass of a
+        classes := classes asOrderedCollection.
+        classes sort:[:a :b | a name < b name].
+
+        pivateClassesOf := IdentityDictionary new.
+        classes do:[:each | pivateClassesOf at:each put:(each allPrivateClasses)].
+
+        classes topologicalSort:[:a :b | 
+            "/ a must come before b iff:
+            "/    b is a subclass of a
+            "/    b has a private class which is a subclass of a
             
-	    |mustComeBefore|
-
-	    mustComeBefore := false.
-	    b withAllPrivateClassesDo:[:eachClassInB |
-		mustComeBefore := mustComeBefore or:[eachClassInB isSubclassOf:a]
-	    ].
-	    mustComeBefore
-	].
+            |mustComeBefore pivateClassesOfB|
+
+            mustComeBefore := b isSubclassOf:a.
+
+            pivateClassesOfB := pivateClassesOf at:b.
+            pivateClassesOfB do:[:eachClassInB |
+                mustComeBefore := mustComeBefore or:[eachClassInB isSubclassOf:a]
+            ].
+            mustComeBefore
+        ].
     ].
     ^ classes.
 
@@ -4834,5 +4840,5 @@
 !Class class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.453 2004-02-03 15:45:01 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.454 2004-02-09 22:44:13 cg Exp $'
 ! !