The Trunk: Traits-ar.253.mcz

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

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

Name: Traits-ar.253
Author: ar
Time: 29 December 2009, 4:27:03 am
UUID: aacbbb6c-5526-f04e-927d-4461d769972f
Ancestors: Traits-ar.252

Install NanoTraits.

=============== Diff against Traits-ar.251 ===============

Item was added:
+ ----- Method: ClassDescription>>traitAddSelector:withMethod: (in category '*Traits-NanoKernel') -----
+ traitAddSelector: selector withMethod: traitMethod
+ "Add a method inherited from a trait.
+ Recompiles to avoid sharing and implement aliasing."
+ | oldMethod source methodNode newMethod originalSelector |
+ oldMethod := self compiledMethodAt: selector ifAbsent:[nil].
+ oldMethod ifNotNil:[
+ "The following is an important optimization as it prevents exponential
+ growth in recompilation. If T1 is used by T2 and T2 by T3 then (without
+ this optimization) any change in T1 would cause all methods in T2 to be
+ recompiled and each recompilation of a method in T2 would cause T3
+ to be fully recompiled. The test eliminates all such situations."
+ (oldMethod sameTraitCodeAs: traitMethod) ifTrue:[^oldMethod].
+ ].
+ originalSelector := traitMethod selector.
+ source := traitMethod methodClass sourceCodeAt: originalSelector.
+ originalSelector == selector ifFalse:[
+ "Replace source selectors for aliases"
+ source := self replaceSelector: originalSelector withAlias: selector in: source.
+ ].
+ methodNode := self compilerClass new
+ compile: source in: self classified: nil notifying: nil ifFail:[^nil].
+ newMethod := methodNode generate: self defaultMethodTrailer.
+ newMethod putSource: source fromParseNode: methodNode inFile: 2
+ withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Trait method'; cr].
+ newMethod originalTraitMethod: traitMethod.
+ ^super addSelectorSilently: selector withMethod: newMethod.!

Item was added:
+ ----- Method: ClassDescription>>isLocalMethod: (in category '*Traits-NanoKernel') -----
+ isLocalMethod: aCompiledMethod
+ "Answer true if the method is a local method, e.g., defined in the receiver instead of a trait."
+ ^aCompiledMethod methodHome == self!

Item was added:
+ ----- Method: Metaclass>>updateTraitsFrom: (in category '*Traits-NanoKernel') -----
+ updateTraitsFrom: instanceTraits
+ "Update me from the given instance traits"
+ | map newTraits trait |
+ ((instanceTraits isKindOf: NanoTraitComposition) or:[instanceTraits isEmpty])
+ ifFalse:[self error: 'Invalid 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 added:
+ ----- Method: NanoTrait>>baseTrait (in category 'accessing') -----
+ baseTrait
+ ^self!

Item was added:
+ ----- Method: NanoTraitDescription>>traitComposition: (in category 'accessing') -----
+ traitComposition: aTraitComposition
+ traitComposition := aTraitComposition.
+ !

Item was added:
+ ----- Method: ClassDescription>>setTraitComposition: (in category '*Traits-NanoKernel') -----
+ setTraitComposition: aTraitComposition
+ "OBSOLETE. Use Class uses: aTraitComposition instead."
+ (aTraitComposition isKindOf: NanoTraitComposition)
+ ifTrue:[^self uses: aTraitComposition].
+ (aTraitComposition isKindOf: TraitComposition)
+ ifTrue:[^super setTraitComposition: aTraitComposition].
+ "Unspecified. Check for prevailing traitOverride"
+ ClassDescription traitImpl == NanoTrait
+ ifTrue:[^self uses: aTraitComposition]
+ ifFalse:[^super setTraitComposition: aTraitComposition].!

Item was added:
+ ----- Method: NanoClassTrait>>soleInstance (in category 'accessing') -----
+ soleInstance
+ ^baseTrait!

Item was added:
+ ----- Method: NanoTraitDescription>>isClassTrait (in category 'testing') -----
+ isClassTrait
+ ^false!

Item was added:
+ ----- Method: NanoTraitComposition>>isAliasSelector: (in category 'operations') -----
+ isAliasSelector: selector
+ "enumerates all selectors and methods in a trait composition"
+ ^self anySatisfy:[:any| any isAliasSelector: selector]!

Item was added:
+ ----- Method: NanoTraitTransformation>>addTraitUser: (in category 'accessing') -----
+ addTraitUser: aTrait
+ users := users copyWith: aTrait.
+ subject addTraitUser: aTrait.
+ !

Item was added:
+ ----- Method: NanoTrait class>>updateTraits: (in category 'installing') -----
+ updateTraits: aCollection
+ "Convert all the traits in aCollection to NanoTraits. Used during installation."
+ "ClassDescription traitImpl: NanoTrait.
+ NanoTrait updateTraits:{
+ TSequencedStreamTest. TGettableStreamTest. TReadStreamTest.
+ TStreamTest. TPuttableStreamTest. TWriteStreamTest
+ }"
+ | remain processed classes oldTrait classDef newTrait count instTraits classSelectors |
+ ClassDescription traitImpl == self ifFalse:[self error: 'What are you doing???'].
+ remain := (aCollection reject:[:tc| tc isKindOf: self]) asSet.
+ processed := Set new.
+ classes := Set new.
+ count := 0.
+ 'Converting ....' displayProgressAt: Sensor cursorPoint from: 1 to: remain size during:[:bar|
+ [remain isEmpty] whileFalse:[
+ "Pick any trait whose traits are already converted"
+ oldTrait := remain detect:[:any|
+ any traitComposition traits allSatisfy:[:t| (Smalltalk at: t name) isKindOf: self].
+ ] ifNone:[self error: 'Cannot convert cyclic traits'].
+ remain remove: oldTrait.
+
+ bar value: (count := count +1).
+ ProgressNotification signal: '' extra: 'Converting ', oldTrait name.
+
+ "Silently remove the old trait class and recreate it based on NanoTrait"
+ classDef := oldTrait definition.
+ Smalltalk removeKey: oldTrait name.
+
+ "Create the NanoTrait from the same definition"
+ newTrait := Compiler evaluate: classDef.
+
+ "Update comment"
+ oldTrait organization classComment ifNotEmpty:[
+ newTrait classComment: oldTrait organization commentRemoteStr
+ stamp: oldTrait organization commentStamp.
+ ].
+
+ "Copy local methods to new trait"
+ oldTrait localSelectors do:[:sel|
+ newTrait
+ compile: (oldTrait sourceCodeAt: sel)
+ classified: (oldTrait organization categoryOfElement: sel)
+ withStamp: (oldTrait compiledMethodAt: sel) timeStamp
+ notifying: nil
+ ].
+ oldTrait classSide localSelectors do:[:sel|
+ newTrait classSide
+ compile: (oldTrait classSide sourceCodeAt: sel)
+ classified: (oldTrait classSide organization categoryOfElement: sel)
+ withStamp: (oldTrait classSide compiledMethodAt: sel) timeStamp
+ notifying: nil
+ ].
+
+ newTrait selectors sort = oldTrait selectors sort
+ ifFalse:[self error: 'Something went VERY wrong'].
+ newTrait classSide selectors sort = oldTrait classSide selectors sort
+ ifFalse:[self error: 'Something went VERY wrong'].
+
+ processed add: oldTrait.
+ classes addAll: (oldTrait users reject:[:aClass| aClass isObsolete]).
+ ].
+ ].
+
+ classes := classes asArray select:[:cls| cls isKindOf: ClassDescription].
+ 'Updating ....' displayProgressAt: Sensor cursorPoint from: 1 to: classes size during:[:bar|
+ "The traits are all converted, next update the classes"
+ classes keysAndValuesDo:[:index :aClass|
+ bar value: index.
+ ProgressNotification signal: '' extra: 'Updating ', aClass name.
+
+ instTraits := Compiler evaluate: aClass traitComposition asString.
+ "Keep the local selectors from before"
+ localSelectors := aClass localSelectors.
+ classSelectors := aClass class localSelectors.
+ "Nuke the old traits composition"
+ aClass traitComposition: nil.
+ aClass class traitComposition: nil.
+ "Install the new one"
+ aClass uses: instTraits.
+ "Remove the old trait (now local) selectors"
+ (aClass selectors reject:[:sel| localSelectors includes: sel]) do:[:sel|
+ aClass removeSelectorSilently: sel.
+ (aClass includesSelector: sel) ifFalse:[self halt: 'Where is the code?'].
+ ].
+ (aClass class selectors reject:[:sel| classSelectors includes: sel]) do:[:sel|
+ aClass class removeSelectorSilently: sel.
+ (aClass class includesSelector: sel) ifFalse:[self halt: 'Where is the code?'].
+ ].
+ ].
+ ].
+
+ "Finally, obsolete all the old traits"
+ processed do:[:trait| trait obsolete].
+ !

Item was added:
+ ----- Method: NanoTraitDescription>>@ (in category 'operations') -----
+ @ anArrayOfAssociations
+ "Creates an alias"
+ ^ NanoTraitAlias with: self aliases: anArrayOfAssociations!

Item was added:
+ ----- Method: ClassDescription>>traitRemoveSelector: (in category '*Traits-NanoKernel') -----
+ traitRemoveSelector: selector
+ "Remove the message whose selector is given from the method
+ dictionary of the receiver, if it is there. Answer nil otherwise."
+ | priorMethod priorProtocol |
+ priorMethod := self compiledMethodAt: selector ifAbsent: [^ nil].
+ priorProtocol := self whichCategoryIncludesSelector: selector.
+ SystemChangeNotifier uniqueInstance doSilently: [
+ self organization removeElement: selector].
+ super basicRemoveSelector: selector.
+ SystemChangeNotifier uniqueInstance
+ methodRemoved: priorMethod selector: selector inProtocol: priorProtocol class: self.
+ (self organization isEmptyCategoryNamed: priorProtocol)
+ ifTrue:[self organization removeCategory: priorProtocol].
+ !

Item was added:
+ ----- Method: NanoTraitDescription class>>conflict:with:with:with:with:with: (in category 'conflict methods') -----
+ conflict: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6
+ "This method has a trait conflict"
+ ^self traitConflict!

Item was added:
+ ----- Method: NanoTraitComposition>>@ (in category 'converting') -----
+ @ 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)!

