The Trunk: Traits-ar.271.mcz

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

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

Name: Traits-ar.271
Author: ar
Time: 31 December 2009, 3:45:08 am
UUID: c7f78cfa-a551-ee4d-a4a5-f4f6da2bbad6
Ancestors: Traits-ar.270

Fix a few issues where we should operate on the elements of the trait transform instead of the transform itself.

=============== Diff against Traits-ar.270 ===============

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."
- "Install the traits from the given composition"
  | 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 removeTraitUser: self.
  self traitComposition: aTraitComposition.
+ aTraitComposition do:[:tc| tc addTraitUser: self].
- aTraitComposition 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 changed:
  ----- Method: ClassDescription>>includesTrait: (in category '*Traits-NanoKernel') -----
  includesTrait: aTrait
+ ^self traitComposition anySatisfy:[:each| each includesTrait: aTrait]!
- ^self traitComposition includesTrait: aTrait!

Item was removed:
- ----- Method: TraitComposition>>includesTrait: (in category 'testing') -----
- includesTrait: aTrait
- ^self anySatisfy:[:each| each includesTrait: aTrait]!

Item was removed:
- ----- Method: TraitComposition>>addTraitUser: (in category 'accessing') -----
- addTraitUser: aUser
- self do:[:each| each addTraitUser: aUser]!

Item was removed:
- ----- Method: TraitComposition>>removeTraitUser: (in category 'accessing') -----
- removeTraitUser: aUser
- self do:[:each| each removeTraitUser: aUser]!