[Pkg] The Trunk: Traits-ar.275.mcz

[commits at source.squeak.org]

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

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

Name: Traits-ar.275
Author: ar
Time: 2 January 2010, 3:57:10 am
UUID: 3a07fcd6-afdc-b048-bb5b-889a4655c403
Ancestors: Traits-ar.274

A bit of refactoring. Break up ClassDescription>>installTraitsFrom: since it had gotten too long. Remove the obsolete definitionST80 protocol. Move updateTraitsFrom: up into ClassDescription.

=============== Diff against Traits-ar.274 ===============

Item was changed:
  ----- Method: ClassDescription>>installTraitsFrom: (in category '*Traits-NanoKernel') -----
  installTraitsFrom: aTraitComposition
  	"Install the traits from the given composition. This method implements
  	the core composition method - all others are just optimizations for
  	particular cases. Consequently, the optimized versions can always fall
  	back to this method when things get too hairy."
+ 	| allTraits methods |
- 	| allTraits methods oldMethod removals oldCategories |
  
  	(self traitComposition isEmpty and: [aTraitComposition isEmpty]) ifTrue: [^self].
  
  	"Check for cycles"
  	allTraits := aTraitComposition gather: [:t | t allTraits copyWith: t].
  	(allTraits includes: self) ifTrue:[^self error: 'Cyclic trait definition detected'].
  
- 	"XXXX: addUser/removeUser should be part of setter, but subclass 
- 	override prevents it until we've got rid of Traits mess."
- 	self traitComposition do:[:tc|  tc removeTraitUser: self].
  	self traitComposition: aTraitComposition.