Item was added:
+ ----- Method: NanoTraitDescription>>fileOut (in category 'fileIn/Out') -----
+ fileOut
+ "Create a file whose name is the name of the receiver with '.st' as the
+ extension, and file a description of the receiver onto it."
+ ^ self fileOutAsHtml: false!

Item was added:
+ ----- Method: NanoClassTrait>>theNonMetaClass (in category 'accessing') -----
+ theNonMetaClass
+ "Sent to a class or metaclass, always return the class"
+ ^baseTrait!

Item was added:
+ ----- Method: NanoTraitExclusion>>@ (in category 'converting') -----
+ @ anArrayOfAssociations
+
+ NanoTraitCompositionException signal: 'Invalid trait exclusion. Aliases have to be specified before exclusions.'
+ !

Item was added:
+ ----- Method: NanoTraitExclusion>>includesSelector: (in category 'composition') -----
+ includesSelector: selector
+ "Answers true if the receiver provides the selector"
+ ^(subject includesSelector: selector) and:[(exclusions includes: selector) not]!

Item was added:
+ ----- Method: NanoTraitTransformation>>isAliasSelector: (in category 'testing') -----
+ isAliasSelector: selector
+ ^subject isAliasSelector: selector!

Item was added:
+ ----- Method: NanoTrait>>obsolete (in category 'initialize') -----
+ obsolete
+ self name: ('AnObsolete' , self name) asSymbol.
+ super obsolete!

Item was added:
+ ----- Method: NanoTraitComposition>>isLocalAliasSelector: (in category 'operations') -----
+ isLocalAliasSelector: selector
+ "Return true if the selector aSymbol is an alias defined in the receiver."
+ ^self anySatisfy:[:any| any isTraitTransformation and:[any isLocalAliasSelector: selector]]!

Item was added:
+ ----- Method: NanoTraitTransformation>>removeTraitUser: (in category 'accessing') -----
+ removeTraitUser: aTrait
+ users := users copyWithout: aTrait.
+ subject removeTraitUser: aTrait.!

Item was added:
+ ----- Method: NanoTraitTransformation>>allTraits (in category 'accessing') -----
+ allTraits
+ ^subject allTraits!

Item was added:
+ ----- Method: NanoTraitDescription>>installTraitsFrom: (in category 'operations') -----
+ installTraitsFrom: aTraitComposition
+ super installTraitsFrom: aTraitComposition.
+ self users do:[:each| each updateTraits].!

Item was added:
+ ----- Method: NanoTraitTransformation>>@ (in category 'converting') -----
+ @ anArrayOfAssociations
+ ^self subclassResponsibility!

Item was added:
+ ----- Method: NanoTrait class>>named:uses:category: (in category 'public') -----
+ named: aSymbol uses: aTraitCompositionOrCollection category: aString
+ "Dispatch through ClassDescription for alternative implementations"
+ ^ClassDescription newTraitNamed: aSymbol uses: aTraitCompositionOrCollection category: aString!

Item was added:
+ NanoTraitTransformation subclass: #NanoTraitAlias
+ instanceVariableNames: 'aliases'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Traits-NanoKernel'!
+
+ !NanoTraitAlias commentStamp: '<historical>' prior: 0!
+ A trait transformation representing the alias (->) operator.!

Item was added:
+ ----- Method: NanoTraitDescription>>fileOutAsHtml: (in category 'fileIn/Out') -----
+ fileOutAsHtml: useHtml
+ "File a description of the receiver onto a new file whose base name is the name of the receiver."
+
+ | internalStream |
+ internalStream := WriteStream on: (String new: 100).
+ internalStream header; timeStamp.
+
+ self fileOutOn: internalStream moveSource: false toFile: 0.
+ internalStream trailer.
+
+ FileStream writeSourceCodeFrom: internalStream baseName: self name isSt: true useHtml: useHtml.
+ !

Item was added:
+ ----- Method: NanoTraitTransformation>>isLocalAliasSelector: (in category 'testing') -----
+ isLocalAliasSelector: selector
+ ^false!

Item was added:
+ ----- Method: NanoTraitTransformation>>updateTraits (in category 'operations') -----
+ updateTraits
+ "Recompute my users traits composition"
+ users do:[:each| each updateTraits].!

Item was added:
+ ----- Method: NanoTraitDescription>>printHierarchy (in category 'printing') -----
+ printHierarchy
+ "For hierarchy view in the browser; print the users of a trait"
+ ^String streamContents:[:s| self printUsersOf: self on: s level: 0].!

Item was added:
+ ----- Method: NanoTrait>>isObsolete (in category 'testing') -----
+ isObsolete
+ "Return true if the receiver is obsolete."
+ ^(self environment at: name ifAbsent: [nil]) ~~ self!

Item was added:
+ ----- Method: ClassDescription>>traitComposition: (in category '*Traits-NanoKernel') -----
+ traitComposition: aTraitComposition
+ "Install my traits"
+ ^self subclassResponsibility!

Item was added:
+ ----- Method: ClassDescription>>isAliasSelector: (in category '*Traits-NanoKernel') -----
+ 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]!

Item was added:
+ ----- Method: NanoClassTrait>>classSide (in category 'accessing') -----
+ classSide
+ ^self!

Item was added:
+ ----- Method: Array>>asTraitComposition (in category '*Traits-NanoKernel') -----
+ asTraitComposition
+ "For convenience the composition {T1. T2 ...} is the same as T1 + T2 + ..."
+ ^self isEmpty
+ ifFalse: [
+ self size = 1
+ ifTrue: [self first asTraitComposition]
+ ifFalse: [
+ self copyWithoutFirst
+ inject: self first
+ into: [:left :right | left + right]]]
+ ifTrue: [ClassDescription newTraitComposition]!

