[squeak-dev] The Trunk: Traits-ar.263.mczcommits at source.squeak.org commits at source.squeak.orgThu Dec 31 13:24:38 UTC 2009
Andreas Raab uploaded a new version of Traits to project The Trunk: http://source.squeak.org/trunk/Traits-ar.263.mcz ==================== Summary ==================== Name: Traits-ar.263 Author: ar Time: 30 December 2009, 2:55:32 am UUID: 82cf76b0-2144-a34d-9067-f131dce10b15 Ancestors: Traits-ar.262 Prepare to push traitComposition into TraitOrganizer so that we don't need to duplicate it in three places (Class, Metaclass, TraitDescription). =============== Diff against Traits-ar.261 =============== Item was added: + ----- Method: ClassOrganizer>>traitComposition (in category '*Traits-Kernel') ----- + traitComposition + "Answer the receiver's trait composition" + ^#()! Item was changed: SystemOrganization addCategory: #'Traits-Composition'! SystemOrganization addCategory: #'Traits-Kernel'! SystemOrganization addCategory: #'Traits-Kernel-Traits'! - SystemOrganization addCategory: #'Traits-NanoKernel'! Item was added: + ----- Method: TraitOrganizer>>traitComposition (in category 'accessing') ----- + traitComposition + "Answer the receiver's trait composition" + ^traitComposition ifNil:[traitComposition := TraitComposition new]! Item was added: + ----- Method: TraitOrganizer>>traitComposition: (in category 'accessing') ----- + traitComposition: aTraitComposition + "Install the receiver's trait composition" + traitComposition := aTraitComposition.! Item was added: + ----- Method: ClassTrait>>isObsolete (in category 'testing') ----- + isObsolete + ^baseTrait == nil or:[baseTrait isObsolete]! Item was changed: ----- Method: ClassDescription>>traitComposition (in category '*Traits-NanoKernel') ----- traitComposition "Answer my trait composition" + ^self organization traitComposition! - ^#()! Item was changed: ----- Method: ClassDescription>>traitComposition: (in category '*Traits-NanoKernel') ----- traitComposition: aTraitComposition + "Install my trait composition" + aTraitComposition isEmpty ifTrue:[ + self organization isTraitOrganizer + ifTrue:[self organization: (ClassOrganizer newFrom: self organization)]. + ] ifFalse:[ + self organization isTraitOrganizer + ifFalse:[self organization: (TraitOrganizer newFrom: self organization)]. + self organization traitComposition: aTraitComposition. + ]. + ! - "Install my traits" - ^self subclassResponsibility! Item was added: + ----- Method: ClassOrganizer>>isTraitOrganizer (in category '*Traits-Kernel') ----- + isTraitOrganizer + "Answer true if this is a TraitOrganizer" + ^false! Item was changed: ----- Method: TraitDescription>>traitComposition: (in category 'accessing') ----- traitComposition: aTraitComposition + super traitComposition: aTraitComposition. traitComposition := aTraitComposition. ! Item was added: + ----- Method: TraitOrganizer>>isTraitOrganizer (in category 'testing') ----- + isTraitOrganizer + "Answer true if this is a TraitOrganizer" + ^true! Item was added: + ClassOrganizer subclass: #TraitOrganizer + instanceVariableNames: 'traitComposition' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-Kernel'! Item was removed: - ----- Method: NanoTraitComposition>>addTraitUser: (in category 'accessing') ----- - addTraitUser: aUser - self do:[:each| each addTraitUser: aUser]! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitExclusion>>copyTraitExpression (in category 'composition') ----- - copyTraitExpression - "Copy all except the actual traits" - ^NanoTraitExclusion - with: subject - exclusions: exclusions asArray! Item was removed: - NanoTraitTransformation subclass: #NanoTraitExclusion - instanceVariableNames: 'exclusions' - classVariableNames: '' - poolDictionaries: '' - category: 'Traits-NanoKernel'! - - !NanoTraitExclusion commentStamp: '<historical>' prior: 0! - A trait transformation representing the exclusion (-) operator.! Item was removed: - ----- 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 removed: - ----- Method: NanoTrait>>baseTrait (in category 'accessing') ----- - baseTrait - ^self! Item was removed: - ----- 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 removed: - ----- Method: NanoClassTrait>>isClassTrait (in category 'testing') ----- - isClassTrait - ^true! Item was removed: - ----- Method: NanoTraitDescription>>traitComposition: (in category 'accessing') ----- - traitComposition: aTraitComposition - traitComposition := aTraitComposition. - ! Item was removed: - ----- Method: NanoTraitTransformation>>selectorsAndMethodsDo: (in category 'operations') ----- - selectorsAndMethodsDo: aBlock - "enumerates all selectors and methods in a trait composition" - ^self subclassResponsibility! Item was removed: - ----- Method: NanoClassTrait>>theMetaClass (in category 'accessing') ----- - theMetaClass - ^self! Item was removed: - ----- Method: NanoTraitTransformation>>copyTraitExpression (in category 'operations') ----- - copyTraitExpression - "Copy all except the actual traits" - ^self subclassResponsibility! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitDescription>>sharedPools (in category 'accessing') ----- - sharedPools - "Traits have no shared pools" - ^ Dictionary new! Item was removed: - ----- Method: NanoTraitDescription>>isClassTrait (in category 'testing') ----- - isClassTrait - ^false! Item was removed: - ----- Method: NanoClassTrait>>soleInstance (in category 'accessing') ----- - soleInstance - ^baseTrait! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitAlias>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - aliases := #().! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: NanoTraitTransformation>>addTraitUser: (in category 'accessing') ----- - addTraitUser: aTrait - users := users copyWith: aTrait. - subject addTraitUser: aTrait. - ! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: NanoTraitDescription>>@ (in category 'operations') ----- - @ anArrayOfAssociations - "Creates an alias" - ^ NanoTraitAlias with: self aliases: anArrayOfAssociations! Item was removed: - ----- Method: NanoTraitExclusion>>exclusions: (in category 'accessing') ----- - exclusions: aCollection - exclusions := Set withAll: aCollection! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: NanoTraitDescription>>isTraitTransformation (in category 'testing') ----- - isTraitTransformation - "Polymorphic with TraitTransformation" - ^false! Item was removed: - ----- Method: NanoTraitExclusion>>- (in category 'converting') ----- - - anArrayOfSelectors - ^NanoTraitExclusion - with: subject - exclusions: (anArrayOfSelectors, exclusions asArray)! Item was removed: - ----- 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 removed: - ----- Method: NanoClassTrait>>theNonMetaClass (in category 'accessing') ----- - theNonMetaClass - "Sent to a class or metaclass, always return the class" - ^baseTrait! Item was removed: - ----- Method: NanoTraitComposition>>isTraitTransformation (in category 'testing') ----- - isTraitTransformation - "Polymorphic with TraitTransformation" - ^false! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitExclusion>>@ (in category 'converting') ----- - @ anArrayOfAssociations - - NanoTraitCompositionException signal: 'Invalid trait exclusion. Aliases have to be specified before exclusions.' - ! Item was removed: - ----- Method: NanoTraitTransformation>>isAliasSelector: (in category 'testing') ----- - isAliasSelector: selector - ^subject isAliasSelector: selector! Item was removed: - ----- Method: NanoTrait>>obsolete (in category 'initialize') ----- - obsolete - self name: ('AnObsolete' , self name) asSymbol. - self class obsolete. - super obsolete! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitTransformation>>allTraits (in category 'accessing') ----- - allTraits - ^subject allTraits! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitTransformation>>removeTraitUser: (in category 'accessing') ----- - removeTraitUser: aTrait - users := users copyWithout: aTrait. - subject removeTraitUser: aTrait.! Item was removed: - ----- Method: NanoTraitDescription>>installTraitsFrom: (in category 'operations') ----- - installTraitsFrom: aTraitComposition - super installTraitsFrom: aTraitComposition. - self users do:[:each| each updateTraits].! Item was removed: - ----- Method: NanoTraitTransformation>>@ (in category 'converting') ----- - @ anArrayOfAssociations - ^self subclassResponsibility! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitComposition>>includesTrait: (in category 'testing') ----- - includesTrait: aTrait - ^self anySatisfy:[:each| each includesTrait: aTrait]! Item was removed: - ----- Method: NanoTrait>>isBaseTrait (in category 'testing') ----- - isBaseTrait - ^true! Item was removed: - ----- 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 removed: - ----- Method: NanoTrait class>>newTraitComposition (in category 'public') ----- - newTraitComposition - "Creates a new TraitComposition" - ^NanoTraitComposition new! Item was removed: - ----- Method: Trait class>>updateTraits: (in category 'class initialization') ----- - updateTraits: aCollection - "Convert all the traits in aCollection to NanoTraits. Used during installation." - "ClassDescription traitImpl: Trait. - Trait 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 removed: - NanoTraitTransformation subclass: #NanoTraitAlias - instanceVariableNames: 'aliases' - classVariableNames: '' - poolDictionaries: '' - category: 'Traits-NanoKernel'! - - !NanoTraitAlias commentStamp: '<historical>' prior: 0! - A trait transformation representing the alias (->) operator.! Item was removed: - ----- Method: NanoTraitDescription class>>conflict:with: (in category 'conflict methods') ----- - conflict: arg1 with: arg2 - "This method has a trait conflict" - ^self traitConflict! Item was removed: - ----- 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 removed: - ----- Method: NanoTrait>>asTraitComposition (in category 'converting') ----- - asTraitComposition - "Convert me into a trait composition" - ^TraitComposition with: self! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitTransformation>>traitsDo: (in category 'accessing') ----- - traitsDo: aBlock - ^subject traitsDo: aBlock! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitTransformation>>isLocalAliasSelector: (in category 'testing') ----- - isLocalAliasSelector: selector - ^false! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitTransformation>>updateTraits (in category 'operations') ----- - updateTraits - "Recompute my users traits composition" - users do:[:each| each updateTraits].! Item was removed: - ----- 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 removed: - ----- Method: NanoTrait>>isObsolete (in category 'testing') ----- - isObsolete - "Return true if the receiver is obsolete." - ^(self environment at: name ifAbsent: [nil]) ~~ self! Item was removed: - ----- Method: NanoTraitDescription>>copy (in category 'copying') ----- - copy - self error: 'Traits cannot be trivially copied'! Item was removed: - ----- Method: NanoTraitTransformation>>asTraitTransform (in category 'converting') ----- - asTraitTransform - ^self! Item was removed: - ----- Method: NanoTraitTransformation>>includesTrait: (in category 'testing') ----- - includesTrait: aTrait - ^subject includesTrait: aTrait! Item was removed: - ----- Method: NanoTrait>>removeFromSystem: (in category 'initialize') ----- - removeFromSystem: logged - self environment forgetClass: self logged: logged. - self obsolete! Item was removed: - ----- 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 removed: - ----- Method: NanoClassTrait>>uses: (in category 'initialize') ----- - uses: aTraitComposition - | newTraits | - newTraits := aTraitComposition asTraitComposition. - 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 removed: - ----- Method: NanoTraitTransformation>>trait (in category 'accessing') ----- - trait - ^subject trait! Item was removed: - ----- Method: NanoClassTrait>>classSide (in category 'accessing') ----- - classSide - ^self! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitDescription>>addUser: (in category 'accessing') ----- - addUser: aTrait - ^self addTraitUser: aTrait! Item was removed: - 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 removed: - 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 removed: - ----- Method: NanoClassTrait>>isMeta (in category 'testing') ----- - isMeta - ^true! Item was removed: - ----- Method: NanoTraitComposition>>addUser: (in category 'accessing') ----- - addUser: aUser - ^self addTraitUser: aUser! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitDescription>>isBaseTrait (in category 'testing') ----- - isBaseTrait - ^false! Item was removed: - ----- Method: NanoTraitExclusion>>initialize (in category 'initialize') ----- - initialize - super initialize. - exclusions := Set new. - ! Item was removed: - ----- Method: NanoTraitDescription>>removeUser: (in category 'accessing') ----- - removeUser: aTrait - ^self removeTraitUser: aTrait! Item was removed: - ----- Method: NanoTraitAlias>>- (in category 'converting') ----- - - anArrayOfSelectors - ^NanoTraitExclusion - with: self - exclusions: anArrayOfSelectors! Item was removed: - ----- Method: NanoTraitDescription>>asTraitComposition (in category 'converting') ----- - asTraitComposition - ^NanoTraitComposition with: self! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: NanoTraitDescription>>isTrait (in category 'testing') ----- - isTrait - ^true! Item was removed: - ----- Method: NanoTrait>>removeFromSystem (in category 'initialize') ----- - removeFromSystem - self removeFromSystem: true! Item was removed: - ----- Method: NanoTraitComposition>>asTraitComposition (in category 'converting') ----- - asTraitComposition - ^self! Item was removed: - ----- Method: NanoTraitDescription class>>conflict: (in category 'conflict methods') ----- - conflict: arg1 - "This method has a trait conflict" - ^self traitConflict! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitDescription>>traitComposition (in category 'accessing') ----- - traitComposition - ^traitComposition ifNil:[traitComposition := NanoTraitComposition new] - ! Item was removed: - ----- Method: NanoClassTrait>>baseTrait (in category 'accessing') ----- - baseTrait - ^baseTrait! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: NanoTrait>>hasClassTrait (in category 'testing') ----- - hasClassTrait - ^true! Item was removed: - 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 removed: - ----- Method: NanoTraitTransformation>>initialize (in category 'initialize') ----- - initialize - super initialize. - users := #().! Item was removed: - ----- 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 removed: - ----- 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 removed: - Error subclass: #NanoTraitCompositionException - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Traits-NanoKernel'! - - !NanoTraitCompositionException commentStamp: '<historical>' prior: 0! - Signals invalid trait compositions.! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitMethodState>>originalTraitMethod (in category 'accessing') ----- - originalTraitMethod - "The original method from the trait" - ^originalTraitMethod! Item was removed: - ----- Method: NanoTraitDescription>>classPool (in category 'accessing') ----- - classPool - "Traits have no class pool" - ^ Dictionary new! Item was removed: - ----- 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 removed: - ----- 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 removed: - 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 removed: - ----- Method: NanoTraitAlias>>isLocalAliasSelector: (in category 'testing') ----- - isLocalAliasSelector: selector - ^(aliases anySatisfy:[:assoc| assoc key == selector])! Item was removed: - ----- Method: NanoTraitMethodState>>originalTraitOrClass (in category 'accessing') ----- - originalTraitOrClass - "The original trait for this method" - ^originalTraitMethod originalTraitOrClass! Item was removed: - ----- 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." - (Smalltalk at: #TWriteStreamTest) classTrait - uses: - (Smalltalk at: #TSequencedStreamTest) classTrait + - (Smalltalk at: #TPuttableStreamTest) classTrait. - ! Item was removed: - ----- Method: NanoTraitDescription>>users: (in category 'accessing') ----- - users: aCollection - users := aCollection! Item was removed: - ----- Method: NanoTrait>>classTrait (in category 'accessing') ----- - classTrait - ^self class! Item was removed: - ----- Method: NanoTraitTransformation>>asTraitComposition (in category 'converting') ----- - asTraitComposition - ^NanoTraitComposition with: self! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitTransformation>>isTraitTransformation (in category 'testing') ----- - isTraitTransformation - "Polymorphic with Trait" - ^true! Item was removed: - 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 removed: - ----- Method: NanoTraitComposition>>traits (in category 'accessing') ----- - traits - ^Array streamContents:[:s| self traitsDo:[:t| s nextPut: t]]! Item was removed: - ----- Method: NanoTrait>>name: (in category 'accessing') ----- - name: aSymbol - name := aSymbol! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitAlias>>copyTraitExpression (in category 'operations') ----- - copyTraitExpression - "Copy all except the actual traits" - ^NanoTraitAlias - with: subject - aliases: aliases! Item was removed: - ----- Method: NanoTrait>>environment (in category 'accessing') ----- - environment - ^environment! Item was removed: - ----- 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 removed: - AdditionalMethodState variableSubclass: #NanoTraitMethodState - instanceVariableNames: 'originalTraitMethod' - classVariableNames: '' - poolDictionaries: '' - category: 'Traits-NanoKernel'! - - !NanoTraitMethodState commentStamp: '<historical>' prior: 0! - Additional method state for trait provided methods.! Item was removed: - ----- Method: NanoTrait>>name (in category 'accessing') ----- - name - ^name! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- 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 removed: - ----- 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 removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: NanoClassTrait>>instanceSide (in category 'accessing') ----- - instanceSide - ^self baseTrait! Item was removed: - ----- Method: NanoTraitDescription>>removeTraitUser: (in category 'accessing') ----- - removeTraitUser: aTrait - users := self users copyWithout: aTrait. - ! Item was removed: - ----- Method: NanoTraitDescription>>- (in category 'operations') ----- - - anArrayOfSelectors - "Creates an exclusion" - ^NanoTraitExclusion - with: self - exclusions: anArrayOfSelectors! Item was removed: - ----- Method: Trait class>>install (in category 'class initialization') ----- - install - "Trait install" - ClassDescription traitImpl: self. "Create all new traits as NanoTraits" - self updateTraits: Smalltalk allTraits. "And convert everything to NanoTraits" - "TWriteStreamTest has the class traits reversed which which will be undone - by installation. Put it back in reverse order to keep MC happy." - (Smalltalk at: #TWriteStreamTest) classTrait - uses: - (Smalltalk at: #TSequencedStreamTest) classTrait + - (Smalltalk at: #TPuttableStreamTest) classTrait. - Smalltalk allClassesAndTraits do:[:cls | | tc | - ((tc := cls traitComposition) isKindOf: TraitComposition) - ifFalse:[cls traitComposition: (TraitComposition withAll: tc)]. - ((tc := cls class traitComposition) isKindOf: TraitComposition) - ifFalse:[cls class traitComposition: (TraitComposition withAll: tc)]. - ].! Item was removed: - ----- Method: NanoTraitComposition>>allTraits (in category 'accessing') ----- - allTraits - ^self gather:[:each| each allTraits copyWith: each trait]! Item was removed: - ----- Method: NanoTraitAlias>>isAliasSelector: (in category 'testing') ----- - isAliasSelector: selector - ^(self isLocalAliasSelector: selector) or:[super isAliasSelector: selector]! Item was removed: - ----- Method: NanoTraitComposition>>removeTraitUser: (in category 'accessing') ----- - removeTraitUser: aUser - self do:[:each| each removeTraitUser: aUser]! Item was removed: - ----- 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 removed: - ----- Method: NanoTrait class>>initialize (in category 'initialize') ----- - initialize - "Install NanoTraits" - self install. - ! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: NanoTraitComposition>>removeUser: (in category 'accessing') ----- - removeUser: aUser - ^self removeTraitUser: aUser! Item was removed: - ----- Method: NanoTraitAlias>>@ (in category 'converting') ----- - @ anArrayOfAssociations - ^NanoTraitAlias - with: subject - aliases: (anArrayOfAssociations, self aliases)! Item was removed: - ----- 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 removed: - ----- Method: NanoClassTrait>>name (in category 'accessing') ----- - name - ^baseTrait name, ' classTrait'! Item was removed: - 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 removed: - ----- Method: NanoTraitComposition>>printOn: (in category 'converting') ----- - printOn: aStream - "Answer the trait composition string (used for class definitions)" - aStream nextPutAll: self traitCompositionString. - ! Item was removed: - ----- Method: NanoTraitTransformation>>+ (in category 'converting') ----- - + aTrait - "Just like ordered collection" - ^NanoTraitComposition withAll: {self. aTrait}! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitDescription>>traitsDo: (in category 'operations') ----- - traitsDo: aBlock - aBlock value: self.! Item was removed: - ----- Method: NanoTraitTransformation>>subject: (in category 'accessing') ----- - subject: aSubject - subject := aSubject.! Item was removed: - ----- Method: NanoTraitExclusion>>exclusions (in category 'accessing') ----- - exclusions - ^exclusions! Item was removed: - ----- Method: NanoTraitMethodState>>originalTraitMethod: (in category 'accessing') ----- - originalTraitMethod: aCompiledMethod - "The original method from the trait" - originalTraitMethod := aCompiledMethod! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: NanoTraitDescription class>>conflict (in category 'conflict methods') ----- - conflict - "This method has a trait conflict" - ^self traitConflict! Item was removed: - ----- Method: NanoTraitComposition>>traitsDo: (in category 'accessing') ----- - traitsDo: aBlock - ^self do:[:each| each traitsDo: aBlock]! Item was removed: - ----- Method: NanoTraitDescription>>allClassVarNames (in category 'accessing') ----- - allClassVarNames - "Traits have no class var names" - ^#()! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitTransformation>>- (in category 'converting') ----- - - anArrayOfSelectors - ^self subclassResponsibility! Item was removed: - ----- Method: NanoTrait>>environment: (in category 'accessing') ----- - environment: anObject - environment := anObject! Item was removed: - ----- Method: NanoTraitDescription>>includesTrait: (in category 'testing') ----- - includesTrait: aTrait - ^self == aTrait or:[super includesTrait: aTrait]! Item was removed: - ----- Method: NanoTraitDescription>>trait (in category 'accessing') ----- - trait - ^self! Item was removed: - ----- Method: NanoClassTrait>>asMCDefinition (in category 'monticello') ----- - asMCDefinition - ^Smalltalk at: #MCClassTraitDefinition ifPresent:[:aClass| - aClass - baseTraitName: self baseTrait name - classTraitComposition: self traitCompositionString - ].! Item was removed: - ----- 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 removed: - ----- Method: NanoTraitDescription>>copyTraitExpression (in category 'copying') ----- - copyTraitExpression - "Copy all except the actual traits" - ^self! Item was removed: - ----- Method: NanoTraitDescription>>users (in category 'accessing') ----- - users - ^users ifNil:[#()]! Item was removed: - ----- Method: NanoTraitComposition>>removeFromComposition: (in category 'compat') ----- - removeFromComposition: aTrait - "--- ignore ---"! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: NanoTraitComposition>>copyTraitExpression (in category 'operations') ----- - copyTraitExpression - "Copy all except the actual traits" - ^self collect:[:each| each copyTraitExpression].! Item was removed: - ----- Method: Trait class>>initialize (in category 'class initialization') ----- - initialize - "Trait initialize" - self install.! Item was removed: - ----- Method: NanoTraitDescription>>addTraitUser: (in category 'accessing') ----- - addTraitUser: aTrait - users := self users copyWith: aTrait. - ! Item was removed: - ----- Method: NanoTraitExclusion class>>with:exclusions: (in category 'instance creation') ----- - with: aTraitComposition exclusions: anArrayOfSelectors - ^self new - subject: aTraitComposition; - exclusions: anArrayOfSelectors; - yourself - ! Item was removed: - ----- Method: NanoTraitAlias>>aliases (in category 'accessing') ----- - aliases - "Collection of associations where key is the - alias and value the original selector." - ^aliases!
More information about the Squeak-dev mailing list |