[squeak-dev] The Trunk: Traits-ar.272.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Jan 1 18:27:24 UTC 2010


Andreas Raab uploaded a new version of Traits to project The Trunk:
http://source.squeak.org/trunk/Traits-ar.272.mcz

==================== Summary ====================

Name: Traits-ar.272
Author: ar
Time: 1 January 2010, 7:27:09 am
UUID: 065dc8bf-9996-f345-8842-76af957c5dd9
Ancestors: Traits-ar.271

Making traits unloadable: Three new operations on class trait to support loading and unloading.
- Trait removeAllTraits flattens all classes and traits, converting traits to classes and storing supplemental information to support traits recovery.
- Trait restoreAllTraits restores traits from previously flattened classes based on the supplemental information stored via removeAllTraits.
- Trait unloadTraits first removes all traits and then unloads the traits package via Monticello.


=============== Diff against Traits-ar.271 ===============

Item was added:
+ ----- Method: Trait class>>restoreCompositionOf: (in category 'load-unload') -----
+ restoreCompositionOf: aClass
+ 	"Restore the trait composition for the given class"
+ 	| method requires composition |
+ 	method := aClass compiledMethodAt: #traitInfo ifAbsent:[^self].
+ 	aClass removeSelector: #traitInfo.
+ 	requires := (method pragmaAt: #traitRequires:) 
+ 		ifNil:[#()]
+ 		ifNotNil:[:pragma| pragma arguments first].
+ 	(requires allSatisfy:[:tn| (Smalltalk at: tn ifAbsent:[nil]) isKindOf: Trait])
+ 		ifFalse:[^self inform: 'Cannot restore composition of ', aClass name].
+ 	composition := (method pragmaAt: #traitComposition:) 
+ 		ifNil:[^self]
+ 		ifNotNil:[:pragma| Compiler evaluate: pragma arguments first].
+ 	aClass uses: composition.
+ 	aClass traitComposition selectorsAndMethodsDo:[:sel :meth|
+ 		| oldMethod newMethod |
+ 		newMethod := meth methodHome compiledMethodAt: sel.
+ 		oldMethod := aClass compiledMethodAt: sel ifAbsent:[newMethod].
+ 		oldMethod timeStamp = newMethod timeStamp
+ 				ifTrue:[aClass removeSelector: sel]].!

Item was added:
+ ----- Method: Trait class>>storeTraitInfoInClass: (in category 'load-unload') -----
+ storeTraitInfoInClass: aClass
+ 	"Store trait information in the given class"
+ 	| code |
+ 	code := WriteStream on: (String new: 100).
+ 	code nextPutAll: 'traitInfo
+ 	"This method contains information to restore the trait structure
+ 	for the receiver when traits are loaded or unloaded"'.
+ 	aClass isTrait ifTrue:[
+ 		code crtab; nextPutAll: '"This class was originally a trait"'.
+ 		code crtab; nextPutAll: '<traitDefinition: true>'.
+ 	].
+ 	aClass hasTraitComposition ifTrue:[
+ 		code crtab; nextPutAll: '"The trait composition for the receiver"'.
+ 		code crtab; nextPutAll: '<traitComposition: ', aClass traitCompositionString storeString,'>'.
+ 		code crtab; nextPutAll: '"The required traits for this trait"'.
+ 		code crtab; nextPutAll: '<traitRequires: ', (aClass traits collect:[:t| t baseTrait name]),'>'.
+ 	].
+ 	aClass compile: code contents.
+ !

Item was added:
+ ----- Method: Trait class>>convertTraitToClass: (in category 'load-unload') -----
+ convertTraitToClass: aTrait
+ 	"Convert the given trait to a class"
+ 	| aClass |
+ 	"Move the trait out of the way"
+ 	Smalltalk removeKey: aTrait name.
+ 	"Create the class in its place"
+ 	aClass := Object subclass: aTrait name
+ 				instanceVariableNames: ''
+ 				classVariableNames: ''
+ 				poolDictionaries: ''
+ 				category: aTrait category.
+ 
+ 	aTrait organization commentRemoteStr ifNotNil:[
+ 		aClass classComment: aTrait organization classComment 
+ 				stamp: aTrait organization commentStamp].
+ 
+ 	aTrait selectorsAndMethodsDo:[:sel :meth|
+ 		aClass compile: (aTrait sourceCodeAt: sel)
+ 			classified: (aTrait organization categoryOfElement: sel)
+ 			withStamp: (aTrait compiledMethodAt: sel) timeStamp
+ 			notifying: nil].
+ 
+ 	aTrait classSide selectorsAndMethodsDo:[:sel :meth|
+ 		aClass classSide compile: (aTrait classSide sourceCodeAt: sel)
+ 			classified: (aTrait classSide organization categoryOfElement: sel)
+ 			withStamp: (aTrait classSide compiledMethodAt: sel) timeStamp
+ 			notifying: nil].
+ 
+ 	aTrait obsolete.
+ 	^aClass
+ !

Item was added:
+ ----- Method: Trait class>>unloadTraits (in category 'load-unload') -----
+ unloadTraits
+ 	"Trait unloadTraits"
+ 	Trait traitImpl == self ifTrue:[Trait traitImpl: nil].
+ 	self removeAllTraits.
+ 	Behavior compileSilently: 'updateTraits' classified: 'accessing'.
+ 	(MCPackage named: 'Traits') unload.
+ 	Behavior removeSelectorSilently: #updateTraits.
+ 	Compiler recompileAll.!

Item was added:
+ ----- Method: Trait class>>removeAllTraits (in category 'load-unload') -----
+ removeAllTraits		"Trait removeAllTraits"
+ 	"Removes all traits currently in use. 
+ 	Preserves enough information so that traits can be recovered."
+ 	| converted remain |
+ 	converted := Set new.
+ 	Smalltalk allClasses do:[:aClass|
+ 		self flattenTraitMethodsInClass: aClass classSide.
+ 		self flattenTraitMethodsInClass: aClass.
+ 		converted add: aClass.
+ 	] displayingProgress: 'Flattening classes'.
+ 
+ 	remain := Smalltalk allTraits asSet.
+ 	(1 to: remain size) do:[:i| | trait |
+ 		trait := remain 
+ 			detect:[:any| any users allSatisfy:[:aClass| converted includes: aClass]]
+ 			ifNone:[self error: 'Cyclic traits detected'].
+ 		remain remove: trait.
+ 		self flattenTraitMethodsInClass: trait classSide.
+ 		self flattenTraitMethodsInClass: trait.
+ 		converted add: trait.
+ 	] displayingProgress: 'Flattening traits'.
+ 
+ 	"Convert all traits to classes"
+ 	Smalltalk allTraits
+ 		do:[:trait| self convertTraitToClass: trait] 
+ 		displayingProgress:[:trait| 'Converting ', trait name].
+ !

Item was added:
+ ----- Method: Trait class>>convertClassToTrait: (in category 'load-unload') -----
+ convertClassToTrait: aClass
+ 	"Convert the given class to a trait"
+ 	| aTrait |
+ 	"Move the class out of the way"
+ 	Smalltalk removeKey: aClass name.
+ 
+ 	"Create the trait in its place"
+ 	aTrait := Trait named: aClass name
+ 				uses: {}
+ 				category: aClass category.
+ 
+ 	aClass organization commentRemoteStr ifNotNil:[
+ 		aTrait classComment: aClass organization classComment 
+ 				stamp: aClass organization commentStamp].
+ 
+ 	aClass selectorsAndMethodsDo:[:sel :meth|
+ 		aTrait compile: (aClass sourceCodeAt: sel)
+ 			classified: (aClass organization categoryOfElement: sel)
+ 			withStamp: (aClass compiledMethodAt: sel) timeStamp
+ 			notifying: nil].
+ 
+ 	aClass classSide selectorsAndMethodsDo:[:sel :meth|
+ 		aTrait classSide compile: (aClass classSide sourceCodeAt: sel)
+ 			classified: (aClass classSide organization categoryOfElement: sel)
+ 			withStamp: (aClass classSide compiledMethodAt: sel) timeStamp
+ 			notifying: nil].
+ 
+ 	aClass obsolete.
+ 	^aTrait
+ !

Item was added:
+ ----- Method: Trait class>>flattenTraitMethodsInClass: (in category 'load-unload') -----
+ flattenTraitMethodsInClass: aClass
+ 	"Flatten all the trait methods in the given class"
+ 	| oldClass |
+ 	(aClass isTrait or:[aClass hasTraitComposition]) ifFalse:[^self].
+ 	self storeTraitInfoInClass: aClass.
+ 	aClass selectorsAndMethodsDo:[:sel :meth|
+ 		(aClass includesLocalSelector: sel) ifFalse:[
+ 			oldClass := meth methodHome.
+ 			aClass compile: (aClass sourceCodeAt: sel)
+ 				classified: (aClass organization categoryOfElement: sel)
+ 				withStamp: (oldClass compiledMethodAt: sel ifAbsent:[meth]) timeStamp
+ 				notifying: nil]].
+ 	aClass traitComposition: #().!

Item was added:
+ ----- Method: Trait class>>restoreAllTraits (in category 'load-unload') -----
+ restoreAllTraits		"Trait restoreAllTraits"
+ 	"Restores traits that had been previously removed.
+ 	This is the inverse operation to removeAllTraits."
+ 	| classes method |
+ 	classes := Smalltalk allClasses select:[:aClass| aClass includesSelector: #traitInfo].
+ 	classes do:[:aClass|
+ 		method := aClass compiledMethodAt: #traitInfo.
+ 		(method pragmaAt: #traitDefinition:) ifNotNil:[:pragma| 
+ 			pragma arguments first
+ 				ifTrue:[self convertClassToTrait: aClass]].
+ 	] displayingProgress:[:aClass| 'Creating trait ', aClass name].
+ 	classes := Smalltalk allClassesAndTraits select:[:aClass| 
+ 		(aClass includesSelector: #traitInfo) 
+ 			or:[aClass classSide includesSelector: #traitInfo]].
+ 	classes do:[:aClass|
+ 		self restoreCompositionOf: aClass.
+ 		self restoreCompositionOf: aClass classSide.
+ 	] displayingProgress:[:aClass| 'Updating ', aClass name].
+ !




More information about the Squeak-dev mailing list