[squeak-dev] Unload Traits script

[Jerome Peace]

[squeak-dev] [ANN] Unload Traits script

***

>Matthew Fulmer tapplek at gmail.com
>Sat May 10 19:18:47 UTC 2008
>
>
>I wrote a script that removes traits from a 3.9 or 3.8 image:
>http://installer.pbwiki.org/UnloadTraits
>
>In an image with Installer (preferably LPF), do:
>Installer install: 'UnloadTraits'
><...>

Ok. Then what does this give you?

If you had such an image could you use it as a basis for development?
How would you update it?
How could you revert an update to it?

Basically what I am asking is could this be squeak 4.0 and a basis for future development?
Or would the image produced just be a curiosity that could not be developed further.

This is different from the question of should it be. That also is important to answer. But the "should"
question is a political one. I'm just looking for the technical answer to the "could" questions.

Yours in curiosity and service, --Jeorme Peace

P.S. How is work on DeltaStreams coming?



      ____________________________________________________________________________________
Be a better friend, newshound, and
know-it-all with Yahoo! Mobile.  Try it now.  http://mobile.yahoo.com/;_ylt=Ahu06i62sR8HDtDypao8Wcj9tAcJ

[Edgar J. De Cleene]

El 5/10/08 5:58 PM, "Jerome Peace" <peace_the_dreamer@...> escribió:

>> Matthew Fulmer tapplek at gmail.com
>> Sat May 10 19:18:47 UTC 2008
>>
>>
>> I wrote a script that removes traits from a 3.9 or 3.8 image:
>> http://installer.pbwiki.org/UnloadTraits
>>
>> In an image with Installer (preferably LPF), do:
>> Installer install: 'UnloadTraits'
>> <...>
>
> Ok. Then what does this give you?
>
> If you had such an image could you use it as a basis for development?
> How would you update it?
> How could you revert an update to it?
>
> Basically what I am asking is could this be squeak 4.0 and a basis for future
> development?
> Or would the image produced just be a curiosity that could not be developed
> further.
>
> This is different from the question of should it be. That also is important to
> answer. But the "should"
> question is a political one. I'm just looking for the technical answer to the
> "could" questions.
>
> Yours in curiosity and service, --Jeorme Peace
>
> P.S. How is work on DeltaStreams coming?

Well , 3.11 could not have Installer or any 3.8 don't have.
No SM, no Universes, no etc
As clean we manage to clean and not putting any.
Less code means less work, more easy to test, more easy to improve.
I plan to cut several things , so my first could be Traits.
It's your picture on Hall of Fame and going back to good track.

Repeat with me, smaller is good , smaller is faster , smaller is .... :=)

Edgar

[Keithy]

Jerome Peace wrote:

>
>> Matthew wrote:
>> I wrote a script that removes traits from a 3.9 or 3.8 image:
>> http://installer.pbwiki.org/UnloadTraits
>>
>> In an image with Installer (preferably LPF), do:
>> Installer install: 'UnloadTraits'
>> <...>
>>    
>
> Ok. Then what does this give you?
>
>  

It gives you an image, a) without traits, and b) with the old class format.

The aim being to 1) enable folks with code that relies on the old format
to move up to 3.10 should they so desire 2) Satisfy those who dont like
the existing traits based traits implementation and would like to have
something simpler and 3) Provide a starting point for a future simpler
traits implementation if anyone wants to write it.
> If you had such an image could you use it as a basis for development?
>  
If you take 3.10 and remove traits, its roughly the same as a 3.8 image
with more toys and bug fixes of 3.9 and 3.10.

A future development for MC1.6+ will be to enable MC packages which
include traits to automatically load flattened into a non-trait image.
i.e. traits fans can use them as a design/code reuse tool publishing
their work as a package that anyone can use.
> How would you update it?
>  
In comparison to which current practice?
> How could you revert an update to it?
>
>  
In comparison to which current practice?

Reverting is part of the DS concept.

Sake/Packages has a Package-level unload function which could work well
if appropriately configured.
> Basically what I am asking is could this be squeak 4.0 and a basis for future development?
>  
If someone does the complementary "TraitsLoad", then
3.11-minimal-load-what-you-need-image can be published without traits.
However doing this would prevent traits being used unflattened in the
kernel, so it may be better to leave traits in, with a "flatten all
traits and remove traits" script or sake-task.
> Or would the image produced just be a curiosity that could not be developed further.
>
> This is different from the question of should it be. That also is important to answer. But the "should"
> question is a political one. I'm just looking for the technical answer to the "could" questions.
>  
Where there is a will there is a way...  subject to further tools support.

regards

Keith
 

[Philippe Marschall]

2008/5/11, Keith Hodges <keith_hodges@...>:

> Jerome Peace wrote:
>
> >
> >
> > > Matthew wrote:
> > > I wrote a script that removes traits from a 3.9 or 3.8 image:
> > > http://installer.pbwiki.org/UnloadTraits
> > >
> > > In an image with Installer (preferably LPF), do:
> > > Installer install: 'UnloadTraits'
> > > <...>
> > >
> > >
> >
> > Ok. Then what does this give you?
> >
> >
> >
>  It gives you an image, a) without traits, and b) with the old class format.
>
>  The aim being to 1) enable folks with code that relies on the old format to
> move up to 3.10 should they so desire 2) Satisfy those who dont like the
> existing traits based traits implementation and would like to have something
> simpler and 3) Provide a starting point for a future simpler traits
> implementation if anyone wants to write it.

What about people who need traits?

Cheers
Philippe

> > If you had such an image could you use it as a basis for development?
> >
> >
>  If you take 3.10 and remove traits, its roughly the same as a 3.8 image
> with more toys and bug fixes of 3.9 and 3.10.
>
>  A future development for MC1.6+ will be to enable MC packages which include
> traits to automatically load flattened into a non-trait image. i.e. traits
> fans can use them as a design/code reuse tool publishing their work as a
> package that anyone can use.
>
> > How would you update it?
> >
> >
>  In comparison to which current practice?
>
> > How could you revert an update to it?
> >
> >
> >
>  In comparison to which current practice?
>
>  Reverting is part of the DS concept.
>
>  Sake/Packages has a Package-level unload function which could work well if
> appropriately configured.
>
> > Basically what I am asking is could this be squeak 4.0 and a basis for
> future development?
> >
>  If someone does the complementary "TraitsLoad", then
> 3.11-minimal-load-what-you-need-image can be published
> without traits. However doing this would prevent traits being used
> unflattened in the kernel, so it may be better to leave traits in, with a
> "flatten all traits and remove traits" script or sake-task.
>
> > Or would the image produced just be a curiosity that could not be
> developed further.
> >
> > This is different from the question of should it be. That also is
> important to answer. But the "should"
> > question is a political one. I'm just looking for the technical answer to
> the "could" questions.
> >
> >
>  Where there is a will there is a way...  subject to further tools support.
>
>  regards
>
>  Keith
>
>
>
>
>

[stephane ducasse]

>> What about people who need traits?

Hi philippe

who care, they are idiot. Reuse is a bullshit.
if people believe that traits are the unique problem of Squeak let  
them believe it.

I recently receive that email from a guy aparently from the C++ and  
perl community. Certainly one of this
one idiot that believe in other abstractions.

