[Cuis-dev] [IMRPOV] Changes to the class builder, take 1

[Gerald Klix]

Hi Juan, hi all,

Here comes my first patch refactoring the class builder.


Best Regards,

Gerald


-------------- next part --------------
'From Cuis 5.0 [latest update: #4384] on 2 October 2020 at 1:00:07 pm'!

!ClassBuilder methodsFor: 'instance creation' stamp: 'KLG 10/2/2020 11:58:14'!
metaclassClass
	"Answer the proper meta class for me."

	^ self class metaclassClass! !

!ClassBuilder methodsFor: 'subclass hooks' stamp: 'KLG 10/2/2020 12:51:08'!
configureNewMetaclass: aMetaclass
	"Configure a newly created  metaclass.
	
	The aMetaclass maybe the result of a shallow copy, so take care.
	
	Subclass me if you need special configuration."! !

!ClassBuilder methodsFor: 'subclass hooks' stamp: 'KLG 10/2/2020 12:19:15'!
newMetaclassFromOldMetaclass: aMetaclass
	"Create a new meta class instance from the old one.
	
 	Override me if you have a custom class builder with custom
	metclasses that need some tweaking."

	^ aMetaclass shallowCopy! !


!ClassBuilder class methodsFor: 'instance creation' stamp: 'KLG 10/2/2020 11:58:32'!
metaclassClass
	"Answer the proper meta class for me."

	^ Metaclass! !


!ClassBuilder methodsFor: 'private' stamp: 'KLG 10/2/2020 12:51:34'!
privateNewSubclassOf: newSuper
	"Create a new meta and non-meta subclass of newSuper"
	"WARNING: This method does not preserve the superclass/subclass invariant!!"
	| newSuperMeta newMeta |
	newSuperMeta _ newSuper ifNil:[Class] ifNotNil:[newSuper class].
	newMeta _ self metaclassClass new.
	self configureNewMetaclass: newMeta.
	newMeta 
		superclass: newSuperMeta 
		methodDictionary: MethodDictionary new 
		format: newSuperMeta format.
	^newMeta new
! !

!ClassBuilder methodsFor: 'private' stamp: 'KLG 10/2/2020 12:52:11'!
privateNewSubclassOf: newSuper from: oldClass
	"Create a new meta and non-meta subclass of newSuper using oldClass as template"
	"WARNING: This method does not preserve the superclass/subclass invariant!!"
	| newSuperMeta oldMeta newMeta |
	oldClass ifNil:[^self privateNewSubclassOf: newSuper].
	newSuperMeta _ newSuper ifNil:[Class] ifNotNil:[newSuper class].
	oldMeta _ oldClass class.
	newMeta _ self newMetaclassFromOldMetaclass: oldMeta.
	self configureNewMetaclass: newMeta.
	newMeta 
		superclass: newSuperMeta
		methodDictionary: MethodDictionary new
		format: (self computeFormat: oldMeta typeOfClass 
					instSize: oldMeta instVarNames size 
					forSuper: newSuperMeta
					ccIndex: 0);
		setInstVarNames: oldMeta instVarNames;
		organization: oldMeta organization.
	"Recompile the meta class"
	oldMeta hasMethods 
		ifTrue:[newMeta compileAllFrom: oldMeta].
	"Record the meta class change"
	self recordClass: oldMeta replacedBy: newMeta.
	"And create a new instance"
	^newMeta adoptInstance: oldClass from: oldMeta! !


!ClassBuilder reorganize!
('class definition' class:instanceVariableNames:unsafe: name:subclassOf:type:instanceVariableNames:classVariableNames:poolDictionaries:category: name:subclassOf:type:instanceVariableNames:classVariableNames:poolDictionaries:category:unsafe: needsSubclassOf:type:instanceVariables:from: newSubclassOf:type:instanceVariables:from: recompile:from:to:mutate: silentlyMoveInstVarNamed:from:to:after:)
('class format' computeFormat:instSize:forSuper: computeFormat:instSize:forSuper:ccIndex: format:variable:bitsUnitSize:pointers:weak: format:variable:words:pointers:weak:)
('validation' doesClassNameStartWithUppercase: validateClass:forMoving:downTo: validateClass:forMoving:upTo: validateClassName: validateClassvars:from:forSuper: validateInstvars:from:forSuper: validateSubclass:canKeepLayoutFrom:forSubclassFormat: validateSubclassFormat:from:forSuper:extra: validateSuperclass:forSubclass:)
('private' informUserDuring: privateNewSubclassOf: privateNewSubclassOf:from: recordClass:replacedBy: reservedNames showProgressFor: tooDangerousClasses)
('public' class:instanceVariableNames: moveInstVarNamed:from:to:after: superclass:ephemeronSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: superclass:subclass:instanceVariableNames:classVariableNames:poolDictionaries:category: superclass:variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: superclass:variableDoubleByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: superclass:variableDoubleWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: superclass:variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: superclass:variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: superclass:weakSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)
('class mutation' mutate:to: reshapeClass:toSuper: update:to:)
('initialization' doneCompiling: initialize)
('instance creation' metaclassClass)
('subclass hooks' configureNewMetaclass: newMetaclassFromOldMetaclass:)
!


!ClassBuilder class reorganize!
('accessing' beSilent: beSilentDuring: isSilent reservedNames)
('cleanup obsolete classes' checkClassHierarchyConsistency checkClassHierarchyConsistency: checkClassHierarchyConsistencyFor: cleanupAndCheckClassHierarchy cleanupAndCheckClassHierarchy: cleanupClassHierarchy cleanupClassHierarchy: cleanupClassHierarchyFor: countReallyObsoleteClassesAndMetaclasses isReallyObsolete: reallyObsoleteClasses reallyObsoleteMetaclasses)
('cached state access' releaseClassCachedState)
('instance creation' metaclassClass)
!