Item was added:
+ ----- Method: ClassDescription>>hasTraitComposition (in category '*Traits-NanoKernel') -----
+ hasTraitComposition
+ ^self traitComposition notEmpty!

Item was added:
+ ----- Method: ClassDescription>>classify:under:from:trait: (in category '*Traits-NanoKernel') -----
+ classify: selector under: heading from: category trait: aTrait
+ "Update the organization for a trait. the dumb, unoptimized version"
+ self updateTraits.!

Item was added:
+ ----- Method: ClassDescription>>localSelectors (in category '*Traits-NanoKernel') -----
+ localSelectors
+ ^(self traitComposition isKindOf: NanoTraitComposition)
+ ifTrue:[self selectors select:[:sel| self includesLocalSelector: sel]]
+ ifFalse:[super localSelectors].
+ !

Item was added:
+ ----- Method: NanoTraitComposition>>traitCompositionString (in category 'operations') -----
+ traitCompositionString
+ "Answer the trait composition string (used for class definitions)"
+ self size = 0 ifTrue:[^'{}'].
+ self  size = 1 ifTrue:[^self first asString].
+ ^String streamContents:[:s|
+ self do:[:each| s nextPutAll: each asString] separatedBy:[s nextPutAll: ' + '].
+ ].!

Item was added:
+ ----- Method: NanoTrait class>>unloadBerneTraits (in category 'installing') -----
+ unloadBerneTraits
+ "Unload Berne traits via Monticello"
+ #(TraitBehavior TraitDescription ClassTrait) do:[:clsName|
+ Smalltalk at: clsName ifPresent:[:aClass| aClass traitComposition: nil]].
+
+ "Special for Trait since it becomes a plain old global"
+ Smalltalk at: #Trait ifPresent:[:aClass|
+ aClass name == #Trait ifTrue:[aClass traitComposition: nil].
+ ].
+ Smalltalk at: #ModelExtension ifPresent:[:aClass|
+ aClass withAllSubclassesDo:[:subclass|
+ SystemChangeNotifier uniqueInstance noMoreNotificationsFor: subclass.
+ SystemChangeNotifier uniqueInstance noMoreNotificationsFor: subclass current.
+ ]].
+
+ (MCPackage named: 'Traits') unload.
+
+ Smalltalk allClassesDo:[:aClass|
+ aClass basicLocalSelectors: nil.
+ aClass class basicLocalSelectors: nil.
+ aClass traitComposition class isObsolete
+ ifTrue:[aClass traitComposition: nil].
+ aClass classSide traitComposition class isObsolete
+ ifTrue:[aClass classSide traitComposition: nil].
+ ].
+ !

Item was added:
+ ----- Method: ClassDescription>>isLocalAliasSelector: (in category '*Traits-NanoKernel') -----
+ 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]!

Item was added:
+ ----- Method: ClassDescription>>updateTraits (in category '*Traits-NanoKernel') -----
+ updateTraits
+ "Recompute my local traits composition"
+ (self traitComposition isKindOf: NanoTraitComposition)
+ ifTrue:[self installTraitsFrom: self traitComposition].
+ !

Item was added:
+ ----- Method: NanoTraitDescription class>>conflict: (in category 'conflict methods') -----
+ conflict: arg1
+ "This method has a trait conflict"
+ ^self traitConflict!

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

Item was added:
+ ----- Method: NanoClassTrait>>baseTrait (in category 'accessing') -----
+ baseTrait
+ ^baseTrait!

Item was added:
+ NanoTraitBehavior subclass: #NanoTraitDescription
+ instanceVariableNames: 'users traitComposition'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Traits-NanoKernel'!
+
+ !NanoTraitDescription commentStamp: 'ar 12/3/2009 23:42' prior: 0!
+ TraitDescription combines common behavior for both (instance) traits and (meta) class traits.!

Item was added:
+ ----- Method: NanoTraitAlias>>printOn: (in category 'operations') -----
+ printOn: s
+ "Answer the trait composition string (used for class definitions)"
+ s nextPutAll: subject asString.
+ s nextPutAll: ' @ {'.
+ aliases do:[:assoc| s print: assoc] separatedBy:[s nextPutAll:'. '].
+ s nextPutAll: '}'.
+ !

Item was added:
+ ----- Method: ClassDescription>>includesLocalSelector: (in category '*Traits-NanoKernel') -----
+ includesLocalSelector: selector
+ self traitComposition isEmpty "guard for Berne traits"
+ ifTrue:[^self includesSelector: selector].
+ ^(self traitComposition isKindOf: NanoTraitComposition)
+ ifTrue:[(self compiledMethodAt: selector ifAbsent:[^false]) methodHome == self]
+ ifFalse:[super includesLocalSelector: selector].!

Item was added:
+ ----- Method: NanoTraitAlias>>includesSelector: (in category 'operations') -----
+ includesSelector: selector
+ "Answers true if the receiver provides the selector"
+ ^(subject includesSelector: selector) or:[aliases anySatisfy:[:assoc| assoc key == selector]]!

Item was added:
+ Error subclass: #NanoTraitCompositionException
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Traits-NanoKernel'!
+
+ !NanoTraitCompositionException commentStamp: '<historical>' prior: 0!
+ Signals invalid trait compositions.!

Item was added:
+ ----- Method: ClassDescription>>installTraitsFrom: (in category '*Traits-NanoKernel') -----
+ installTraitsFrom: aTraitComposition
+ "Install the traits from the given composition"
+ | allTraits methods oldMethod removals oldCategories |
+ (aTraitComposition isKindOf: NanoTraitComposition)
+ ifFalse:[self error: 'Invalid composition'].
+ (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 removeTraitUser: self.
+ self traitComposition: aTraitComposition.
+ 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 class updateTraitsFrom: aTraitComposition].!

Item was added:
+ ----- Method: NanoTraitDescription>>classPool (in category 'accessing') -----
+ classPool
+ "Traits have no class pool"
+ ^ Dictionary new!

Item was added:
+ ----- Method: NanoTraitAlias>>aliases: (in category 'accessing') -----
+ aliases: aCollection
+ "Collection of associations where key is the
+ alias and value the original selector."
+ aliases := aCollection!

Item was added:
+ Object subclass: #NanoTraitTransformation
+ instanceVariableNames: 'subject users'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Traits-NanoKernel'!
+
+ !NanoTraitTransformation commentStamp: '<historical>' prior: 0!
+ A trait transformation is an instance of one of my concrete subclasses, TraitAlias or TraitExclusion. These represent a transformation of a trait, specified by the alias and exclusion operators.
+
+ I define an instance variable named subject which holds the object that is transformed.  Thus, an alias transformation has as its subject a trait, and a trait exclusion has as its subject either a trait alias or a trait. Each of the concrete transformation classes implement the method allSelectors according to the transformation it represents.
+ !

Item was added:
+ ----- Method: NanoTraitAlias>>isLocalAliasSelector: (in category 'testing') -----
+ isLocalAliasSelector: selector
+ ^(aliases anySatisfy:[:assoc| assoc key == selector])!

Item was added:
+ ----- Method: NanoTrait class>>install (in category 'installing') -----
+ install "NanoTrait install"
+ "Installs NanoTraits"
+
+ "Force recompilation of basic classes to get traits aliasing right"
+ {Behavior. ClassDescription. Class. Metaclass} do:[:aClass|
+ aClass selectorsDo:[:sel|
+ aClass
+ compile: (aClass sourceCodeAt: sel)
+ classified: (aClass organization categoryOfElement: sel)
+ withStamp: (aClass compiledMethodAt: sel) timeStamp
+ notifying: nil].
+ aClass setTraitCompositionFrom: {}].
+
+ ClassDescription traitImpl: self. "Create all new traits as NanoTraits"
+ self updateTraits: Smalltalk allTraits. "And convert everything to NanoTraits"
+ Smalltalk allClassesAndTraitsDo:[:aClass|
+ aClass traitComposition isEmpty
+ ifTrue:[aClass traitComposition: nil].
+ aClass classSide traitComposition isEmpty
+ ifTrue:[aClass classSide traitComposition: nil]].
+
+ "TWriteStreamTest has the class traits reversed which which will be undone
+ by installation. Put it back in reverse order to keep MC happy."
+ TWriteStreamTest classTrait
+ uses: TSequencedStreamTest classTrait + TPuttableStreamTest classTrait
+ !