"First, I wonder if you were aware of the impact your paper has had on  
the early stages of designing the object system for Perl 6.  I guess  
Larry was quite taken with the idea.  After struggling to bend C++  
templates to a similar end, I certainly see it as revolutionary.

I further wonder if you are interested in Perl 6, and are looking in  
on the design effort from time to time.  I'm currently working on a  
more detailed exploration of the type system.

--John"

We made a huge mistake to have done 3.9, we should have forked 3 years  
ago. Now I start to believe what marcus always told me.

Stef

[Andreas Raab]

Philippe Marschall wrote:
>>  It gives you an image, a) without traits, and b) with the old class format.
>>
>>  The aim being to 1) enable folks with code that relies on the old format to
>> move up to 3.10 should they so desire 2) Satisfy those who dont like the
>> existing traits based traits implementation and would like to have something
>> simpler and 3) Provide a starting point for a future simpler traits
>> implementation if anyone wants to write it.
>
> What about people who need traits?

There is no reason why a traits implementation needs to be as intrusive
as this one. Earlier this year I had been playing with a traits
implementation for Croquet just to understand some of the implementation
aspects a little better and it was pretty clear that an alternative
implementation which is much less invasive is not only trivial to do but
fits much better into the rest of the existing system. I'm attaching a
draft version of this experiment (which is not fully functional since I
lost interest but it will load into Croquet and is enough to play with
it) and you can check it out to see how it hooks into the system -
basically traits inherit from ClassDescription which avoids most of the
code duplication and leaves the option for perhaps having stateful
traits at some point. The extension points to the existing kernel are
few (and could be made fewer) and loading and unloading would be trivial
with just a tiny bit more work.

In any case, this is not a complete implementation but rather an
illustration that the current implementation isn't the only way traits
can be implemented in Squeak and that an alternative can be small,
loadable, and easy to understand.

Cheers,
   - Andreas

[Traits-Kernel.2.cs]

---

'From Croquet1.0beta of 11 April 2006 [latest update: #2] on 12 May 2008 at 5:48:20 am'!
OrderedCollection subclass: #TraitComposition
        instanceVariableNames: ''
        classVariableNames: 'TraitsCache'
        poolDictionaries: ''
        category: 'Traits-Kernel'!

!TraitComposition commentStamp: '<historical>' prior: 0!
A trait composition is a collection of Traits or TraitTransformations.!

TraitComposition class
        instanceVariableNames: ''!
Error subclass: #TraitCompositionException
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Traits-Kernel'!
TraitCompositionException class
        instanceVariableNames: ''!
ClassDescription subclass: #TraitDescription
        instanceVariableNames: 'users'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Traits-Kernel'!
TraitDescription subclass: #Metatrait
        instanceVariableNames: 'baseTrait'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Traits-Kernel'!

!Metatrait commentStamp: '<historical>' prior: 0!
Metatrait is the metaclass used for traits.!

TraitDescription subclass: #Trait
        instanceVariableNames: 'name environment category'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Traits-Kernel'!
TraitDescription class
        instanceVariableNames: ''!
Metatrait class
        instanceVariableNames: ''!
Trait class
        instanceVariableNames: ''!
Object subclass: #TraitTransformation
        instanceVariableNames: 'subject users'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Traits-Kernel'!
TraitTransformation subclass: #TraitAlias
        instanceVariableNames: 'aliases'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Traits-Kernel'!
TraitTransformation subclass: #TraitExclusion
        instanceVariableNames: 'exclusions'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Traits-Kernel'!
TraitTransformation class
        instanceVariableNames: ''!
TraitAlias class
        instanceVariableNames: ''!
TraitExclusion class
        instanceVariableNames: ''!

!Object methodsFor: '*Traits-Kernel' stamp: 'ar 11/22/2007 04:25'!
isTrait
        ^false! !


!Behavior methodsFor: '*Traits-Kernel' stamp: 'ar 5/11/2008 02:09'!
hasTraitComposition
        ^self traitComposition notEmpty! !

!Behavior methodsFor: '*Traits-Kernel' stamp: 'ar 5/11/2008 01:55'!
includesLocalSelector: selector
        ^(self compiledMethodAt: selector ifAbsent:[^false]) methodHome == self! !

!Behavior methodsFor: '*Traits-Kernel' stamp: 'ar 5/11/2008 02:11'!
isAliasSelector: aSymbol
        "Return true if the selector aSymbol is an alias defined
        in my or in another composition somewhere deeper in
        the tree of traits compositions."

        ^(self includesLocalSelector: aSymbol) not
                and: [self hasTraitComposition]
                and: [self traitComposition isAliasSelector: aSymbol]! !

!Behavior methodsFor: '*Traits-Kernel' stamp: 'ar 5/11/2008 02:17'!
isLocalAliasSelector: aSymbol
        "Return true if the selector aSymbol is an alias defined
        in my or in another composition somewhere deeper in
        the tree of traits compositions."

        ^(self includesLocalSelector: aSymbol) not
                and: [self hasTraitComposition]
                and: [self traitComposition isLocalAliasSelector: aSymbol]! !

!Behavior methodsFor: '*Traits-Kernel' stamp: 'ar 5/11/2008 02:07'!
localSelectors
        ^self selectors select:[:sel| self includesLocalSelector: sel]! !


!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 11/28/2007 20:53'!
addSelector: selector withTraitMethod: compiledMethod
        "Add a method from a trait. Recompiles if the method includes super sends."
        | newMethod |
        self addSelectorSilently: selector withMethod: compiledMethod.
        (compiledMethod sendsToSuper) ifTrue:[
                self recompile: selector.
                newMethod := self compiledMethodAt: selector.
                newMethod == compiledMethod ifTrue:[self error: 'Recompilation failure'].
                "Set the original home of the recompiled method"
                newMethod methodHome: compiledMethod methodHome.
        ].! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 11/22/2007 04:21'!
allTraits
        "Answer all the traits that are used by myself without their transformations"
        ^self traits gather:[:t| t allTraits copyWith: t].! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 11/28/2007 20:49'!
basicRemoveSelector: selector
        "Assuming that the argument, selector (a Symbol), is a message selector
        in my method dictionary, remove it and its method. For traits, we need to check
        whether the selector originated in a different trait and if so, exclude it from the trait
        in addition to removing it."
        | oldMethod oldHome tc updated |
        oldMethod := self compiledMethodAt: selector ifAbsent:[^nil].
        oldHome := oldMethod methodHome.
        "Make sure this is neither my trait nor that the method was removed from oldHome"
        (oldHome isTrait and:[oldHome includesSelector: selector]) ifTrue:[
                "Find any trait transformation providing the selector"
                tc := self traitComposition.
                oldHome := tc detect:[:t| t includesSelector: selector] ifNone:[nil].
                oldHome ifNotNil:["Exclude the selector and store the transform back"
                        oldHome removeUser: self.
                        updated := oldHome - {selector}.
                        updated addUser: self.
                        updated = oldHome ifFalse:[tc at: (tc indexOf: oldHome) put: updated]
                ].
        ].
        super basicRemoveSelector: selector.
        "The following is slow, but effective to propagate a selector from a trait after removing it."
        self installTraitsFrom: self traitComposition.! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 11/28/2007 20:50'!
classify: selector under: heading fromTrait: aTrait
        "Update the organization for a trait"
        | compiledMethod |
        compiledMethod := self compiledMethodAt: selector.
        compiledMethod methodHome == aTrait ifTrue:[
                self organization classify: selector under: heading.
        ].! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 11/18/2007 19:02'!
