--- a/Metaclass.st Sun Oct 29 19:08:45 1995 +0100
+++ b/Metaclass.st Sun Oct 29 20:27:04 1995 +0100
@@ -10,21 +10,30 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.8 on 29-oct-1995 at 20:01:09' !
+
Class subclass:#Metaclass
- instanceVariableNames:'myClass'
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Classes'
+ instanceVariableNames:'myClass'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Classes'
!
-Metaclass comment:'
-COPYRIGHT (c) 1988 by Claus Gittinger
- All Rights Reserved
+!Metaclass class methodsFor:'documentation'!
+
+version
+"
+$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.32 1995-10-29 19:26:47 cg Exp $
+"!
-$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.31 1995-09-08 16:46:05 claus Exp $
-'!
-
-!Metaclass class methodsFor:'documentation'!
+documentation
+"
+ every classes class is a subclass of Metaclass.
+ (i.e. every class is the sole instance of its Metaclass)
+ Metaclass provides support for creating new (sub)classes and/or
+ changing the definition of an already existing class.
+"
+!
copyright
"
@@ -38,21 +47,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-!
-
-version
-"
-$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.31 1995-09-08 16:46:05 claus Exp $
-"
-!
-
-documentation
-"
- every classes class is a subclass of Metaclass.
- (i.e. every class is the sole instance of its Metaclass)
- Metaclass provides support for creating new (sub)classes and/or
- changing the definition of an already existing class.
-"
! !
!Metaclass class methodsFor:'creating metaclasses'!
@@ -78,8 +72,375 @@
"
! !
+!Metaclass methodsFor:'accessing'!
+
+name
+ "return my name - that is the name of my sole class, with 'class'
+ appended. Currently, this is incompatible to ST-80 (which appends ' class')
+ and will be changed (have to check for side effects first ...)"
+
+ myClass isNil ifTrue:[
+ ^ 'someMetaclass'
+ ].
+"/ ^ myClass name , ' class'
+ ^ myClass name , 'class'
+! !
+
+!Metaclass methodsFor:'class instance variables'!
+
+instanceVariableNames:aString
+ "changing / adding class-inst vars -
+ this actually creates a new metaclass and class, leaving the original
+ classes around as obsolete classes. This may also be true for all subclasses,
+ if class instance variables are added/removed.
+ Existing instances continue to be defined by their original classes.
+
+ Time will show, if this is an acceptable behavior or if we should migrate
+ instances to become insts. of the new classes."
+
+ |newClass newMetaclass nClassInstVars oldClass
+ allSubclasses oldVars
+ oldNames newNames addedNames
+ oldOffsets newOffsets offset changeSet delta
+ oldToNew newSubMeta newSub oldSubMeta oldSuper
+ commonClassInstVars currentProject t|
+
+ "
+ cleanup needed here: extract common things with name:inEnvironment:...
+ and restructure things ... currently way too complex.
+ "
+
+ oldVars := self instanceVariableString.
+ aString = oldVars ifTrue:[
+"
+ Transcript showCr:'no change (', oldVars , ') -> (', aString , ')'.
+"
+ ^ self
+ ].
+
+ oldNames := oldVars asCollectionOfWords.
+ newNames := aString asCollectionOfWords.
+
+ oldNames = newNames ifTrue:[
+"
+ Transcript showCr:'no real change'.
+"
+ "no real change (just formatting)"
+ self setInstanceVariableString:aString.
+ ^ self
+ ].
+
+"/ "
+"/ let user confirm, if any name is no good (and was good before)
+"/ "
+"/ (oldNames inject:true
+"/ into:[:okSoFar :word |
+"/ okSoFar and:[word first isUppercase]
+"/ ])
+"/ ifTrue:[
+"/ "was ok before"
+"/ (newNames inject:true
+"/ into:[:okSoFar :word |
+"/ okSoFar and:[word first isUppercase]
+"/ ])
+"/ ifFalse:[
+"/ (self confirm:'class instance variable names should start with an uppercase letter
+"/(by convention only)
+"/
+"/install anyway ?' withCRs)
+"/ ifFalse:[
+"/ ^ nil
+"/ ]
+"/ ]
+"/ ].
+
+ nClassInstVars := newNames size.
+
+"
+ Transcript showCr:'create new class/metaclass'.
+"
+
+ "
+ create the new metaclass
+ "
+ newMetaclass := Metaclass new.
+ newMetaclass setSuperclass:superclass.
+ newMetaclass instSize:(superclass instSize + nClassInstVars).
+ (nClassInstVars ~~ 0) ifTrue:[
+ newMetaclass setInstanceVariableString:aString
+ ].
+"/ newMetaclass flags:(Behavior flagBehavior "flagNotIndexed").
+ newMetaclass setName:name.
+ newMetaclass classVariableString:classvars.
+ newMetaclass category:category.
+ newMetaclass setComment:(self comment).
+
+ "find the class which is my sole instance"
+
+ t := Smalltalk allClasses select:[:element | element class == self].
+ (t size ~~ 1) ifTrue:[
+ self error:'oops - I should have exactly one instance'.
+ ^ nil
+ ].
+ oldClass := t anElement.
+
+ "
+ create the new class
+ "
+ newClass := newMetaclass new.
+ newClass setSuperclass:(oldClass superclass).
+ newClass instSize:(oldClass instSize).
+ newClass flags:(oldClass flags).
+ newClass setName:(oldClass name).
+ newClass setInstanceVariableString:(oldClass instanceVariableString).
+ newClass classVariableString:(oldClass classVariableString).
+ newClass setComment:(oldClass comment).
+ newClass category:(oldClass category).
+ (t := oldClass primitiveSpec) notNil ifTrue:[
+ newClass primitiveSpec:t.
+ newClass setClassFilename:(oldClass classFilename).
+ ].
+
+ "/ set the new classes package
+
+ Project notNil ifTrue:[
+ currentProject := Project current.
+ currentProject notNil ifTrue:[
+ t := currentProject packageName.
+ newMetaclass package:t.
+ newClass package:t.
+ ]
+ ].
+
+ changeSet := Set new.
+ ((oldNames size == 0)
+ or:[newNames startsWith:oldNames]) ifTrue:[
+ "new variable(s) has/have been added - old methods still work"
+
+" "
+ Transcript showCr:'copying methods ...'.
+ Transcript endEntry.
+" "
+ self copyMethodsFrom:self for:newMetaclass.
+ self copyMethodsFrom:oldClass for:newClass.
+
+ "
+ but have to recompile methods accessing stuff now defined
+ (it might have been a global before ...)
+ "
+
+ addedNames := newNames select:[:nm | (oldNames includes:nm) not].
+" "
+ Transcript showCr:'recompiling methods accessing ' , addedNames printString , '...'.
+ Transcript endEntry.
+" "
+ "recompile class-methods"
+ newMetaclass recompileMethodsAccessingAny:addedNames.
+ ] ifFalse:[
+ "
+ create the changeSet; thats the set of class instvar names
+ which have changed their position or are new
+ "
+ offset := 0. oldOffsets := Dictionary new.
+ oldNames do:[:nm | offset := offset + 1. oldOffsets at:nm put:offset].
+ offset := 0. newOffsets := Dictionary new.
+ newNames do:[:nm | offset := offset + 1. newOffsets at:nm put:offset].
+
+ oldOffsets associationsDo:[:a |
+ |k|
+
+ k := a key.
+ (newOffsets includesKey:k) ifFalse:[
+ changeSet add:k
+ ] ifTrue:[
+ (a value ~~ (newOffsets at:k)) ifTrue:[
+ changeSet add:k
+ ]
+ ]
+ ].
+ newOffsets associationsDo:[:a |
+ |k|
+
+ k := a key.
+ (oldOffsets includesKey:k) ifFalse:[
+ changeSet add:k
+ ] ifTrue:[
+ (a value ~~ (oldOffsets at:k)) ifTrue:[
+ changeSet add:k
+ ]
+ ]
+ ].
+
+" "
+ Transcript showCr:'recompiling methods accessing ' , changeSet printString , ' ...'.
+ Transcript endEntry.
+" "
+ "
+ recompile class-methods
+ "
+ self copyInvalidatedMethodsFrom:self for:newMetaclass accessingAny:changeSet.
+ newMetaclass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidCodeObject).
+
+ self copyMethodsFrom:oldClass for:newClass.
+ ].
+
+ delta := newNames size - oldNames size.
+
+ "
+ get list of all subclasses - do before superclass is changed
+ "
+ allSubclasses := oldClass allSubclasses.
+ allSubclasses := allSubclasses asSortedCollection:[:a :b |
+ b isSubclassOf:a
+ ].
+
+ oldToNew := IdentityDictionary new.
+
+ "
+ create a new class tree, based on new version
+ "
+ allSubclasses do:[:aSubclass |
+ oldSuper := aSubclass superclass.
+ oldSubMeta := aSubclass class.
+
+ newSubMeta := Metaclass new.
+ oldSuper == oldClass ifTrue:[
+ newSubMeta setSuperclass:newMetaclass.
+ ] ifFalse:[
+ newSubMeta setSuperclass:(oldToNew at:oldSuper) class.
+ ].
+ newSubMeta instSize:(oldSubMeta instSize + delta).
+ newSubMeta flags:(oldSubMeta flags).
+ newSubMeta setName:(oldSubMeta name).
+ newSubMeta setInstanceVariableString:(oldSubMeta instanceVariableString).
+ newSubMeta classVariableString:(oldSubMeta classVariableString).
+ newSubMeta setComment:(oldSubMeta comment).
+ newSubMeta category:(oldSubMeta category).
+
+ newSub := newSubMeta new.
+ oldSuper == oldClass ifTrue:[
+ newSub setSuperclass:newClass.
+ ] ifFalse:[
+ newSub setSuperclass:(oldToNew at:oldSuper).
+ ].
+ newSub setSelectorArray:(aSubclass selectorArray).
+ newSub setMethodArray:(aSubclass methodArray).
+ newSub setName:(aSubclass name).
+ newSub classVariableString:(aSubclass classVariableString).
+ newSub setComment:(aSubclass comment).
+ newSub category:(aSubclass category).
+
+ oldToNew at:aSubclass put:newSub.
+
+ aSubclass category:'obsolete'.
+ aSubclass class category:'obsolete'.
+ ].
+
+ "recompile what needs to be"
+
+ delta == 0 ifTrue:[
+ "only have to recompile class methods accessing
+ class instvars from changeset
+ "
+
+ allSubclasses do:[:oldSubclass |
+ |newSubclass|
+
+ newSubclass := oldToNew at:oldSubclass.
+
+Transcript showCr:'recompiling class methods of ' , newSubclass class name ,
+ ' accessing any of ' , changeSet printString.
+
+ newSubclass class recompileMethodsAccessingAny:changeSet.
+ ]
+ ] ifFalse:[
+ "
+ have to recompile all class methods accessing class instvars
+ "
+ commonClassInstVars := oldClass class allInstVarNames.
+ changeSet do:[:v |
+ commonClassInstVars remove:v ifAbsent:[]
+ ].
+
+ allSubclasses do:[:oldSubclass |
+ |newSubclass classInstVars|
+
+ newSubclass := oldToNew at:oldSubclass.
+
+ classInstVars := newSubclass class allInstVarNames asSet.
+ classInstVars removeAll:commonClassInstVars.
+ classInstVars addAll:changeSet.
+
+Transcript showCr:'recompiling class methods of ' , newSubclass class name ,
+ ' accessing any of ' , classInstVars printString.
+
+ newSubclass class recompileMethodsAccessingAny:classInstVars.
+ ]
+ ].
+
+ self updateVersionString.
+ self addChangeRecordForClassInstvars:newClass.
+
+ "install all new classes"
+
+ Smalltalk at:(oldClass name asSymbol) put:newClass.
+ ObjectMemory flushCachesFor:oldClass.
+
+ allSubclasses do:[:oldClass |
+ |newClass|
+
+ newClass := oldToNew at:oldClass.
+"
+Transcript showCr:'install ' , newClass name , '(' , newClass category , ')' ,
+ ' as ' , newClass name.
+"
+ Smalltalk at:newClass name asSymbol put:newClass.
+ ObjectMemory flushCachesFor:oldClass.
+ ].
+
+ "tell dependents ..."
+
+ oldClass changed:#definition.
+ self changed:#definition.
+
+ ^ newMetaclass
+
+ "Created: 29.10.1995 / 19:57:08 / cg"
+! !
+
+!Metaclass methodsFor:'copying'!
+
+postCopy
+ "redefined - a copy may have a new instance"
+
+ myClass := nil
+! !
+
!Metaclass methodsFor:'creating classes'!
+new
+ "create & return a new metaclass (a classes class).
+ Since metaclasses only have one instance (the class),
+ complain if there is already one.
+ You get a new class by sending #new to the returned metaclass
+ (confusing - isn't it ?)"
+
+ |newClass|
+
+ myClass notNil ifTrue:[
+ ^ self error:'Each metaclass may only have one instance'.
+ ].
+ newClass := self basicNew.
+ newClass setSuperclass:Object
+ selectors:(Array new:0)
+ methods:(Array new:0)
+ instSize:0
+ flags:(Behavior flagBehavior).
+ newClass setName:'someClass'.
+ myClass := newClass.
+ ^ newClass
+!
+
name:newName inEnvironment:aSystemDictionary
subclassOf:aClass
instanceVariableNames:stringOfInstVarNames
@@ -713,385 +1074,6 @@
ObjectMemory flushCaches.
^ newClass
-!
-
-new
- "create & return a new metaclass (a classes class).
- Since metaclasses only have one instance (the class),
- complain if there is already one.
- You get a new class by sending #new to the returned metaclass
- (confusing - isn't it ?)"
-
- |newClass|
-
- myClass notNil ifTrue:[
- ^ self error:'Each metaclass may only have one instance'.
- ].
- newClass := self basicNew.
- newClass setSuperclass:Object
- selectors:(Array new:0)
- methods:(Array new:0)
- instSize:0
- flags:(Behavior flagBehavior).
- newClass setName:'someClass'.
- myClass := newClass.
- ^ newClass
-! !
-
-!Metaclass methodsFor:'class instance variables'!
-
-instanceVariableNames:aString
- "changing / adding class-inst vars -
- this actually creates a new metaclass and class, leaving the original
- classes around as obsolete classes. This may also be true for all subclasses,
- if class instance variables are added/removed.
- Existing instances continue to be defined by their original classes.
-
- Time will show, if this is an acceptable behavior or if we should migrate
- instances to become insts. of the new classes."
-
- |newClass newMetaclass nClassInstVars oldClass
- allSubclasses oldVars
- oldNames newNames addedNames
- oldOffsets newOffsets offset changeSet delta
- oldToNew newSubMeta newSub oldSubMeta oldSuper
- commonClassInstVars currentProject t|
-
- "
- cleanup needed here: extract common things with name:inEnvironment:...
- and restructure things ... currently way too complex.
- "
-
- oldVars := self instanceVariableString.
- aString = oldVars ifTrue:[
-"
- Transcript showCr:'no change (', oldVars , ') -> (', aString , ')'.
-"
- ^ self
- ].
-
- oldNames := oldVars asCollectionOfWords.
- newNames := aString asCollectionOfWords.
-
- oldNames = newNames ifTrue:[
-"
- Transcript showCr:'no real change'.
-"
- "no real change (just formatting)"
- self setInstanceVariableString:aString.
- ^ self
- ].
-
-"/ "
-"/ let user confirm, if any name is no good (and was good before)
-"/ "
-"/ (oldNames inject:true
-"/ into:[:okSoFar :word |
-"/ okSoFar and:[word first isUppercase]
-"/ ])
-"/ ifTrue:[
-"/ "was ok before"
-"/ (newNames inject:true
-"/ into:[:okSoFar :word |
-"/ okSoFar and:[word first isUppercase]
-"/ ])
-"/ ifFalse:[
-"/ (self confirm:'class instance variable names should start with an uppercase letter
-"/(by convention only)
-"/
-"/install anyway ?' withCRs)
-"/ ifFalse:[
-"/ ^ nil
-"/ ]
-"/ ]
-"/ ].
-
- nClassInstVars := newNames size.
-
-"
- Transcript showCr:'create new class/metaclass'.
-"
-
- "
- create the new metaclass
- "
- newMetaclass := Metaclass new.
- newMetaclass setSuperclass:superclass.
- newMetaclass instSize:(superclass instSize + nClassInstVars).
- (nClassInstVars ~~ 0) ifTrue:[
- newMetaclass setInstanceVariableString:aString
- ].
-"/ newMetaclass flags:(Behavior flagBehavior "flagNotIndexed").
- newMetaclass setName:name.
- newMetaclass classVariableString:classvars.
- newMetaclass category:category.
- newMetaclass setComment:(self comment).
-
- "find the class which is my sole instance"
-
- t := Smalltalk allClasses select:[:element | element class == self].
- (t size ~~ 1) ifTrue:[
- self error:'oops - I should have exactly one instance'.
- ^ nil
- ].
- oldClass := t anElement.
-
- "
- create the new class
- "
- newClass := newMetaclass new.
- newClass setSuperclass:(oldClass superclass).
- newClass instSize:(oldClass instSize).
- newClass flags:(oldClass flags).
- newClass setName:(oldClass name).
- newClass setInstanceVariableString:(oldClass instanceVariableString).
- newClass classVariableString:(oldClass classVariableString).
- newClass setComment:(oldClass comment).
- newClass category:(oldClass category).
- (t := oldClass primitiveSpec) notNil ifTrue:[
- newClass primitiveSpec:t.
- newClass setClassFilename:(oldClass classFilename).
- ].
-
- "/ set the new classes package
-
- Project notNil ifTrue:[
- currentProject := Project current.
- currentProject notNil ifTrue:[
- t := currentProject packageName.
- newMetaclass package:t.
- newClass package:t.
- ]
- ].
-
- changeSet := Set new.
- ((oldNames size == 0)
- or:[newNames startsWith:oldNames]) ifTrue:[
- "new variable(s) has/have been added - old methods still work"
-
-" "
- Transcript showCr:'copying methods ...'.
- Transcript endEntry.
-" "
- self copyMethodsFrom:self for:newMetaclass.
- self copyMethodsFrom:oldClass for:newClass.
-
- "
- but have to recompile methods accessing stuff now defined
- (it might have been a global before ...)
- "
-
- addedNames := newNames select:[:nm | (oldNames includes:nm) not].
-" "
- Transcript showCr:'recompiling methods accessing ' , addedNames printString , '...'.
- Transcript endEntry.
-" "
- "recompile class-methods"
- newMetaclass recompileMethodsAccessingAny:addedNames.
- ] ifFalse:[
- "
- create the changeSet; thats the set of class instvar names
- which have changed their position or are new
- "
- offset := 0. oldOffsets := Dictionary new.
- oldNames do:[:nm | offset := offset + 1. oldOffsets at:nm put:offset].
- offset := 0. newOffsets := Dictionary new.
- newNames do:[:nm | offset := offset + 1. newOffsets at:nm put:offset].
-
- oldOffsets associationsDo:[:a |
- |k|
-
- k := a key.
- (newOffsets includesKey:k) ifFalse:[
- changeSet add:k
- ] ifTrue:[
- (a value ~~ (newOffsets at:k)) ifTrue:[
- changeSet add:k
- ]
- ]
- ].
- newOffsets associationsDo:[:a |
- |k|
-
- k := a key.
- (oldOffsets includesKey:k) ifFalse:[
- changeSet add:k
- ] ifTrue:[
- (a value ~~ (oldOffsets at:k)) ifTrue:[
- changeSet add:k
- ]
- ]
- ].
-
-" "
- Transcript showCr:'recompiling methods accessing ' , changeSet printString , ' ...'.
- Transcript endEntry.
-" "
- "
- recompile class-methods
- "
- self copyInvalidatedMethodsFrom:self for:newMetaclass accessingAny:changeSet.
- newMetaclass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidCodeObject).
-
- self copyMethodsFrom:oldClass for:newClass.
- ].
-
- delta := newNames size - oldNames size.
-
- "
- get list of all subclasses - do before superclass is changed
- "
- allSubclasses := oldClass allSubclasses.
- allSubclasses := allSubclasses asSortedCollection:[:a :b |
- b isSubclassOf:a
- ].
-
- oldToNew := IdentityDictionary new.
-
- "
- create a new class tree, based on new version
- "
- allSubclasses do:[:aSubclass |
- oldSuper := aSubclass superclass.
- oldSubMeta := aSubclass class.
-
- newSubMeta := Metaclass new.
- oldSuper == oldClass ifTrue:[
- newSubMeta setSuperclass:newMetaclass.
- ] ifFalse:[
- newSubMeta setSuperclass:(oldToNew at:oldSuper) class.
- ].
- newSubMeta instSize:(oldSubMeta instSize + delta).
- newSubMeta flags:(oldSubMeta flags).
- newSubMeta setName:(oldSubMeta name).
- newSubMeta setInstanceVariableString:(oldSubMeta instanceVariableString).
- newSubMeta classVariableString:(oldSubMeta classVariableString).
- newSubMeta setComment:(oldSubMeta comment).
- newSubMeta category:(oldSubMeta category).
-
- newSub := newSubMeta new.
- oldSuper == oldClass ifTrue:[
- newSub setSuperclass:newClass.
- ] ifFalse:[
- newSub setSuperclass:(oldToNew at:oldSuper).
- ].
- newSub setSelectorArray:(aSubclass selectorArray).
- newSub setMethodArray:(aSubclass methodArray).
- newSub setName:(aSubclass name).
- newSub classVariableString:(aSubclass classVariableString).
- newSub setComment:(aSubclass comment).
- newSub category:(aSubclass category).
-
- oldToNew at:aSubclass put:newSub.
-
- aSubclass category:'obsolete'.
- aSubclass class category:'obsolete'.
- ].
-
- "recompile what needs to be"
-
- delta == 0 ifTrue:[
- "only have to recompile class methods accessing
- class instvars from changeset
- "
-
- allSubclasses do:[:oldSubclass |
- |newSubclass|
-
- newSubclass := oldToNew at:oldSubclass.
-
-Transcript showCr:'recompiling class methods of ' , newSubclass class name ,
- ' accessing any of ' , changeSet printString.
-
- newSubclass class recompileMethodsAccessingAny:changeSet.
- ]
- ] ifFalse:[
- "
- have to recompile all class methods accessing class instvars
- "
- commonClassInstVars := oldClass class allInstVarNames.
- changeSet do:[:v |
- commonClassInstVars remove:v ifAbsent:[]
- ].
-
- allSubclasses do:[:oldSubclass |
- |newSubclass classInstVars|
-
- newSubclass := oldToNew at:oldSubclass.
-
- classInstVars := newSubclass class allInstVarNames asSet.
- classInstVars removeAll:commonClassInstVars.
- classInstVars addAll:changeSet.
-
-Transcript showCr:'recompiling class methods of ' , newSubclass class name ,
- ' accessing any of ' , classInstVars printString.
-
- newSubclass class recompileMethodsAccessingAny:classInstVars.
- ]
- ].
-
- self addChangeRecordForClassInstvars:newClass.
-
- "install all new classes"
-
- Smalltalk at:(oldClass name asSymbol) put:newClass.
- ObjectMemory flushCachesFor:oldClass.
-
- allSubclasses do:[:oldClass |
- |newClass|
-
- newClass := oldToNew at:oldClass.
-"
-Transcript showCr:'install ' , newClass name , '(' , newClass category , ')' ,
- ' as ' , newClass name.
-"
- Smalltalk at:newClass name asSymbol put:newClass.
- ObjectMemory flushCachesFor:oldClass.
- ].
-
- "tell dependents ..."
-
- oldClass changed:#definition.
- self changed:#definition.
-
- ^ newMetaclass
-! !
-
-!Metaclass methodsFor:'copying'!
-
-postCopy
- "redefined - a copy may have a new instance"
-
- myClass := nil
-! !
-
-!Metaclass methodsFor:'accessing'!
-
-name
- "return my name - that is the name of my sole class, with 'class'
- appended. Currently, this is incompatible to ST-80 (which appends ' class')
- and will be changed (have to check for side effects first ...)"
-
- myClass isNil ifTrue:[
- ^ 'someMetaclass'
- ].
-"/ ^ myClass name , ' class'
- ^ myClass name , 'class'
-! !
-
-!Metaclass methodsFor:'queries'!
-
-isMeta
- "return true, if the receiver is some kind of metaclass;
- true is returned here. Redefines isMeta in Object"
-
- ^ true
-!
-
-soleInstance
- "return my sole class."
-
- ^ myClass
! !
!Metaclass methodsFor:'private'!
@@ -1271,26 +1253,6 @@
]
!
-anyInvalidatedMethodsIn:aClass
- "return true, if aClass has any invalidated methods in it"
-
- |trap trapCode trapByteCode|
-
- trap := Metaclass compiledMethodAt:#invalidCodeObject.
- trapCode := trap code.
- trapByteCode := trap byteCode.
-
- aClass methodArray do:[:aMethod |
- trapCode notNil ifTrue:[
- (aMethod code = trapCode) ifTrue:[^ true]
- ].
- trapByteCode notNil ifTrue:[
- (aMethod byteCode == trapByteCode) ifTrue:[^ true]
- ]
- ].
- ^ false
-!
-
checkConventionsFor:className instVarNames:instVarNameString classVarNames:classVarNameString
"Check for some 'considered bad-style' things, like lower case names.
NOTICE:
@@ -1335,4 +1297,40 @@
].
^ true
+!
+
+anyInvalidatedMethodsIn:aClass
+ "return true, if aClass has any invalidated methods in it"
+
+ |trap trapCode trapByteCode|
+
+ trap := Metaclass compiledMethodAt:#invalidCodeObject.
+ trapCode := trap code.
+ trapByteCode := trap byteCode.
+
+ aClass methodArray do:[:aMethod |
+ trapCode notNil ifTrue:[
+ (aMethod code = trapCode) ifTrue:[^ true]
+ ].
+ trapByteCode notNil ifTrue:[
+ (aMethod byteCode == trapByteCode) ifTrue:[^ true]
+ ]
+ ].
+ ^ false
! !
+
+!Metaclass methodsFor:'queries'!
+
+isMeta
+ "return true, if the receiver is some kind of metaclass;
+ true is returned here. Redefines isMeta in Object"
+
+ ^ true
+!
+
+soleInstance
+ "return my sole class."
+
+ ^ myClass
+! !
+