--- 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!