Item was added:
+ ----- Method: NanoTraitTransformation>>isTraitTransformation (in category 'testing') -----
+ isTraitTransformation
+ "Polymorphic with Trait"
+ ^true!

Item was added:
+ ----- Method: NanoTrait>>classTrait (in category 'accessing') -----
+ classTrait
+ ^self class!

Item was added:
+ ----- Method: NanoTraitComposition>>traits (in category 'accessing') -----
+ traits
+ ^Array streamContents:[:s| self traitsDo:[:t| s nextPut: t]]!

Item was added:
+ ----- Method: NanoTraitAlias class>>assertValidAliasDefinition: (in category 'instance creation') -----
+ 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: [
+ NanoTraitCompositionException signal: 'Invalid alias definition: Alias and original selector have to have the same number of arguments.']!

Item was added:
+ ----- Method: NanoTraitAlias>>copyTraitExpression (in category 'operations') -----
+ copyTraitExpression
+ "Copy all except the actual traits"
+ ^NanoTraitAlias
+ with: subject
+ aliases: aliases!

Item was added:
+ ----- Method: NanoTrait>>environment (in category 'accessing') -----
+ environment
+ ^environment!

Item was added:
+ ----- Method: NanoTraitDescription class>>conflict:with:with: (in category 'conflict methods') -----
+ conflict: arg1 with: arg2 with: arg3
+ "This method has a trait conflict"
+ ^self traitConflict!

Item was added:
+ ----- Method: NanoTrait>>name (in category 'accessing') -----
+ name
+ ^name!

Item was added:
+ ----- Method: NanoTraitDescription>>+ (in category 'operations') -----
+ + aTrait
+ "Creates a composition with the receiver and aTrait"
+ aTrait traitsDo:[:t| self == t ifTrue:[NanoTraitCompositionException
+ signal: 'Trait ' , self asString, ' already in composition']].
+ ^NanoTraitComposition withAll: {self}, aTrait asTraitComposition!

Item was added:
+ ----- Method: ClassDescription>>traitCompositionString (in category '*Traits-NanoKernel') -----
+ traitCompositionString
+ "Answer the trait composition string for the receiver"
+ ^self traitComposition isEmpty
+ ifTrue:['{}']
+ ifFalse:[self traitComposition asString].!

Item was added:
+ ----- Method: ClassDescription>>uses: (in category '*Traits-NanoKernel') -----
+ uses: aTraitComposition
+ | newTraits |
+ newTraits := (aTraitComposition isKindOf: NanoTrait orOf: NanoTraitTransformation)
+ ifTrue:[NanoTraitComposition with: aTraitComposition]
+ ifFalse:[(aTraitComposition isKindOf: SequenceableCollection)
+ ifTrue:[NanoTraitComposition withAll: aTraitComposition asArray]
+ ifFalse:[self error: 'Invalid traits specification']].
+ self installTraitsFrom: newTraits.
+ !

Item was added:
+ ----- Method: NanoTraitComposition>>+ (in category 'converting') -----
+ + aTrait
+ self traitsDo:[:t| (t == aTrait trait) ifTrue:[^NanoTraitCompositionException
+ signal: 'Trait ' , aTrait trait asString, ' already in composition']].
+ self addLast: aTrait.
+ ^self!

Item was added:
+ ----- Method: NanoTrait>>category (in category 'accessing') -----
+ 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!

Item was added:
+ ----- Method: NanoTraitDescription>>removeTraitUser: (in category 'accessing') -----
+ removeTraitUser: aTrait
+ users := self users copyWithout: aTrait.
+ !

Item was added:
+ ----- Method: NanoTraitComposition>>allTraits (in category 'accessing') -----
+ allTraits
+ ^self gather:[:each| each allTraits copyWith: each trait]!

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

Item was added:
+ ----- Method: ClassDescription>>replaceSelector:withAlias:in: (in category '*Traits-NanoKernel') -----
+ replaceSelector: originalSelector withAlias: aliasSelector in: source
+ "replaces originalSelector with aliasSelector in in given source code"
+ | oldKeywords newKeywords args selectorWithArgs s |
+ oldKeywords := originalSelector keywords.
+ newKeywords := aliasSelector keywords.
+ oldKeywords size = newKeywords size ifFalse:[self error: 'Keyword mismatch'].
+ args := (self parserClass new parseArgsAndTemps: source asString notifying: nil)
+ copyFrom: 1 to: originalSelector numArgs.
+ selectorWithArgs := String streamContents: [:stream |
+ newKeywords keysAndValuesDo: [:index :keyword |
+ stream nextPutAll: keyword.
+ stream space.
+ args size >= index ifTrue: [
+ stream nextPutAll: (args at: index); space]]].
+ s := source asString readStream.
+ oldKeywords do: [ :each | s match: each ].
+ args isEmpty ifFalse: [ s match: args last ].
+ ^selectorWithArgs withBlanksTrimmed asText , s upToEnd
+ !

Item was added:
+ ----- Method: NanoTraitComposition>>removeUser: (in category 'accessing') -----
+ removeUser: aUser
+ ^self removeTraitUser: aUser!

Item was added:
+ ----- Method: NanoTraitComposition>>printOn: (in category 'converting') -----
+ printOn: aStream
+ "Answer the trait composition string (used for class definitions)"
+ aStream nextPutAll: self traitCompositionString.
+ !

Item was added:
+ ----- Method: NanoTraitTransformation>>+ (in category 'converting') -----
+ + aTrait
+ "Just like ordered collection"
+ ^NanoTraitComposition withAll: {self. aTrait}!

Item was added:
+ ----- Method: NanoTraitAlias>>initializeFrom: (in category 'initialize-release') -----
+ initializeFrom: anArrayOfAssociations
+ | newNames |
+ newNames := (anArrayOfAssociations collect: [:each | each key]) asIdentitySet.
+ newNames size < anArrayOfAssociations size ifTrue: [
+ NanoTraitCompositionException signal: 'Cannot use the same alias name twice'].
+ anArrayOfAssociations do: [:each |
+ (newNames includes: each value) ifTrue: [
+ NanoTraitCompositionException signal: 'Cannot define an alias for an alias']].
+ aliases := anArrayOfAssociations.
+ !

Item was added:
+ ----- Method: NanoTraitTransformation>>subject: (in category 'accessing') -----
+ subject: aSubject
+ subject := aSubject.!