+ 	methods := self assembleTraitMethodsFrom: aTraitComposition.
+ 	self installTraitMethodDict: methods.
+ 	self isMeta ifFalse:[self classSide updateTraitsFrom: aTraitComposition].
+ !
- 	aTraitComposition do:[:tc| tc addTraitUser: self].
- 
- 	"Assemble the methods in a new dictionary first.
- 	Uses a Dictionary instead of a MethodDictionary for speed (MDs grow by #become:)"
- 	methods := Dictionary new.
- 
- 	"Stick in the local methods first, since this avoids generating conflict methods unnecessarily"
- 	self selectorsAndMethodsDo:[:sel :newMethod|
- 		(self isLocalMethod: newMethod)
- 			ifTrue:[methods at: sel put:newMethod]].
- 
- 	"Now assemble the traits methods"
- 	aTraitComposition do:[:trait|
- 		trait selectorsAndMethodsDo:[:sel :newMethod|
- 			oldMethod := methods at: sel ifAbsentPut:[newMethod].
- 			newMethod == oldMethod ifFalse:["a conflict"
- 				(self isLocalMethod: oldMethod) ifFalse:[
- 					methods at: sel put: (self resolveTraitsConflict: sel from: oldMethod to: newMethod).
- 				].
- 			].
- 		].
- 	].
- 
- 	"Apply the changes. We first add the new or changed methods."
- 	oldCategories := Set new.
- 	methods keysAndValuesDo:[:sel :newMethod|
- 		oldMethod := self compiledMethodAt: sel ifAbsent:[nil].
- 		oldMethod == newMethod ifFalse:[
- 			self traitAddSelector: sel withMethod: newMethod.
- 			(self organization categoryOfElement: sel) ifNotNil:[:cat| oldCategories add: cat].
- 			self organization classify: sel under: 
- 				(newMethod methodHome organization categoryOfElement: newMethod selector).
- 		]].
- 
- 	"Now remove the old or obsoleted ones"
- 	removals := OrderedCollection new.
- 	self selectorsDo:[:sel| (methods includesKey: sel) ifFalse:[removals add: sel]].
- 	removals do:[:sel| self traitRemoveSelector: sel].
- 
- 	"Clean out empty categories"
- 	oldCategories do:[:cat|
- 		(self organization isEmptyCategoryNamed: cat)
- 			ifTrue:[self organization removeCategory: cat]].
- 
- 	self isMeta ifFalse:[self classSide updateTraitsFrom: aTraitComposition].!

Item was added:
+ ----- Method: ClassDescription>>assembleTraitMethodsFrom: (in category '*Traits-NanoKernel') -----
+ assembleTraitMethodsFrom: aTraitComposition
+ 	"Assemble the resulting methods for installing the given trait composition.
+ 	Returns a Dictionary instead of a MethodDictionary for speed (MDs grow by #become:)"
+ 	| methods oldMethod |
+ 	methods := Dictionary new.
+ 	"Stick in the local methods first, since this avoids generating conflict methods unnecessarily"
+ 	self selectorsAndMethodsDo:[:sel :newMethod|
+ 		(self isLocalMethod: newMethod)
+ 			ifTrue:[methods at: sel put:newMethod]].
+ 	"Now assemble the traits methods"
+ 	aTraitComposition do:[:trait|
+ 		trait selectorsAndMethodsDo:[:sel :newMethod|
+ 			oldMethod := methods at: sel ifAbsentPut:[newMethod].
+ 			newMethod == oldMethod ifFalse:["a conflict"
+ 				(self isLocalMethod: oldMethod) ifFalse:[
+ 					methods at: sel put: (self resolveTraitsConflict: sel from: oldMethod to: newMethod)]]]].
+ 	^methods!

Item was added:
+ ----- Method: ClassDescription>>installTraitMethodDict: (in category '*Traits-NanoKernel') -----
+ installTraitMethodDict: methods
+ 	"After having assembled the trait composition, install its methods."
+ 	| oldCategories oldMethod removals |
+ 	"Apply the changes. We first add the new or changed methods."
+ 	oldCategories := Set new.
+ 	methods keysAndValuesDo:[:sel :newMethod|
+ 		oldMethod := self compiledMethodAt: sel ifAbsent:[nil].
+ 		oldMethod == newMethod ifFalse:[
+ 			self traitAddSelector: sel withMethod: newMethod.
+ 			(self organization categoryOfElement: sel) ifNotNil:[:cat| oldCategories add: cat].
+ 			self organization classify: sel under: 
+ 				(newMethod methodHome organization categoryOfElement: newMethod selector)]].
+ 
+ 	"Now remove the old or obsoleted ones"
+ 	removals := OrderedCollection new.
+ 	self selectorsDo:[:sel| (methods includesKey: sel) ifFalse:[removals add: sel]].
+ 	removals do:[:sel| self traitRemoveSelector: sel].
+ 
+ 	"Clean out empty categories"
+ 	oldCategories do:[:cat|
+ 		(self organization isEmptyCategoryNamed: cat)
+ 			ifTrue:[self organization removeCategory: cat]].
+ 
+ !

Item was added:
+ ----- Method: ClassDescription>>updateTraitsFrom: (in category '*Traits-NanoKernel') -----
+ updateTraitsFrom: instanceTraits
+ 	"ClassTrait/Metaclass only. Update me from the given instance traits"
+ 	| map newTraits trait |
+ 	self isMeta ifFalse:[self error: 'This is a metaclass operation'].
+ 	map := Dictionary new.
+ 	self traitComposition do:[:composed| map at: composed trait put: composed].
+ 	newTraits := (instanceTraits collect:[:composed|
+ 		trait := composed trait classTrait.
+ 		map at: trait ifAbsent:[trait]] 
+ 	), (self traitComposition select:[:comp| comp trait isBaseTrait]).
+ 
+ 	self installTraitsFrom: newTraits!

Item was changed:
  ----- Method: ClassDescription>>traitComposition: (in category '*Traits-NanoKernel') -----
  traitComposition: aTraitComposition
  	"Install my trait composition"
+ 	self traitComposition do:[:tc|  tc removeTraitUser: self].
  	aTraitComposition isEmptyOrNil ifTrue:[
  		self organization isTraitOrganizer 
  			ifTrue:[self organization: (ClassOrganizer newFrom: self organization)].
  	] ifFalse:[
  		self organization isTraitOrganizer 
  			ifFalse:[self organization: (TraitOrganizer newFrom: self organization)].
  		self organization traitComposition: aTraitComposition.
+ 		aTraitComposition do:[:tc| tc addTraitUser: self].
  	].
  !

Item was removed:
- ----- Method: Metaclass>>updateTraitsFrom: (in category '*Traits-NanoKernel') -----
- updateTraitsFrom: instanceTraits
- 	"Update me from the given instance traits"
- 	| map newTraits trait |
- 
- 	map := Dictionary new.
- 	self traitComposition isEmpty ifFalse:[
- 		self traitComposition do:[:composed| map at: composed trait put: composed].
- 	].
- 
- 	newTraits := (instanceTraits collect:[:composed|
- 		trait := composed trait classTrait.
- 		map at: trait ifAbsent:[trait]]).
- 
- 	self traitComposition isEmpty ifFalse:[
- 		newTraits := newTraits, (self traitComposition select:[:comp| comp trait isBaseTrait]).
- 	].
- 	self installTraitsFrom: newTraits!

Item was removed:
- ----- Method: ClassTrait>>updateTraitsFrom: (in category 'initialize') -----
- updateTraitsFrom: instanceTraits
- 	"Update me from the given instance traits"
- 	| map newTraits trait |
- 	map := Dictionary new.
- 	self traitComposition do:[:composed| map at: composed trait put: composed].
- 	newTraits := (instanceTraits collect:[:composed|
- 		trait := composed trait classTrait.
- 		map at: trait ifAbsent:[trait]] 
- 	), (self traitComposition select:[:comp| comp trait isBaseTrait]).
- 
- 	self installTraitsFrom: newTraits!

Item was removed:
- ----- Method: Trait>>definitionST80 (in category 'initialize') -----
- definitionST80
- 	^String streamContents: [:stream |
- 		stream nextPutAll: 'Trait named: ';
- 				store: self name.
- 		stream cr; tab; nextPutAll: 'uses: ';
- 				nextPutAll: self traitComposition asString.
- 		stream cr; tab; nextPutAll: 'category: ';
- 				store: self category asString].!

Item was removed:
- ----- Method: ClassTrait>>definitionST80 (in category 'accessing') -----
- definitionST80
- 	^String streamContents: [:stream |
- 		stream nextPutAll: self name.
- 		stream cr; tab; nextPutAll: 'uses: ';
- 				nextPutAll: self traitComposition asString.
- 	].!