classSide
        ^self theMetaClass! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 5/11/2008 02:38'!
fileOutInitializerOn: aStream
        "-- ignored --"! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 5/11/2008 02:37'!
fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: aBool
        ^self fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 11/28/2007 21:22'!
installTraitsFrom: aTraitComposition
        "Install the traits from the given composition"
        | allTraits methods oldMethod removals |
        (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'].

        "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."
        methods keysAndValuesDo:[:sel :newMethod|
                oldMethod := self compiledMethodAt: sel ifAbsent:[nil].
                oldMethod == newMethod ifFalse:[
                        self addSelector: sel withTraitMethod: newMethod.
                        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 removeSelector: sel].

        self traitComposition: aTraitComposition.

        self isMeta ifFalse:[self class updateTraitsFrom: aTraitComposition].! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 5/11/2008 01:53'!
instanceSide
        ^self theNonMetaClass! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 11/28/2007 20:51'!
isLocalMethod: aCompiledMethod
        "Answer true if the method is a local method, e.g., defined in the receiver instead of a trait."
        ^aCompiledMethod methodHome == self! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 11/18/2007 18:16'!
removeTraitSelector: selector
        self removeSelectorSilently: selector! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 5/1/2008 21:25'!
replaceTraitSelector: original with: aSelector in: source for: aMethod
        | oldKeywords newKeywords args newSelectorWithArgs startOfSource lastSelectorToken |
        oldKeywords := original keywords.
        newKeywords := aSelector keywords.
        self assert: oldKeywords size = newKeywords size.
        args := (self parserClass new
                parseArgsAndTemps: source string notifying: nil) copyFrom: 1 to: aMethod numArgs.
        newSelectorWithArgs := String streamContents: [:stream |
                newKeywords withIndexDo: [:keyword :index |
                        stream nextPutAll: keyword.
                        stream space.
                        args size >= index ifTrue: [
                                stream nextPutAll: (args at: index); space]]].
        lastSelectorToken := args isEmpty
                ifFalse: [args last]
                ifTrue: [oldKeywords last].
        startOfSource := (source string
                indexOfSubCollection: lastSelectorToken startingAt: 1) + lastSelectorToken size.
        ^newSelectorWithArgs withBlanksTrimmed asText , (source copyFrom: startOfSource to: source size)! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 11/18/2007 15:22'!
resolveTraitsConflict: selector from: oldMethod to: newMethod
        "Resolve a traits conflict. Last one wins (for now)"
        ^newMethod
! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 11/22/2007 04:12'!
traitComposition
        "Answer an array of my traits"
        ^TraitComposition for: self! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 11/22/2007 06:32'!
traitCompositionString
        "Print a description of the traits composition"
        ^self name asString! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 11/22/2007 06:29'!
traitComposition: aTraitComposition
        "Install my traits"
        (aTraitComposition isKindOf: TraitComposition) ifFalse:[self error: 'Not a trait composition'].
        self traitComposition do:[:t| t removeUser: self].
        TraitComposition for: self put: aTraitComposition.
        aTraitComposition do:[:t| t addUser: self].
! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 11/22/2007 04:36'!
traits
        "Answer an array of my traits"
        ^self traitComposition asArray collect:[:composed| composed theTrait]! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 11/28/2007 21:22'!
updateSelector: selector withTraitMethod: compiledMethod from: aTrait
        "A selector in the given trait has changed. Update my usage of it."
        | oldMethod |
        oldMethod := self compiledMethodAt: selector ifAbsent:[nil].
        (oldMethod == nil and:[compiledMethod == nil]) ifTrue:[^nil].
        oldMethod ifNil:["No previous method, add and classify the new method"
                self addSelector: selector withTraitMethod: compiledMethod.
                self organization classify: selector under: (aTrait organization categoryOfElement: selector).
                ^self].
        (self isLocalMethod: oldMethod) ifTrue:[^nil]. "local version trumps override"
        oldMethod methodHome == aTrait ifTrue:["same trait, just update"
                compiledMethod ifNil:[^self removeTraitSelector: selector].
                ^self addSelector: selector withTraitMethod: compiledMethod].
        compiledMethod ifNil:[^self]. "removed a method from a different trait"
        "Resolve conflict"
        ^self addSelector: selector withTraitMethod:
                (self resolveTraitsConflict: selector from: oldMethod to: compiledMethod)! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 11/18/2007 22:27'!
usesTrait: aTrait
        ^self traits anySatisfy:[:t| t usesTrait: aTrait].! !

!ClassDescription methodsFor: '*Traits-Kernel' stamp: 'ar 5/11/2008 02:34'!
uses: aTraitComposition
        | newTraits |
        newTraits := (aTraitComposition isKindOf: Trait orOf: TraitTransformation)
                ifTrue:[TraitComposition with: aTraitComposition]
                ifFalse:[(aTraitComposition isKindOf: SequenceableCollection)
                                        ifTrue:[TraitComposition withAll: aTraitComposition asArray]
                                        ifFalse:[self error: 'Invalid traits specification']].
        self installTraitsFrom: newTraits.
! !


!Class methodsFor: '*Traits-Kernel' stamp: 'ar 11/22/2007 06:34'!
definitionST80
        "Answer a String that defines the receiver."

        | aStream path |
        aStream := WriteStream on: (String new: 300).
        superclass == nil
                ifTrue: [aStream nextPutAll: 'ProtoObject']
                ifFalse: [path := ''.
                                self environment scopeFor: superclass name from: nil
                                                envtAndPathIfFound: [:envt :remotePath | path := remotePath].
                                aStream nextPutAll: path , superclass name].
        aStream nextPutAll: self kindOfSubclass;
                        store: self name.
        self traitComposition ifNotEmpty:[
        aStream cr; tab; nextPutAll: 'uses: ';
                        nextPutAll: self traitComposition traitCompositionString.
        ].
        aStream cr; tab; nextPutAll: 'instanceVariableNames: ';
                        store: self instanceVariablesString.
        aStream cr; tab; nextPutAll: 'classVariableNames: ';
                        store: self classVariablesString.
        aStream cr; tab; nextPutAll: 'poolDictionaries: ';
                        store: self sharedPoolsString.
        aStream cr; tab; nextPutAll: 'category: ';
                        store: (SystemOrganization categoryOfElement: self name) asString.

        superclass ifNil: [
                aStream nextPutAll: '.'; cr.
                aStream nextPutAll: self name.
                aStream space; nextPutAll: 'superclass: nil'. ].

        ^ aStream contents! !

!Class methodsFor: '*Traits-Kernel' stamp: 'ar 5/11/2008 02:34'!
subclass: t uses: aTraitComposition instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat
        | newClass copyOfOldClass |
        copyOfOldClass := self copy.
        newClass := self
                subclass: t
                instanceVariableNames: f
                classVariableNames: d
                poolDictionaries: s
                category: cat.

        newClass uses: aTraitComposition.
        SystemChangeNotifier uniqueInstance
                classDefinitionChangedFrom: copyOfOldClass to: newClass.
        ^newClass! !


!CompiledMethod methodsFor: '*Traits-Kernel' stamp: 'ar 11/28/2007 20:48'!
methodHome
        "The behavior (trait/class) this method was originally defined in.
        Can be different from methodClass if the method was recompiled due to super sends."
        ^self properties at: #methodHome ifAbsent:[self methodClass]! !

!CompiledMethod methodsFor: '*Traits-Kernel' stamp: 'ar 11/28/2007 20:48'!
methodHome: aBehavior
        "The behavior (trait/class) this method was originally defined in.
        Can be different from methodClass if the method was recompiled due to super sends."
        aBehavior
                ifNil:[self properties removeKey: #methodHome]
                ifNotNil:[self properties at: #methodHome put: aBehavior].! !


!Metaclass methodsFor: '*Traits-Kernel' stamp: 'ar 11/22/2007 06:34'!
definitionST80
        "Refer to the comment in ClassDescription|definition."

        ^ String streamContents:
                [:strm |
                strm print: self.
                self traitComposition ifNotEmpty:[
                        strm crtab; nextPutAll: 'uses: '; nextPutAll: self traitComposition traitCompositionString.
                ].
                strm
                        crtab;
                        nextPutAll: 'instanceVariableNames: ';
                        store: self instanceVariablesString]! !

!Metaclass methodsFor: '*Traits-Kernel' stamp: 'ar 11/22/2007 04:20'!
updateTraitsFrom: instanceTraits
        "Update me from the given instance traits"
        | map newTraits trait |
        map := Dictionary new.
        self traitComposition do:[:composed| map at: composed theTrait put: composed].
        newTraits := (instanceTraits collect:[:composed|
                trait := composed theTrait classTrait.
                map at: trait ifAbsent:[trait]]
        ), (self traitComposition select:[:comp| comp theTrait isBaseTrait]).

        self installTraitsFrom: newTraits! !

!Metaclass methodsFor: '*Traits-Kernel' stamp: 'ar 5/11/2008 02:34'!
uses: aTraitComposition instanceVariableNames: instVarString
        | newMetaClass copyOfOldMetaClass |
       
        copyOfOldMetaClass := self copy.
        newMetaClass := self instanceVariableNames: instVarString.
        self uses: aTraitComposition.
        SystemChangeNotifier uniqueInstance
                classDefinitionChangedFrom: copyOfOldMetaClass to: newMetaClass! !


!TraitComposition methodsFor: 'accessing' stamp: 'ar 11/18/2007 19:20'!
addUser: aUser
        self do:[:each| each addUser: aUser]! !

!TraitComposition methodsFor: 'accessing' stamp: 'ar 11/22/2007 04:37'!
allTraits
        ^self gather:[:each| each allTraits copyWith: each theTrait]! !

!TraitComposition methodsFor: 'accessing' stamp: 'ar 11/18/2007 19:20'!
removeUser: aUser
        self do:[:each| each removeUser: aUser]! !

!TraitComposition methodsFor: 'accessing' stamp: 'ar 5/11/2008 02:30'!
traits
        ^Array streamContents:[:s| self traitsDo:[:t| s nextPut: t]]! !

!TraitComposition methodsFor: 'accessing' stamp: 'ar 11/22/2007 06:21'!
traitsDo: aBlock
        ^self do:[:each| each traitsDo: aBlock]! !

!TraitComposition methodsFor: 'accessing' stamp: 'ar 11/18/2007 21:02'!
traitUsers
        "Answer this traits users, without the transforms in the middle"
        ^self gather:[:each|
                (each isBehavior)
                        ifTrue:[Array with: each]
                        ifFalse:[each traitUsers]].! !

!TraitComposition methodsFor: 'testing' stamp: 'ar 11/28/2007 21:09'!
isTraitTransformation
        "Polymorphic with TraitTransformation"
        ^false! !

!TraitComposition methodsFor: 'testing' stamp: 'ar 11/22/2007 06:21'!
usesTrait: aTrait
        ^self anySatisfy:[:each| each usesTrait: aTrait]! !

!TraitComposition methodsFor: 'converting' stamp: 'ar 11/18/2007 19:13'!
+ aTrait
        self addLast: aTrait.
        ^self! !

!TraitComposition methodsFor: 'converting' stamp: 'ar 11/18/2007 23:13'!
- anArray
        "the modifier operators #@ and #- bind stronger than +.
        Thus, #@ or #- sent to a sum will only affect the most right summand"
       
        self addLast: (self removeLast - anArray)! !

!TraitComposition methodsFor: 'converting' stamp: 'ar 11/18/2007 23:12'!
@ anArrayOfAssociations
        "the modifier operators #@ and #- bind stronger than +.
        Thus, #@ or #- sent to a sum will only affect the most right summand"

        self addLast: (self removeLast @ anArrayOfAssociations)! !

!TraitComposition methodsFor: 'composition' stamp: 'ar 11/22/2007 06:21'!
classify: selector under: category fromTrait: aTrait
        "broadcasts a reclassification of some selector to all users of a trait"
        self do:[:each| each classify: selector under: category fromTrait: aTrait].! !

!TraitComposition methodsFor: 'composition' stamp: 'ar 11/22/2007 06:20'!
copyTraitExpression
        "Copy all except the actual traits"
        ^self collect:[:each| each copyTraitExpression].! !

!TraitComposition methodsFor: 'composition' stamp: 'ar 5/11/2008 02:13'!
isAliasSelector: selector
        "enumerates all selectors and methods in a trait composition"
        ^self anySatisfy:[:any| any isAliasSelector: selector]! !

!TraitComposition methodsFor: 'composition' stamp: 'ar 5/11/2008 02:17'!
isLocalAliasSelector: selector
        "enumerates all selectors and methods in a trait composition"
        ^self anySatisfy:[:any| any isLocalAliasSelector: selector]! !

!TraitComposition methodsFor: 'composition' stamp: 'ar 11/22/2007 06:12'!
selectorsAndMethodsDo: aBlock
        "enumerates all selectors and methods in a trait composition"
        self do:[:each| each selectorsAndMethodsDo: aBlock].! !

!TraitComposition methodsFor: 'composition' stamp: 'ar 11/22/2007 06:23'!
traitCompositionString
        "Answer the trait composition string (used for class definitions)"
        self size = 0 ifTrue:[^'{}'].
        self  size = 1 ifTrue:[^self first traitCompositionString].
        ^String streamContents:[:s|
                self do:[:each| s nextPutAll: each traitCompositionString] separatedBy:[s nextPutAll: ' + '].
        ].! !

!TraitComposition methodsFor: 'composition' stamp: 'ar 11/22/2007 06:11'!
updateSelector: aSelector withTraitMethod: compiledMethod from: aTrait
        "broadcasts the change of a selector to all users of a trait"
        ^self do:[:each| each updateSelector: aSelector withTraitMethod: compiledMethod from: aTrait]! !


!TraitComposition class methodsFor: 'class initialization' stamp: 'ar 11/22/2007 04:11'!
initialize
        "TraitComposition initialize"
        TraitsCache := Dictionary new.! !

!TraitComposition class methodsFor: 'accessing' stamp: 'ar 11/22/2007 04:10'!
for: aUser
        "Answer the traits composition for the given user.
        This method provides a storage area for traits in classes."
        ^TraitsCache at: aUser ifAbsent:[self new]! !

!TraitComposition class methodsFor: 'accessing' stamp: 'ar 11/22/2007 04:11'!
for: aUser put: aComposition
        "Answer the traits composition for the given user.
        This method provides a storage area for traits in classes."
        ^TraitsCache at: aUser put: aComposition! !


!TraitDescription methodsFor: 'accessing' stamp: 'ar 11/28/2007 20:54'!
addUser: aTrait
        users := self users copyWith: aTrait.
! !

!TraitDescription methodsFor: 'accessing' stamp: 'ar 11/28/2007 20:57'!
allClassVarNames
        "Traits have no class var names"
        ^#()! !

!TraitDescription methodsFor: 'accessing' stamp: 'ar 11/28/2007 20:58'!
classPool
        "Traits have no class pool"
        ^ Dictionary new! !

!TraitDescription methodsFor: 'accessing' stamp: 'ar 11/28/2007 20:55'!
removeUser: aTrait
        users := self users copyWithout: aTrait.
! !

!TraitDescription methodsFor: 'accessing' stamp: 'ar 11/28/2007 20:58'!
sharedPools
        "Traits have no shared pools"
        ^ Dictionary new! !

!TraitDescription methodsFor: 'accessing' stamp: 'ar 11/28/2007 20:59'!
theTrait
        ^self! !

!TraitDescription methodsFor: 'accessing' stamp: 'ar 11/28/2007 20:55'!
traitUsers
        "Answer this traits users, without the transforms in the middle"
        ^self users gather:[:each|
                (each isBehavior)
                        ifTrue:[Array with: each]
                        ifFalse:[each traitUsers]].! !

!TraitDescription methodsFor: 'accessing' stamp: 'ar 11/28/2007 20:55'!
users
        ^users ifNil:[#()]! !

!TraitDescription methodsFor: 'accessing' stamp: 'ar 11/28/2007 20:55'!
users: aCollection
        users := aCollection! !

!TraitDescription methodsFor: 'copying' stamp: 'ar 11/28/2007 20:55'!
copy
        self error: 'Traits cannot be trivially copied'! !

!TraitDescription methodsFor: 'copying' stamp: 'ar 11/28/2007 20:55'!
copyTraitExpression
        "Copy all except the actual traits"
        ^self! !

!TraitDescription methodsFor: 'testing' stamp: 'ar 11/28/2007 21:01'!
isBaseTrait
        ^false! !

!TraitDescription methodsFor: 'testing' stamp: 'ar 11/28/2007 21:01'!
isClassTrait
        ^false! !

!TraitDescription methodsFor: 'testing' stamp: 'ar 11/28/2007 20:56'!
isTrait
        ^true! !

!TraitDescription methodsFor: 'testing' stamp: 'ar 11/28/2007 20:56'!
isTraitTransformation
        "Polymorphic with TraitTransformation"
        ^false! !

!TraitDescription methodsFor: 'testing' stamp: 'ar 11/28/2007 20:56'!
usesTrait: aTrait
        ^self == aTrait or:[super usesTrait: aTrait]! !

!TraitDescription methodsFor: 'operations' stamp: 'ar 11/28/2007 20:57'!
addAndClassifySelector: selector withMethod: compiledMethod inProtocol: category notifying: requestor
        "Overridden to update the users of this trait"
        super addAndClassifySelector: selector withMethod: compiledMethod inProtocol: category notifying: requestor.
        "Update category"
        self users do:[:each| each classify: selector under: category fromTrait: self].! !

!TraitDescription methodsFor: 'operations' stamp: 'ar 11/28/2007 20:57'!
addSelectorSilently: selector withMethod: compiledMethod
        "Overridden to update the users of this trait"
        super addSelectorSilently: selector withMethod: compiledMethod.
        self users do:[:each| each updateSelector: selector withTraitMethod: compiledMethod from: self].! !

!TraitDescription methodsFor: 'operations' stamp: 'ar 11/28/2007 20:57'!
basicRemoveSelector: aSelector
        "Overridden to update the users of this trait"
        | priorMethod |
        priorMethod := self compiledMethodAt: aSelector ifAbsent:[^nil].
        super basicRemoveSelector: aSelector.
        self users do:[:each|
                each updateSelector: aSelector withTraitMethod: nil from: priorMethod methodHome].! !

!TraitDescription methodsFor: 'operations' stamp: 'ar 11/28/2007 20:57'!
classify: selector under: heading fromTrait: aTrait
        "Update the organization for a trait"
        super classify: selector under: heading fromTrait: aTrait.
        self users do:[:each| each classify: selector under: heading fromTrait: aTrait].! !

!TraitDescription methodsFor: 'operations' stamp: 'ar 11/28/2007 20:58'!
recompile: selector from: oldClass
        "Duplicated to avoid calling our version of addSelectorSilently:"
        | method trailer methodNode |
        method := oldClass compiledMethodAt: selector.
        trailer := method trailer.
        methodNode := self compilerClass new
                                compile: (oldClass sourceCodeAt: selector)
                                in: self
                                notifying: nil
                                ifFail: [^ self].   "Assume OK after proceed from SyntaxError"
        selector == methodNode selector ifFalse: [self error: 'selector changed!!'].
        super addSelectorSilently: selector withMethod: (methodNode generate: trailer).
! !

!TraitDescription methodsFor: 'operations' stamp: 'ar 11/28/2007 20:59'!
traitsDo: aBlock
        aBlock value: self.! !

!TraitDescription methodsFor: 'operations' stamp: 'ar 11/28/2007 21:02'!
+ aTrait
        "Creates a composition with the receiver and aTrait"
        ^TraitComposition withAll: {self. aTrait}! !

!TraitDescription methodsFor: 'operations' stamp: 'ar 11/28/2007 21:03'!
- anArrayOfSelectors
        "Creates an exclusion"
        ^TraitExclusion
                with: self
                exclusions: anArrayOfSelectors! !

!TraitDescription methodsFor: 'operations' stamp: 'ar 11/28/2007 21:03'!
@ anArrayOfAssociations
        "Creates an alias"
        ^ TraitAlias with: self aliases: anArrayOfAssociations! !


!Metatrait methodsFor: 'initialize' stamp: 'ar 11/22/2007 04:20'!
updateTraitsFrom: instanceTraits
        "Update me from the given instance traits"
        | map newTraits trait |
        map := Dictionary new.
        self traitComposition do:[:composed| map at: composed theTrait put: composed].
        newTraits := (instanceTraits collect:[:composed|
                trait := composed theTrait classTrait.
                map at: trait ifAbsent:[trait]]
        ), (self traitComposition select:[:comp| comp theTrait isBaseTrait]).

        self installTraitsFrom: newTraits! !

!Metatrait methodsFor: 'initialize' stamp: 'ar 11/22/2007 04:26'!
uses: aTraitComposition
        | newTraits |
        newTraits := (aTraitComposition isTrait or:[aTraitComposition isTraitTransformation])
                ifTrue:[TraitComposition with: aTraitComposition]
                ifFalse:[(aTraitComposition isKindOf: SequenceableCollection)
                                        ifTrue:[TraitComposition withAll: aTraitComposition asArray]
                                        ifFalse:[self error: 'Invalid traits specification']].
        newTraits traitsDo:[:t|
                (t isBaseTrait and:[t classSide hasMethods])
                        ifTrue:[self error: 'Cannot add: ', t].
                (t isClassTrait and:[(baseTrait usesTrait: t baseTrait) not])
                        ifTrue:[self error: 'Cannot add: ', t].
        ].
        self installTraitsFrom: newTraits.! !

!Metatrait methodsFor: 'accessing' stamp: 'ar 11/18/2007 23:00'!
baseTrait
        ^baseTrait! !

!Metatrait methodsFor: 'accessing' stamp: 'ar 11/22/2007 06:34'!
definitionST80
        ^String streamContents: [:stream |
                stream nextPutAll: self name.
                stream cr; tab; nextPutAll: 'uses: ';
                                nextPutAll: self traitComposition traitCompositionString.
        ].! !

!Metatrait methodsFor: 'accessing' stamp: 'ar 5/11/2008 01:51'!
instanceSide
        ^self baseTrait! !

!Metatrait methodsFor: 'accessing' stamp: 'ar 11/18/2007 21:44'!
name
        ^baseTrait name, ' classTrait'! !

!Metatrait methodsFor: 'accessing' stamp: 'ar 11/18/2007 21:45'!
new
        baseTrait ifNotNil:[self error: 'Already initialized'].
        baseTrait := self basicNew initialize.
        baseTrait
                superclass: nil
                methodDictionary: MethodDictionary new
                format: Object format.
        ^baseTrait! !

!Metatrait methodsFor: 'testing' stamp: 'ar 11/18/2007 22:59'!
isClassTrait
        ^true! !

!Metatrait methodsFor: 'testing' stamp: 'ar 11/18/2007 22:21'!
isMeta
        ^true! !


!Trait methodsFor: 'initialize' stamp: 'ar 11/28/2007 21:02'!
definitionST80
        ^String streamContents: [:stream |
                stream nextPutAll: 'Trait named: ';
                                store: self name.
                stream cr; tab; nextPutAll: 'uses: ';
                                nextPutAll: self traitComposition traitCompositionString.
                stream cr; tab; nextPutAll: 'category: ';
                                store: self category asString].! !

!Trait methodsFor: 'initialize' stamp: 'ar 11/18/2007 15:33'!
isValidTraitName: aSymbol
        ^(aSymbol isEmptyOrNil
                or: [aSymbol first isLetter not]
                or: [aSymbol anySatisfy: [:character | character isAlphaNumeric not]]) not! !

!Trait methodsFor: 'initialize' stamp: 'ar 11/28/2007 21:00'!
obsolete
        self name: ('AnObsolete' , self name) asSymbol.
        super obsolete! !

!Trait methodsFor: 'initialize' stamp: 'ar 11/28/2007 21:00'!
removeFromSystem
        self removeFromSystem: true! !

!Trait methodsFor: 'initialize' stamp: 'ar 11/28/2007 21:00'!
removeFromSystem: logged
        self environment forgetClass: self logged: logged.
        self obsolete! !

!Trait methodsFor: 'initialize' stamp: 'ar 11/18/2007 15:41'!
rename: aString
        "The new name of the receiver is the argument, aString."

        | newName |
        (newName := aString asSymbol) ~= self name
                ifFalse: [^ self].
        (self environment includesKey: newName)
                ifTrue: [^ self error: newName , ' already exists'].
        (Undeclared includesKey: newName)
                ifTrue: [self inform: 'There are references to, ' , aString printString , '
from Undeclared. Check them after this change.'].
        self environment renameClass: self as: newName.
        name := newName! !

!Trait methodsFor: 'initialize' stamp: 'ar 11/18/2007 15:33'!
setName: aSymbol andRegisterInCategory: categorySymbol environment: aSystemDictionary
        (self isValidTraitName: aSymbol) ifFalse: [self error:'Invalid trait name'].

        (self environment == aSystemDictionary
                and: [self name = aSymbol
                        and: [self category = categorySymbol]]) ifTrue: [^self].
               
        ((aSystemDictionary includes: aSymbol) and: [(aSystemDictionary at: aSymbol) ~~ self])
                ifTrue: [self error: 'The name ''' , aSymbol , ''' is already used'].

        (self environment notNil and: [self name notNil and: [self name ~= aSymbol]]) ifTrue: [
                self environment renameClass: self as: aSymbol].
       
        self name: aSymbol.
        self environment: aSystemDictionary.
        self environment at: self name put: self.
        self environment organization classify: self name under: categorySymbol.
        ^ true! !

!Trait methodsFor: 'accessing' stamp: 'ar 11/18/2007 15:37'!
category
        "Answer the system organization category for the receiver. First check whether the
        category name stored in the ivar is still correct and only if this fails look it up
        (latter is much more expensive)"

        | result |
        category ifNotNilDo: [ :symbol |
                ((SystemOrganization listAtCategoryNamed: symbol) includes: self name)
                        ifTrue: [ ^symbol ] ].
        category := (result := SystemOrganization categoryOfElement: self name).
        ^result! !

!Trait methodsFor: 'accessing' stamp: 'ar 11/18/2007 15:38'!
category: aString
        "Categorize the receiver under the system category, aString, removing it from
        any previous categorization."

        | oldCategory |
        oldCategory := category.
        aString isString
                ifTrue: [
                        category := aString asSymbol.
                        SystemOrganization classify: self name under: category ]
                ifFalse: [self errorCategoryName].
        SystemChangeNotifier uniqueInstance
                class: self recategorizedFrom: oldCategory to: category! !

!Trait methodsFor: 'accessing' stamp: 'ar 11/18/2007 21:48'!
classTrait
        ^self class! !

!Trait methodsFor: 'accessing' stamp: 'ar 11/18/2007 15:37'!
environment
        ^environment! !

!Trait methodsFor: 'accessing' stamp: 'ar 11/18/2007 15:37'!
environment: anObject
        environment := anObject! !

!Trait methodsFor: 'accessing' stamp: 'ar 11/18/2007 15:37'!
name
        ^name! !

!Trait methodsFor: 'accessing' stamp: 'ar 11/18/2007 15:37'!
name: aSymbol
        name := aSymbol! !

!Trait methodsFor: 'testing' stamp: 'ar 5/11/2008 01:57'!
hasClassTrait
        ^true! !

!Trait methodsFor: 'testing' stamp: 'ar 11/18/2007 22:59'!
isBaseTrait
        ^true! !

!Trait methodsFor: 'testing' stamp: 'ar 11/18/2007 15:41'!
isObsolete
        "Return true if the receiver is obsolete."
        ^(self environment at: name ifAbsent: [nil]) ~~ self! !


!Metatrait class methodsFor: 'instance creation' stamp: 'ar 11/18/2007 21:25'!
new
        | newMeta |
        newMeta := super new.
        newMeta
                superclass: Trait
                methodDictionary: MethodDictionary new
                format: Trait format.
        ^newMeta! !


!Trait class methodsFor: 'instance creation' stamp: 'ar 5/1/2008 21:16'!
named: aSymbol uses: aTraitCompositionOrCollection category: aString
        | env |
        env := self environment.
        ^self
                named: aSymbol
                uses: aTraitCompositionOrCollection
                category: aString
                env: env! !

!Trait class methodsFor: 'instance creation' stamp: 'ar 5/11/2008 02:34'!
named: aSymbol uses: aTraitComposition category: aString env: anEnvironment
        | trait oldTrait systemCategory oldCategory |
        systemCategory := aString asSymbol.
        oldTrait := anEnvironment at: aSymbol ifAbsent: [nil].
        oldTrait ifNil:[
                trait := Metatrait new new.
        ] ifNotNil:[
                oldCategory := oldTrait category.
                trait := oldTrait.
        ].
        (trait isKindOf: Trait) ifFalse: [
                ^self error: trait name , ' is not a Trait'].
        trait
                setName: aSymbol
                andRegisterInCategory: systemCategory
                environment: anEnvironment.

        trait uses: aTraitComposition.
       
        "... notify interested clients ..."
        oldTrait ifNil:[
                SystemChangeNotifier uniqueInstance classAdded: trait inCategory: systemCategory.
        ] ifNotNil:[
                systemCategory = oldCategory  ifFalse:[
                        SystemChangeNotifier uniqueInstance class: trait
                                recategorizedFrom: oldTrait category to: systemCategory].
        ].
        ^ trait! !


!TraitTransformation methodsFor: 'initialize' stamp: 'ar 11/18/2007 17:32'!
initialize
        super initialize.
        users := #().! !

!TraitTransformation methodsFor: 'accessing' stamp: 'ar 11/18/2007 19:12'!
addUser: aTrait
        users ifEmpty:[subject addUser: self].
        users := users copyWith: aTrait.! !

!TraitTransformation methodsFor: 'accessing' stamp: 'ar 11/18/2007 19:12'!
allTraits
        ^subject allTraits! !

!TraitTransformation methodsFor: 'accessing' stamp: 'ar 11/18/2007 19:11'!
removeUser: aTrait
        users := users copyWithout: aTrait.
        users ifEmpty:[subject removeUser: self].
! !

!TraitTransformation methodsFor: 'accessing' stamp: 'ar 11/18/2007 19:12'!
subject: aSubject
        subject := aSubject.! !

!TraitTransformation methodsFor: 'accessing' stamp: 'ar 11/22/2007 06:08'!
theTrait
        ^subject theTrait! !

!TraitTransformation methodsFor: 'accessing' stamp: 'ar 11/22/2007 06:08'!
traitsDo: aBlock
        ^subject traitsDo: aBlock! !

!TraitTransformation methodsFor: 'accessing' stamp: 'ar 11/18/2007 21:02'!
traitUsers
        "Answer this traits users, without the transforms in the middle"
        ^users gather:[:each|
                (each isBehavior)
                        ifTrue:[Array with: each]
                        ifFalse:[each traitUsers]].! !

!TraitTransformation methodsFor: 'testing' stamp: 'ar 5/11/2008 02:13'!
isAliasSelector: selector
        ^subject isAliasSelector: selector! !

!TraitTransformation methodsFor: 'testing' stamp: 'ar 5/11/2008 02:17'!
isLocalAliasSelector: selector
        ^false! !

!TraitTransformation methodsFor: 'testing' stamp: 'ar 11/22/2007 04:24'!
isTraitTransformation
        "Polymorphic with Trait"
        ^true! !

!TraitTransformation methodsFor: 'testing' stamp: 'ar 11/22/2007 06:08'!
usesTrait: aTrait
        ^subject usesTrait: aTrait! !

!TraitTransformation methodsFor: 'composition' stamp: 'ar 11/22/2007 06:14'!
classify: selector under: category fromTrait: aTrait
        "broadcasts a reclassification of some selector to all users of a trait"
        ^self subclassResponsibility! !

!TraitTransformation methodsFor: 'composition' stamp: 'ar 11/22/2007 06:18'!
copyTraitExpression
        "Copy all except the actual traits"
        ^self subclassResponsibility! !

!TraitTransformation methodsFor: 'composition' stamp: 'ar 11/22/2007 06:12'!
selectorsAndMethodsDo: aBlock
        "enumerates all selectors and methods in a trait composition"
        ^self subclassResponsibility! !

!TraitTransformation methodsFor: 'composition' stamp: 'ar 11/22/2007 06:15'!
traitCompositionString
        "Answer the trait composition string (used for class definitions)"
        ^self subclassResponsibility! !

!TraitTransformation methodsFor: 'composition' stamp: 'ar 11/22/2007 06:12'!
updateSelector: aSelector withTraitMethod: compiledMethod from: aTrait
        "broadcasts the change of a selector to all users of a trait"
        ^self subclassResponsibility! !

!TraitTransformation methodsFor: 'printing' stamp: 'ar 11/22/2007 06:19'!
asString
        ^self traitCompositionString! !

!TraitTransformation methodsFor: 'printing' stamp: 'ar 11/22/2007 06:19'!
printOn: aStream
        super printOn: aStream.
        aStream nextPut: $(; print: users; nextPutAll: ': '; nextPutAll: self traitCompositionString; nextPut: $).! !

!TraitTransformation methodsFor: 'converting' stamp: 'ar 11/18/2007 17:44'!
asTraitTransform
        ^self! !

!TraitTransformation methodsFor: 'converting' stamp: 'ar 11/22/2007 04:07'!
+ aTrait
        "Just like ordered collection"
        ^TraitComposition withAll: {self. aTrait}! !

!TraitTransformation methodsFor: 'converting' stamp: 'ar 11/18/2007 23:13'!
- anArrayOfSelectors
        ^TraitExclusion
                with: self
                exclusions: anArrayOfSelectors! !

!TraitTransformation methodsFor: 'converting' stamp: 'ar 11/18/2007 23:14'!
@ anArrayOfAssociations
        self error: 'Invalid trait exclusion. Aliases have to be specified before exclusions.'! !


!TraitAlias methodsFor: 'initialize-release' stamp: 'ar 11/18/2007 17:14'!
initialize
        super initialize.
        aliases := Dictionary new.! !

!TraitAlias methodsFor: 'initialize-release' stamp: 'ar 5/11/2008 02:28'!
initializeFrom: anArrayOfAssociations
        | newNames |
        newNames := (anArrayOfAssociations collect: [:each | each key]) asIdentitySet.
        newNames size < anArrayOfAssociations size ifTrue: [
                TraitCompositionException signal: 'Cannot use the same alias name twice'].
        anArrayOfAssociations do: [:each |
                (newNames includes: each value) ifTrue: [
                        TraitCompositionException signal: 'Cannot define an alias for an alias']].
        aliases := Dictionary new.
        anArrayOfAssociations do:[:assoc|
                aliases at: assoc value put: assoc key.
        ].! !

!TraitAlias methodsFor: 'accessing' stamp: 'ar 11/18/2007 17:07'!
aliases
        "Collection of associations where key is the
        alias and value the original selector."
       
        ^aliases! !

!TraitAlias methodsFor: 'accessing' stamp: 'ar 11/18/2007 17:45'!
aliases: aDictionary
        aliases := aDictionary! !

!TraitAlias methodsFor: 'composition' stamp: 'ar 5/1/2008 21:14'!
classify: selector under: category fromTrait: aTrait
        "broadcasts a reclassification of some selector to all users of a trait"
        ^users do:[:each|
                each classify: selector under: category fromTrait: aTrait.
                (aliases includesKey: selector) ifTrue:[
                        each classify: (aliases at: selector) under: category fromTrait: aTrait.
                ].
        ].! !

!TraitAlias methodsFor: 'composition' stamp: 'ar 11/22/2007 06:18'!
copyTraitExpression
        "Copy all except the actual traits"
        ^TraitAlias
                with: subject
                aliases: (Array streamContents:[:s|
                        aliases associationsDo:[:a| s nextPut: a value -> a key]])
! !

!TraitAlias methodsFor: 'composition' stamp: 'ar 5/1/2008 21:14'!
includesSelector: selector
        "Answers true if the receiver provides the selector"
        ^(subject includesSelector: selector) or:[aliases includesKey: selector]! !

!TraitAlias methodsFor: 'composition' stamp: 'ar 5/1/2008 21:15'!
selectorsAndMethodsDo: aBlock
        "enumerates all selectors and methods in a trait composition"
        ^subject selectorsAndMethodsDo:[:sel :meth|
                aBlock value: sel value: meth.
                (aliases includesKey: sel)
                        ifTrue:[aBlock value: (aliases at: sel ifAbsent:[sel]) value: meth]
        ].! !

!TraitAlias methodsFor: 'composition' stamp: 'ar 11/22/2007 06:16'!
traitCompositionString
        "Answer the trait composition string (used for class definitions)"
        ^String streamContents:[:s|
                s nextPutAll: subject traitCompositionString.
                s nextPutAll: ' @ {'.
                aliases keys asArray sort do:[:original|
                        s print: (aliases at: original); nextPutAll: ' -> '; print: original.
                ] separatedBy:[s nextPutAll:'. '].
                s nextPutAll: '}'.
        ].! !

!TraitAlias methodsFor: 'composition' stamp: 'ar 5/1/2008 21:15'!
updateSelector: aSelector withTraitMethod: compiledMethod from: aTrait
        "broadcasts the change of a selector to all users of a trait"
        users do:[:each|
                each updateSelector: aSelector withTraitMethod: compiledMethod from: aTrait.
                (aliases includesKey: aSelector) ifTrue:[
                        each updateSelector: (aliases at: aSelector ifAbsent:[aSelector])
                                withTraitMethod: compiledMethod from: aTrait
                ].
        ].! !

!TraitAlias methodsFor: 'converting' stamp: 'ar 11/18/2007 18:11'!
asArrayOfAssociations
        "Awkward, compatible mapped -> original representation"
        ^Array streamContents:[:s|
                aliases keysAndValuesDo:[:original :mapped|
                        s nextPut: mapped -> original.
                ].
        ].! !

!TraitAlias methodsFor: 'converting' stamp: 'ar 11/18/2007 19:13'!
@ anArrayOfAssociations
        ^TraitAlias
                with: subject
                aliases: (anArrayOfAssociations, self asArrayOfAssociations)! !

!TraitAlias methodsFor: 'testing' stamp: 'ar 5/11/2008 02:17'!
isAliasSelector: selector
        ^(aliases includes: selector) or:[super isAliasSelector: selector]! !

!TraitAlias methodsFor: 'testing' stamp: 'ar 5/11/2008 02:17'!
isLocalAliasSelector: selector
        ^(aliases includes: selector)! !


!TraitExclusion methodsFor: 'initialize' stamp: 'ar 11/18/2007 17:16'!
initialize
        super initialize.
        exclusions := Set new.
! !

!TraitExclusion methodsFor: 'accessing' stamp: 'ar 11/18/2007 18:04'!
exclusions
        ^exclusions! !

!TraitExclusion methodsFor: 'accessing' stamp: 'ar 11/18/2007 18:04'!
exclusions: aCollection
        exclusions := Set withAll: aCollection! !

!TraitExclusion methodsFor: 'composition' stamp: 'ar 11/22/2007 06:13'!
classify: selector under: category fromTrait: aTrait
        "broadcasts a reclassification of some selector to all users of a trait"
        (exclusions includes: selector) ifFalse:[
                users do:[:each| each classify: selector under: category fromTrait: aTrait]
        ].! !

!TraitExclusion methodsFor: 'composition' stamp: 'ar 11/22/2007 06:19'!
copyTraitExpression
        "Copy all except the actual traits"
        ^TraitExclusion
                with: subject
                exclusions: exclusions asArray! !

!TraitExclusion methodsFor: 'composition' stamp: 'ar 11/27/2007 22:10'!
includesSelector: selector
        "Answers true if the receiver provides the selector"
        ^(subject includesSelector: selector) and:[(exclusions includes: selector) not]! !

!TraitExclusion methodsFor: 'composition' stamp: 'ar 11/22/2007 06:12'!
selectorsAndMethodsDo: aBlock
        "enumerates all selectors and methods in a trait composition"
        ^subject selectorsAndMethodsDo:[:sel :meth|
                (exclusions includes: sel) ifFalse:[aBlock value: sel value: meth].
        ].! !

!TraitExclusion methodsFor: 'composition' stamp: 'ar 11/22/2007 06:17'!
traitCompositionString
        "Answer the trait composition string (used for class definitions)"
        ^String streamContents:[:s|
                s nextPutAll: subject traitCompositionString.
                s nextPutAll: ' - {'.
                exclusions asArray sort do:[:exc| s store: exc] separatedBy:[s nextPutAll: '. '].
                s nextPutAll: '}'.
        ].! !

!TraitExclusion methodsFor: 'composition' stamp: 'ar 11/22/2007 06:11'!
updateSelector: aSelector withTraitMethod: compiledMethod from: aTrait
        "broadcasts the change of a selector to all users of a trait"
        (exclusions includes: aSelector) ifFalse:[
                users do:[:each| each updateSelector: aSelector withTraitMethod: compiledMethod from: aTrait]
        ].! !

!TraitExclusion methodsFor: 'converting' stamp: 'ar 11/18/2007 18:09'!
- anArrayOfSelectors
        ^TraitExclusion
                with: subject
                exclusions: (anArrayOfSelectors, exclusions asArray)! !


!TraitAlias class methodsFor: 'instance creation' stamp: 'ar 5/11/2008 02:27'!
assertValidAliasDefinition: anArrayOfAssociations
        "Throw an exceptions if the alias definition is not valid.
        It is expected to be a collection of associations and
        the number of arguments of the alias selector has to
        be the same as the original selector."

        ((anArrayOfAssociations isKindOf: Collection) and: [
                anArrayOfAssociations allSatisfy: [:each |
                        each isKindOf: Association]]) ifFalse: [
                self error: 'Invalid alias definition: Not a collection of associations.'].
       
        (anArrayOfAssociations allSatisfy: [:association |
                (association key numArgs = association value numArgs and: [
                        (association key numArgs = -1) not])]) ifFalse: [
                TraitCompositionException signal: 'Invalid alias definition: Alias and original selector have to have the same number of arguments.']! !

!TraitAlias class methodsFor: 'instance creation' stamp: 'ar 11/18/2007 17:45'!
with: aTraitComposition aliases: anArrayOfAssociations
        self assertValidAliasDefinition: anArrayOfAssociations.
        ^self new
                subject: aTraitComposition;
                initializeFrom: anArrayOfAssociations;
                yourself! !


!TraitExclusion class methodsFor: 'instance creation' stamp: 'ar 11/18/2007 18:04'!
with: aTraitComposition exclusions: anArrayOfSelectors
        ^self new
                subject: aTraitComposition;
                exclusions: anArrayOfSelectors;
                yourself
! !


!TraitExclusion class reorganize!
('instance creation' with:exclusions:)
!


!TraitAlias class reorganize!
('instance creation' assertValidAliasDefinition: with:aliases:)
!


!TraitTransformation class reorganize!
('as yet unclassified')
!


!TraitExclusion reorganize!
(