Item was added:
+ ----- Method: NanoTrait class>>unloadNanoTraits (in category 'installing') -----
+ unloadNanoTraits
+ "Unload NanoTraits"
+ ClassDescription traitImpl == self
+ ifTrue:[ClassDescription traitImpl: nil].
+
+ CompiledMethod allInstancesDo:[:cm|
+ "Clean out NanoTraitState for all methods; this makes all methods local"
+ (cm properties isKindOf: NanoTraitMethodState) ifTrue:[
+ cm penultimateLiteral: (AdditionalMethodState newFrom: cm properties).
+ ].
+ ].
+
+ self allTraitsDo:[:trait|
+ "Clean out the existing users for this trait"
+ trait users do:[:user| user uses: {}].
+ ].
+
+ "We need a stub updateTraits method during unload"
+ [Behavior halt compileSilently: 'updateTraits' classified: nil.
+ "Finally, unload NanoTraits"
+ (MCPackage named: 'NanoTraits') unload.
+ ] ensure:[Behavior removeSelectorSilently: #updateTraits].
+
+ Smalltalk allClassesAndTraitsDo:[:aClass|
+ "Clean out existing NanoTraitCompositions"
+ (aClass traitComposition class isObsolete)
+ ifTrue:[aClass traitComposition: #()].
+ (aClass classSide traitComposition class isObsolete)
+ ifTrue:[aClass classSide traitComposition: #()].
+ ].
+
+ Smalltalk at: #Trait ifPresent:[:aClass|
+ aClass isObsolete ifTrue:[Smalltalk at: #Trait put: nil].
+ ].
+
+ Compiler recompileAll.!

Item was added:
+ ----- Method: NanoTrait>>bindingOf: (in category 'compiling') -----
+ bindingOf: varName
+ "Answer the binding of some variable resolved in the scope of the receiver"
+ ^self environment bindingOf: varName asSymbol.!

Item was added:
+ ----- Method: NanoTraitExclusion>>printOn: (in category 'composition') -----
+ printOn: aStream
+ "Answer the trait composition string (used for class definitions)"
+ aStream nextPutAll: subject asString.
+ aStream nextPutAll: ' - {'.
+ exclusions asArray sort do:[:exc| aStream store: exc] separatedBy:[aStream nextPutAll: '. '].
+ aStream nextPutAll: '}'.!

Item was added:
+ ----- Method: ClassDescription>>basicRemoveSelector: (in category '*Traits-NanoKernel') -----
+ basicRemoveSelector: aSelector
+ "Remove the message whose selector is given from the method
+ dictionary of the receiver, if it is there. Update the trait composition."
+ | oldMethod |
+ oldMethod := super basicRemoveSelector: aSelector.
+ oldMethod ifNotNil:[self updateTraits].
+ ^oldMethod!

Item was added:
+ ----- Method: ClassDescription>>traits (in category '*Traits-NanoKernel') -----
+ traits
+ "Answer an array of my traits"
+ ^self traitComposition asArray collect:[:composed| composed trait]!

Item was added:
+ ----- Method: NanoClassTrait>>asMCDefinition (in category 'monticello') -----
+ asMCDefinition
+ ^Smalltalk at: #MCClassTraitDefinition ifPresent:[:aClass|
+ aClass
+ baseTraitName: self baseTrait name
+ classTraitComposition: self traitCompositionString
+ ].!

Item was added:
+ ----- Method: NanoTraitDescription>>copyTraitExpression (in category 'copying') -----
+ copyTraitExpression
+ "Copy all except the actual traits"
+ ^self!

Item was added:
+ ----- Method: NanoTraitDescription>>users (in category 'accessing') -----
+ users
+ ^users ifNil:[#()]!

Item was added:
+ ----- Method: NanoTraitComposition>>removeFromComposition: (in category 'compat') -----
+ removeFromComposition: aTrait
+ "--- ignore ---"!

Item was added:
+ ----- Method: NanoTraitComposition>>selectorsAndMethodsDo: (in category 'operations') -----
+ selectorsAndMethodsDo: aBlock
+ "enumerates all selectors and methods in a trait composition"
+ self do:[:each| each selectorsAndMethodsDo: aBlock].!

Item was added:
+ ----- Method: NanoTraitComposition>>copyTraitExpression (in category 'operations') -----
+ copyTraitExpression
+ "Copy all except the actual traits"
+ ^self collect:[:each| each copyTraitExpression].!

Item was added:
+ ----- Method: NanoTraitExclusion class>>with:exclusions: (in category 'instance creation') -----
+ with: aTraitComposition exclusions: anArrayOfSelectors
+ ^self new
+ subject: aTraitComposition;
+ exclusions: anArrayOfSelectors;
+ yourself
+ !

Item was added:
+ ----- Method: NanoTraitExclusion>>selectorsAndMethodsDo: (in category 'composition') -----
+ selectorsAndMethodsDo: aBlock
+ "enumerates all selectors and methods in a trait composition"
+ ^subject selectorsAndMethodsDo:[:sel :meth|
+ (exclusions includes: sel) ifFalse:[aBlock value: sel value: meth].
+ ].!

Item was added:
+ ----- Method: NanoTraitExclusion>>copyTraitExpression (in category 'composition') -----
+ copyTraitExpression
+ "Copy all except the actual traits"
+ ^NanoTraitExclusion
+ with: subject
+ exclusions: exclusions asArray!

Item was added:
+ NanoTraitTransformation subclass: #NanoTraitExclusion
+ instanceVariableNames: 'exclusions'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Traits-NanoKernel'!
+
+ !NanoTraitExclusion commentStamp: '<historical>' prior: 0!
+ A trait transformation representing the exclusion (-) operator.!

Item was added:
+ ----- Method: NanoTrait>>fileOutOn:moveSource:toFile: (in category 'fileIn/Out') -----
+ fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex
+ super fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex.
+ self classSide hasMethods ifTrue:[
+ aFileStream cr; nextPutAll: '"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!'; cr; cr.
+ self classSide
+ fileOutOn: aFileStream
+ moveSource: moveSource
+ toFile: fileIndex].!

Item was changed:
  SystemOrganization addCategory: #'Traits-Composition'!
  SystemOrganization addCategory: #'Traits-Kernel'!
  SystemOrganization addCategory: #'Traits-Kernel-Traits'!
  SystemOrganization addCategory: #'Traits-LocalSends'!
  SystemOrganization addCategory: #'Traits-Requires'!
  SystemOrganization addCategory: #'Traits-Tests'!
+ SystemOrganization addCategory: #'Traits-NanoKernel'!

Item was added:
+ ----- Method: NanoTrait>>classDefinitions (in category 'monticello') -----
+ classDefinitions
+ | definitions |
+ definitions := OrderedCollection with: self asClassDefinition.
+ (self hasClassTrait
+ and: [self classTrait hasTraitComposition]
+ and: [self classTrait traitComposition isEmpty not])
+ ifTrue: [definitions add: self classTrait asMCDefinition].
+ ^definitions asArray!

Item was added:
+ ----- Method: NanoClassTrait>>isClassTrait (in category 'testing') -----
+ isClassTrait
+ ^true!

Item was added:
+ ----- Method: ClassDescription>>allTraits (in category '*Traits-NanoKernel') -----
+ allTraits
+ "Answer all the traits that are used by myself without their transformations"
+ ^self traitComposition isEmpty
+ ifTrue:[#()]
+ ifFalse:[self traitComposition allTraits].!

Item was added:
+ ----- Method: NanoTraitTransformation>>selectorsAndMethodsDo: (in category 'operations') -----
+ selectorsAndMethodsDo: aBlock
+ "enumerates all selectors and methods in a trait composition"
+ ^self subclassResponsibility!

Item was added:
+ ----- Method: NanoClassTrait>>theMetaClass (in category 'accessing') -----
+ theMetaClass
+ ^self!

Item was added:
+ ----- Method: NanoTraitTransformation>>copyTraitExpression (in category 'operations') -----
+ copyTraitExpression
+ "Copy all except the actual traits"
+ ^self subclassResponsibility!

Item was added:
+ ----- Method: NanoTrait>>asClassDefinition (in category 'monticello') -----
+ asClassDefinition
+ ^Smalltalk at: #MCTraitDefinition ifPresent:[:aClass|
+ aClass
+ name: self name
+ traitComposition: self traitCompositionString
+ category: self category
+ comment: self organization classComment asString
+ commentStamp: self organization commentStamp].!

Item was added:
+ ----- Method: NanoTraitDescription>>sharedPools (in category 'accessing') -----
+ sharedPools
+ "Traits have no shared pools"
+ ^ Dictionary new!

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

Item was added:
+ ----- Method: NanoTraitAlias>>initialize (in category 'initialize-release') -----
+ initialize
+ super initialize.
+ aliases := #().!

Item was added:
+ ----- Method: NanoTrait class>>newTemplateIn: (in category 'public') -----
+ newTemplateIn: categoryString
+ ^String streamContents: [:stream |
+ stream
+ nextPutAll: 'Trait named: #NameOfTrait';
+ cr; tab;
+ nextPutAll: 'uses: {}';
+ cr; tab;
+ nextPutAll: 'category: ';
+ nextPut: $';
+ nextPutAll: categoryString;
+ nextPut: $' ]!

Item was added:
+ ----- Method: NanoTrait class>>newTraitNamed:uses:category: (in category 'public') -----
+ newTraitNamed: aSymbol uses: aTraitCompositionOrCollection category: aString
+ "Creates a new trait."
+ | env |
+ env := self environment.
+ ^self
+ named: aSymbol
+ uses: aTraitCompositionOrCollection
+ category: aString
+ env: env!

Item was added:
+ ----- Method: NanoTraitExclusion>>exclusions: (in category 'accessing') -----
+ exclusions: aCollection
+ exclusions := Set withAll: aCollection!

Item was added:
+ ----- Method: AdditionalMethodState>>originalTraitMethod (in category '*Traits-NanoKernel') -----
+ originalTraitMethod
+ "The original method from the trait.
+ Only available in TraitMethodState."
+ ^nil!

Item was added:
+ ----- Method: NanoTraitDescription>>isTraitTransformation (in category 'testing') -----
+ isTraitTransformation
+ "Polymorphic with TraitTransformation"
+ ^false!

Item was added:
+ ----- Method: NanoTraitExclusion>>- (in category 'converting') -----
+ - anArrayOfSelectors
+ ^NanoTraitExclusion
+ with: subject
+ exclusions: (anArrayOfSelectors, exclusions asArray)!

Item was added:
+ ----- Method: ClassDescription>>resolveTraitsConflict:from:to: (in category '*Traits-NanoKernel') -----
+ resolveTraitsConflict: aSelector from: oldMethod to: newMethod
+ "Resolve a traits conflict. Rules:
+ - If one method is required the other one wins
+ - Otherwise we compile a traits conflict
+ "
+ | marker selector |
+ oldMethod methodHome == newMethod methodHome ifTrue:[^oldMethod].
+ marker := oldMethod markerOrNil.
+ (#(requirement explicitRequirement subclassResponsibility shouldNotImplement) includes: marker)
+ ifTrue:[^newMethod].
+ marker := newMethod markerOrNil.
+ (#(requirement explicitRequirement subclassResponsibility shouldNotImplement) includes: marker)
+ ifTrue:[^oldMethod].
+ "Create a conflict marker"
+ selector := #(conflict conflict: conflict:with: conflict:with:with: conflict:with:with:with:
+ conflict:with:with:with:with: conflict:with:with:with:with:with: conflict:with:with:with:with:with:with:
+ conflict:with:with:with:with:with:with:with:) at: oldMethod numArgs+1.
+ ^NanoTraitDescription class compiledMethodAt: selector.!

Item was added:
+ ----- Method: NanoTraitComposition>>isTraitTransformation (in category 'testing') -----
+ isTraitTransformation
+ "Polymorphic with TraitTransformation"
+ ^false!

Item was added:
+ ----- Method: NanoTrait>>rename: (in category 'initialize') -----
+ 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!

Item was added:
+ ----- Method: AdditionalMethodState>>originalTraitOrClass (in category '*Traits-NanoKernel') -----
+ originalTraitOrClass
+ "The original trait for this method"
+ ^method methodClass!

Item was added:
+ ----- Method: ClassDescription>>users (in category '*Traits-NanoKernel') -----
+ users
+ ^#()!

Item was added:
+ ----- Method: CompiledMethod>>originalTraitMethod: (in category '*Traits-NanoKernel') -----
+ originalTraitMethod: aCompiledMethod
+ "Remember the original trait method for the receiver."
+ | methodState |
+ methodState := NanoTraitMethodState newFrom: self properties.
+ methodState originalTraitMethod: aCompiledMethod.
+ self penultimateLiteral:  methodState.!

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

Item was added:
+ ----- Method: NanoTrait>>isBaseTrait (in category 'testing') -----
+ isBaseTrait
+ ^true!

Item was added:
+ ----- Method: CompiledMethod>>sameTraitCodeAs: (in category '*Traits-NanoKernel') -----
+ sameTraitCodeAs: method
+ "Answer whether the receiver implements the same code as the
+ argument, method. Does not look at properties/pragmas since they
+ do not affect the resulting code."
+ | numLits |
+ (method isKindOf: CompiledMethod) ifFalse: [^false].
+ self methodHome == method methodHome ifFalse:[^false].
+ (self properties analogousCodeTo: method properties) ifFalse:[^false].
+ self size = method size ifFalse: [^false].
+ self header = method header ifFalse: [^false].
+ self initialPC to: self endPC do:[:i | (self at: i) = (method at: i) ifFalse: [^false]].
+ (numLits := self numLiterals) ~= method numLiterals ifTrue: [^false].
+ 1 to: numLits-2 do:[:i| | lit1 lit2 |
+ lit1 := self literalAt: i.
+ lit2 := method literalAt: i.
+ lit1 = lit2 ifFalse:[
+ (i = 1 and: [#(117 120) includes: self primitive]) ifTrue: [
+ lit1 isArray ifTrue:[
+ (lit2 isArray and: [lit1 allButLast = lit2 allButLast]) ifFalse:[^false]
+ ] ifFalse: "ExternalLibraryFunction"
+ [(lit1 analogousCodeTo: lit2) ifFalse:[^false]].
+ ] ifFalse:[
+ lit1 isFloat
+ ifTrue:[(lit1 closeTo: lit2) ifFalse: [^false]]
+ ifFalse:["any other discrepancy is a failure"^ false]]]].
+ ^true!

Item was added:
+ ----- Method: NanoTraitDescription>>addSelectorSilently:withMethod: (in category 'operations') -----
+ addSelectorSilently: selector withMethod: compiledMethod
+ "Overridden to update the users of this trait"
+ super addSelectorSilently: selector withMethod: compiledMethod.
+ self users do:[:each| each updateTraits].!

Item was added:
+ ----- Method: NanoTraitDescription class>>conflict:with: (in category 'conflict methods') -----
+ conflict: arg1 with: arg2
+ "This method has a trait conflict"
+ ^self traitConflict!

Item was added:
+ ----- Method: NanoTrait class>>newTraitComposition (in category 'public') -----
+ newTraitComposition
+ "Creates a new TraitComposition"
+ ^NanoTraitComposition new!

Item was added:
+ ----- Method: NanoTrait class>>named:uses:category:env: (in category 'instance creation') -----
+ named: aSymbol uses: aTraitComposition category: aString env: anEnvironment
+ | trait oldTrait systemCategory oldCategory |
+ systemCategory := aString asSymbol.
+ oldTrait := anEnvironment at: aSymbol ifAbsent: [nil].
+ oldTrait ifNil:[
+ trait := NanoClassTrait new new.
+ ] ifNotNil:[
+ oldCategory := oldTrait category.
+ trait := oldTrait.
+ ].
+ (trait isKindOf: NanoTrait) 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!

Item was added:
+ ----- Method: NanoTraitTransformation>>traitsDo: (in category 'accessing') -----
+ traitsDo: aBlock
+ ^subject traitsDo: aBlock!

Item was added:
+ ----- Method: NanoTraitAlias>>selectorsAndMethodsDo: (in category 'operations') -----
+ selectorsAndMethodsDo: aBlock
+ "enumerates all selectors and methods in a trait composition"
+ subject selectorsAndMethodsDo:[:sel :meth|
+ aBlock value: sel value: meth.
+ ].
+ aliases do:[:assoc| | method |
+ "Method can be nil during removals"
+ method := subject compiledMethodAt: assoc value ifAbsent:[nil].
+ method ifNotNil:[aBlock value: assoc key value: method].
+ ].!

Item was added:
+ ----- Method: NanoClassTrait>>bindingOf: (in category 'compiling') -----
+ bindingOf: varName
+ "Answer the binding of some variable resolved in the scope of the receiver"
+ ^baseTrait bindingOf: varName!

Item was added:
+ ----- Method: NanoTraitDescription>>copy (in category 'copying') -----
+ copy
+ self error: 'Traits cannot be trivially copied'!

Item was added:
+ ----- Method: NanoTraitTransformation>>includesTrait: (in category 'testing') -----
+ includesTrait: aTrait
+ ^subject includesTrait: aTrait!

Item was added:
+ ----- Method: NanoTraitTransformation>>asTraitTransform (in category 'converting') -----
+ asTraitTransform
+ ^self!

Item was added:
+ ----- Method: NanoTrait>>removeFromSystem: (in category 'initialize') -----
+ removeFromSystem: logged
+ self environment forgetClass: self logged: logged.
+ self obsolete!

Item was added:
+ ----- Method: NanoClassTrait>>uses: (in category 'initialize') -----
+ uses: aTraitComposition
+ | newTraits |
+ newTraits := (aTraitComposition isTrait or:[aTraitComposition isTraitTransformation])
+ ifTrue:[NanoTraitComposition with: aTraitComposition]
+ ifFalse:[(aTraitComposition isKindOf: SequenceableCollection)
+ ifTrue:[NanoTraitComposition 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 includesTrait: t baseTrait) not])
+ ifTrue:[self error: 'Cannot add: ', t].
+ ].
+ self installTraitsFrom: newTraits.!

Item was added:
+ ----- Method: NanoTrait>>definition (in category 'initialize') -----
+ definition
+ ^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 added:
+ ----- Method: NanoTraitTransformation>>trait (in category 'accessing') -----
+ trait
+ ^subject trait!

Item was added:
+ ----- Method: NanoTraitTransformation>>updateSelector:withTraitMethod:from: (in category 'operations') -----
+ updateSelector: aSelector withTraitMethod: compiledMethod from: aTrait
+ "broadcasts the change of a selector to all users of a trait"
+ ^self subclassResponsibility!

Item was added:
+ ----- Method: NanoTraitDescription>>addUser: (in category 'accessing') -----
+ addUser: aTrait
+ ^self addTraitUser: aTrait!

Item was added:
+ NanoTraitDescription subclass: #NanoClassTrait
+ instanceVariableNames: 'baseTrait'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Traits-NanoKernel'!
+
+ !NanoClassTrait commentStamp: '<historical>' prior: 0!
+ While every class has an associated metaclass, a trait can have an associated classtrait, an instance of me. To preserve metaclass compatibility, the associated classtrait (if there is one) is automatically applied to the metaclass, whenever a trait is applied to a class. Consequently, a trait with an associated classtrait can only be applied to classes, whereas a trait without a classtrait can be applied to both classes and metaclasses.!

Item was added:
+ NanoTraitDescription subclass: #NanoTrait
+ instanceVariableNames: 'name environment category'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Traits-NanoKernel'!
+
+ !NanoTrait commentStamp: '<historical>' prior: 0!
+ Each trait in the system is represented as an instance of me. Like Class, I concretize my superclass by providing instance variables for the name and the environment.!

Item was added:
+ ----- Method: NanoClassTrait>>isMeta (in category 'testing') -----
+ isMeta
+ ^true!

Item was added:
+ ----- Method: NanoTraitComposition>>addUser: (in category 'accessing') -----
+ addUser: aUser
+ ^self addTraitUser: aUser!

Item was added:
+ ----- Method: NanoTraitDescription>>isBaseTrait (in category 'testing') -----
+ isBaseTrait
+ ^false!

Item was added:
+ ----- Method: NanoTraitExclusion>>initialize (in category 'initialize') -----
+ initialize
+ super initialize.
+ exclusions := Set new.
+ !

Item was added:
+ ----- Method: ClassDescription>>setTraitCompositionFrom: (in category '*Traits-NanoKernel') -----
+ setTraitCompositionFrom: aTraitComposition
+ "OBSOLETE. Use Class uses: aTraitComposition instead."
+ (aTraitComposition isKindOf: NanoTraitComposition)
+ ifTrue:[^self uses: aTraitComposition].
+ (aTraitComposition isKindOf: TraitComposition)
+ ifTrue:[^super setTraitCompositionFrom: aTraitComposition].
+ "Unspecified. Check for prevailing traitOverride"
+ ClassDescription traitImpl == NanoTrait
+ ifTrue:[^self uses: aTraitComposition]
+ ifFalse:[^super setTraitCompositionFrom: aTraitComposition].!

Item was added:
+ ----- Method: NanoTraitDescription>>removeUser: (in category 'accessing') -----
+ removeUser: aTrait
+ ^self removeTraitUser: aTrait!

Item was added:
+ ----- Method: NanoTraitAlias>>- (in category 'converting') -----
+ - anArrayOfSelectors
+ ^NanoTraitExclusion
+ with: self
+ exclusions: anArrayOfSelectors!

Item was added:
+ ----- Method: NanoTraitDescription>>asTraitComposition (in category 'converting') -----
+ asTraitComposition
+ ^NanoTraitComposition with: self!

Item was added:
+ ----- Method: NanoTraitAlias class>>with:aliases: (in category 'instance creation') -----
+ with: aTraitComposition aliases: anArrayOfAssociations
+ self assertValidAliasDefinition: anArrayOfAssociations.
+ ^self new
+ subject: aTraitComposition;
+ initializeFrom: anArrayOfAssociations;
+ yourself!

Item was added:
+ ----- Method: NanoTrait>>isValidTraitName: (in category 'initialize') -----
+ isValidTraitName: aSymbol
+ ^(aSymbol isEmptyOrNil
+ or: [aSymbol first isLetter not]
+ or: [aSymbol anySatisfy: [:character | character isAlphaNumeric not]]) not!

Item was added:
+ ----- Method: NanoTraitDescription>>isTrait (in category 'testing') -----
+ isTrait
+ ^true!

Item was added:
+ ----- Method: NanoTrait>>removeFromSystem (in category 'initialize') -----
+ removeFromSystem
+ self removeFromSystem: true!

Item was added:
+ ----- Method: NanoTraitComposition>>asTraitComposition (in category 'converting') -----
+ asTraitComposition
+ ^self!

Item was added:
+ ----- Method: NanoTraitDescription>>printUsersOf:on:level: (in category 'printing') -----
+ printUsersOf: aClass on: aStream level: indent
+ aStream crtab: indent.
+ aStream nextPutAll: aClass name.
+ aClass isTrait ifTrue:[
+ aClass users do:[:each| self printUsersOf: aClass on: aStream level: indent+1].
+ ].
+ !

Item was added:
+ ----- Method: NanoTraitDescription>>traitComposition (in category 'accessing') -----
+ traitComposition
+ ^traitComposition ifNil:[traitComposition := NanoTraitComposition new]
+ !

Item was added:
+ ----- Method: NanoTrait class>>allTraitsDo: (in category 'public') -----
+ allTraitsDo: aBlock
+ "Evaluate aBlock with all the instance and class traits present in the system"
+ NanoClassTrait allInstances do: [:metaTrait|
+ aBlock value: metaTrait instanceSide.
+ aBlock value: metaTrait.
+ ].!

Item was added:
+ ----- Method: NanoTrait>>hasClassTrait (in category 'testing') -----
+ hasClassTrait
+ ^true!

Item was added:
+ ----- Method: NanoTraitTransformation>>initialize (in category 'initialize') -----
+ initialize
+ super initialize.
+ users := #().!

Item was added:
+ ----- Method: NanoTraitMethodState>>originalTraitMethod (in category 'accessing') -----
+ originalTraitMethod
+ "The original method from the trait"
+ ^originalTraitMethod!

Item was added:
+ ----- Method: NanoTraitDescription class>>conflict:with:with:with:with:with:with:with: (in category 'conflict methods') -----
+ conflict: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8
+ "This method has a trait conflict"
+ ^self traitConflict!

Item was added:
+ ----- Method: ClassDescription>>includesTrait: (in category '*Traits-NanoKernel') -----
+ includesTrait: aTrait
+ ^self traitComposition includesTrait: aTrait!

Item was added:
+ ----- Method: NanoTrait>>setName:andRegisterInCategory:environment: (in category 'initialize') -----
+ 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!

Item was added:
+ ----- Method: NanoTraitMethodState>>originalTraitOrClass (in category 'accessing') -----
+ originalTraitOrClass
+ "The original trait for this method"
+ ^originalTraitMethod originalTraitOrClass!

Item was added:
+ ----- Method: NanoTraitDescription>>users: (in category 'accessing') -----
+ users: aCollection
+ users := aCollection!

Item was added:
+ ----- Method: NanoTraitTransformation>>asTraitComposition (in category 'converting') -----
+ asTraitComposition
+ ^NanoTraitComposition with: self!

Item was added:
+ ----- Method: CompiledMethod>>originalTraitMethod (in category '*Traits-NanoKernel') -----
+ originalTraitMethod
+ "Remember the original trait method for the receiver."
+ ^self properties originalTraitMethod!

Item was added:
+ ClassDescription subclass: #NanoTraitBehavior
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Traits-NanoKernel'!
+
+ !NanoTraitBehavior commentStamp: 'ar 12/29/2009 15:57' prior: 0!
+ Stub class for backward compatibility. Allows past extension methods in TraitBehavior to continue to work.!

Item was added:
+ ----- Method: NanoTrait>>category: (in category 'accessing') -----
+ 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!

Item was added:
+ ----- Method: CompiledMethod>>originalTraitOrClass (in category '*Traits-NanoKernel') -----
+ originalTraitOrClass
+ "The original trait for this method"
+ ^self properties originalTraitOrClass!

Item was added:
+ ----- Method: NanoTrait>>name: (in category 'accessing') -----
+ name: aSymbol
+ name := aSymbol!

Item was added:
+ AdditionalMethodState variableSubclass: #NanoTraitMethodState
+ instanceVariableNames: 'originalTraitMethod'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Traits-NanoKernel'!
+
+ !NanoTraitMethodState commentStamp: '<historical>' prior: 0!
+ Additional method state for trait provided methods.!

Item was added:
+ ----- Method: NanoClassTrait class>>new (in category 'instance creation') -----
+ new
+ | newMeta |
+ newMeta := super new.
+ newMeta
+ superclass: NanoTrait
+ methodDictionary: MethodDictionary new
+ format: NanoTrait format.
+ ^newMeta!

Item was added:
+ ----- Method: NanoTraitMethodState>>methodHome (in category 'accessing') -----
+ methodHome
+ "The behavior (trait/class) this method was originally defined in.
+ Derived from the originalTraitMethod if any."
+ ^originalTraitMethod ifNil:[super methodHome] ifNotNil:[:m| m methodHome]!

Item was added:
+ ----- Method: NanoTraitDescription>>notifyOfRecategorizedSelector:from:to: (in category 'operations') -----
+ notifyOfRecategorizedSelector: element from: oldCategory to: newCategory
+ super notifyOfRecategorizedSelector: element from: oldCategory to: newCategory.
+ self users do:[:each| each classify: element under: newCategory from: oldCategory trait: self].!

Item was added:
+ ----- Method: NanoClassTrait>>instanceSide (in category 'accessing') -----
+ instanceSide
+ ^self baseTrait!

Item was added:
+ ----- Method: NanoTraitDescription>>- (in category 'operations') -----
+ - anArrayOfSelectors
+ "Creates an exclusion"
+ ^NanoTraitExclusion
+ with: self
+ exclusions: anArrayOfSelectors!

Item was added:
+ ----- Method: NanoTraitAlias>>isAliasSelector: (in category 'testing') -----
+ isAliasSelector: selector
+ ^(self isLocalAliasSelector: selector) or:[super isAliasSelector: selector]!

Item was added:
+ ----- Method: NanoTraitComposition>>- (in category 'converting') -----
+ - 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)!

Item was added:
+ ----- Method: NanoTrait class>>initialize (in category 'initialize') -----
+ initialize
+ "Install NanoTraits"
+ self install.
+ !

Item was added:
+ ----- Method: ClassDescription>>traitComposition (in category '*Traits-NanoKernel') -----
+ traitComposition
+ "Answer my trait composition"
+ ^#()!

Item was added:
+ ----- Method: NanoClassTrait>>new (in category 'accessing') -----
+ new
+ baseTrait ifNotNil:[self error: 'Already initialized'].
+ baseTrait := self basicNew initialize.
+ baseTrait
+ superclass: nil
+ methodDictionary: MethodDictionary new
+ format: Object format.
+ ^baseTrait!

Item was added:
+ ----- Method: NanoTraitDescription class>>conflict:with:with:with:with:with:with: (in category 'conflict methods') -----
+ conflict: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7
+ "This method has a trait conflict"
+ ^self traitConflict!

Item was added:
+ ----- Method: NanoTraitAlias>>@ (in category 'converting') -----
+ @ anArrayOfAssociations
+ ^NanoTraitAlias
+ with: subject
+ aliases: (anArrayOfAssociations, self aliases)!

Item was added:
+ ----- Method: NanoClassTrait>>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 added:
+ ----- Method: NanoClassTrait>>name (in category 'accessing') -----
+ name
+ ^baseTrait name, ' classTrait'!

Item was added:
+ OrderedCollection subclass: #NanoTraitComposition
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Traits-NanoKernel'!
+
+ !NanoTraitComposition commentStamp: '<historical>' prior: 0!
+ A trait composition is a collection of Traits or TraitTransformations.!

Item was added:
+ ----- Method: NanoTraitDescription>>traitsDo: (in category 'operations') -----
+ traitsDo: aBlock
+ aBlock value: self.!

Item was added:
+ ----- Method: NanoTraitExclusion>>exclusions (in category 'accessing') -----
+ exclusions
+ ^exclusions!

Item was added:
+ ----- Method: NanoTraitMethodState>>originalTraitMethod: (in category 'accessing') -----
+ originalTraitMethod: aCompiledMethod
+ "The original method from the trait"
+ originalTraitMethod := aCompiledMethod!

Item was added:
+ ----- Method: NanoTraitComposition>>traitsDo: (in category 'accessing') -----
+ traitsDo: aBlock
+ ^self do:[:each| each traitsDo: aBlock]!

Item was added:
+ ----- Method: NanoTraitDescription class>>conflict (in category 'conflict methods') -----
+ conflict
+ "This method has a trait conflict"
+ ^self traitConflict!

Item was added:
+ ----- Method: NanoTraitDescription>>allClassVarNames (in category 'accessing') -----
+ allClassVarNames
+ "Traits have no class var names"
+ ^#()!

Item was added:
+ ----- Method: NanoTraitDescription class>>conflict:with:with:with:with: (in category 'conflict methods') -----
+ conflict: arg1 with: arg2 with: arg3 with: arg4 with: arg5
+ "This method has a trait conflict"
+ ^self traitConflict!

Item was added:
+ ----- Method: NanoTraitTransformation>>- (in category 'converting') -----
+ - anArrayOfSelectors
+ ^self subclassResponsibility!

Item was added:
+ ----- Method: NanoTrait>>environment: (in category 'accessing') -----
+ environment: anObject
+ environment := anObject!

Item was added:
+ ----- Method: NanoTraitDescription>>includesTrait: (in category 'testing') -----
+ includesTrait: aTrait
+ ^self == aTrait or:[super includesTrait: aTrait]!

Item was added:
+ ----- Method: NanoTraitDescription>>trait (in category 'accessing') -----
+ trait
+ ^self!

Item was added:
+ ----- Method: NanoTraitDescription class>>conflict:with:with:with: (in category 'conflict methods') -----
+ conflict: arg1 with: arg2 with: arg3 with: arg4
+ "This method has a trait conflict"
+ ^self traitConflict!

Item was added:
+ ----- Method: NanoTrait>>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 added:
+ ----- Method: NanoTraitDescription>>addTraitUser: (in category 'accessing') -----
+ addTraitUser: aTrait
+ users := self users copyWith: aTrait.
+ !

Item was added:
+ ----- Method: NanoTraitAlias>>aliases (in category 'accessing') -----
+ aliases
+ "Collection of associations where key is the
+ alias and value the original selector."
+ ^aliases!

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