ClassBuilder.st
branchjv
changeset 17850 8fa257692c35
parent 17846 24edc476ac18
child 17851 09d75924b034
--- a/ClassBuilder.st	Thu Aug 18 10:37:43 2011 +0100
+++ b/ClassBuilder.st	Sat Aug 20 21:29:33 2011 +0100
@@ -20,7 +20,8 @@
 		nameKey newSuperClass superClassChange newClassVars newInstVars
 		classVarChange instVarChange recompileGlobalAccessTo
 		oldClassToBecomeNew oldClassInstVars newClassInstVars'
-	classVariableNames:''
+	classVariableNames:'LastNamespace LastNamespaceName LastClassesInNameSpace
+		LastClassNamesInNameSpace'
 	poolDictionaries:''
 	category:'Kernel-Support'
 !
@@ -41,6 +42,41 @@
 "
 ! !
 
+!ClassBuilder class methodsFor:'change & update'!
+
+initialize
+    Smalltalk addDependent:self.
+
+    "Created: / 18-08-2011 / 14:32:27 / cg"
+!
+
+update:something with:aParameter from:changedObject
+    "keep track of the namespace->classnames cache"
+
+    something == #projectOrganization ifTrue:[^ self].
+    something == #classVariables ifTrue:[^ self].
+    something == #methodInClass ifTrue:[^ self].
+
+    something == #newClass ifTrue:[
+        aParameter nameSpace name = LastNamespaceName ifTrue:[
+            LastClassNamesInNameSpace add:aParameter name
+        ].
+        ^ self.
+    ].
+    something == #classRemove ifTrue:[
+        aParameter nameSpace name = LastNamespaceName ifTrue:[
+            LastClassNamesInNameSpace remove:aParameter name
+        ].
+        ^ self.
+    ].
+
+    "/ Transcript show:something.
+    "/ Transcript show:' -> '.
+    "/ Transcript showCR:aParameter.
+
+    "Created: / 18-08-2011 / 14:32:16 / cg"
+! !
+
 !ClassBuilder class methodsFor:'checks'!
 
 checkForAliasesOf:oldClass with:newClass
@@ -237,29 +273,45 @@
 
 recompileGlobalAccessorsTo:aGlobalKey in:aNamespace except:someClass
     "when a new class enters a namespace, all accessors to the same-named
-     class in that namespace must be recompiled"
+     class in that namespace must be recompiled.
+     Because that is used heavily during package loading (for the same namespace), cache it."
+
+    |privateClassNames|
 
-    aNamespace allPrivateClassesDo:[:aClass |
-        aClass ~~ someClass ifTrue:[
-            aClass isLoaded ifTrue:[
+    aNamespace name = LastNamespaceName ifTrue:[
+        privateClassNames := LastClassNamesInNameSpace
+    ] ifFalse:[
+        privateClassNames := LastClassNamesInNameSpace := aNamespace allPrivateClasses 
+                                                                reject:[:cls | cls isJavaClass or:[cls isNameSpace] ]
+                                                                thenCollect:[:each | each name].   
+        LastNamespaceName := aNamespace name.
+    ].
+
+    privateClassNames do:[:eachClassName |
+        |cls|
+
+        cls := Smalltalk classNamed:eachClassName.
+        (cls notNil and:[cls ~~ someClass]) ifTrue:[
+            cls isLoaded ifTrue:[
 
 "/                Smalltalk silentLoading ifFalse:[
 "/                    Transcript showCR:'recompiling methods in ''' , aClass name , ''' accessing ''' , aGlobalKey , ''''.
 "/                    Transcript endEntry.
 "/                ].
 
-                aClass recompileMethodsAccessingGlobal:aGlobalKey.
-                aClass class recompileMethodsAccessingGlobal:aGlobalKey.
+                cls recompileMethodsAccessingGlobal:aGlobalKey.
+                cls class recompileMethodsAccessingGlobal:aGlobalKey.
                 "/ actually - must eventually recompile USERS of this namespace too
             ]
         ]
     ].
+
     aNamespace isNameSpace ifFalse:[
         aNamespace recompileMethodsAccessingGlobal:aGlobalKey.
         aNamespace class recompileMethodsAccessingGlobal:aGlobalKey.
     ].
 
-    "Modified: 31.1.1997 / 11:22:57 / cg"
+    "Modified: / 19-08-2011 / 01:00:49 / cg"
 !
 
 recompileMachineCodeMethodsIn:aClass
@@ -411,7 +463,7 @@
 
     oldClass notNil ifTrue:[
         (oldClass isRealNameSpace) ifTrue:[
-            (superClass == NameSpace or:[superClass isNamespace]) ifFalse:[
+            (superClass == NameSpace or:[superClass isNameSpace]) ifFalse:[
                 ClassBuildError raiseErrorString:'class exists as namespace'.
                 ^ nil.
             ].
@@ -599,7 +651,7 @@
 
     "Created: / 26-05-1996 / 11:55:26 / cg"
     "Modified: / 18-03-1999 / 18:23:31 / stefan"
-    "Modified: / 18-01-2011 / 17:56:34 / cg"
+    "Modified: / 19-08-2011 / 01:00:46 / cg"
 !
 
 newSubclassOf:baseClass type:typeOfClass instanceVariables:instanceVariables from:oldClassArg
@@ -1679,7 +1731,7 @@
             newSub classAttributes:t.
         ].        
         newSub package:(aSubclass package).
-        newSub setClassFilename:(oldClass classFilename).
+        newSub setClassFilename:(aSubclass classFilename).
         newSub setComment:(aSubclass comment).
         newSub setCategory:(aSubclass category).
         newSub instSize:(aSubclass instSize).
@@ -1824,7 +1876,7 @@
 
     "Created: / 29-10-1995 / 19:57:08 / cg"
     "Modified: / 01-04-1997 / 15:44:09 / stefan"
-    "Modified: / 18-01-2011 / 20:44:41 / cg"
+    "Modified: / 20-08-2011 / 17:42:53 / cg"
 !
 
 setPackageInNewClass:newClass fromOld:oldClass
@@ -1837,6 +1889,7 @@
         "/ new classes get the current package ...
         pkg := Class packageQuerySignal query.
     ] ifFalse:[
+        "/ cg: is this correct ?
         newClass setClassFilename:(oldClass getClassFilename).
 
         oldPkg := oldClass package.
@@ -1877,7 +1930,7 @@
         newClass package:pkg.
     ].
 
-    "Modified: / 06-10-2006 / 13:17:07 / cg"
+    "Modified (format): / 20-08-2011 / 17:44:15 / cg"
 !
 
 setupNewClass:newClass fromOld:oldClass
@@ -2226,12 +2279,15 @@
     "Modified: 9.1.1997 / 02:10:02 / cg"
 ! !
 
+
 !ClassBuilder class methodsFor:'documentation'!
 
 version
-    ^ '$Id: ClassBuilder.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+    ^ '$Id: ClassBuilder.st 10672 2011-08-20 20:29:33Z vranyj1 $'
 !
 
 version_CVS
-    ^ '§Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.99 2011/01/30 09:59:26 cg Exp §'
+    ^ 'Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.103 2011/08/20 15:44:43 cg Exp '
 ! !
+
+ClassBuilder initialize!