Andreas Raab uploaded a new version of Traits to project The Trunk:
http://source.squeak.org/trunk/Traits-ar.261.mcz ==================== Summary ==================== Name: Traits-ar.261 Author: ar Time: 30 December 2009, 2:36:09 am UUID: 79108af0-87db-b84b-839e-bdad931f5e94 Ancestors: Traits-ar.259 Revert the use of ClassTrait being the class of Trait. It causes problems when modifying class Trait itself since the subclass machinery isn't present and ClassBuilder is not ready for supporting alternative metaclasses in this form. =============== Diff against Traits-ar.256 =============== Item was added: + ClassDescription subclass: #TraitBehavior + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-Kernel'! + + !TraitBehavior commentStamp: 'ar 12/29/2009 18:15' prior: 0! + Stub class for backward compatibility. Allows past extension methods in TraitBehavior to continue to work.! Item was added: + ----- Method: Trait>>removeFromSystem (in category 'initialize') ----- + removeFromSystem + self removeFromSystem: true! Item was added: + ----- Method: TraitDescription>>copy (in category 'copying') ----- + copy + self error: 'Traits cannot be trivially copied'! Item was added: + ----- Method: TraitExclusion>>- (in category 'converting') ----- + - anArrayOfSelectors + ^TraitExclusion + with: subject + exclusions: (anArrayOfSelectors, exclusions asArray)! Item was changed: ----- 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: TraitDescription>>+ (in category 'operations') ----- + + aTrait + "Creates a composition with the receiver and aTrait" + aTrait traitsDo:[:t| self == t ifTrue:[TraitCompositionException + signal: 'Trait ' , self asString, ' already in composition']]. + ^TraitComposition withAll: {self}, aTrait asTraitComposition! Item was added: + ----- Method: ClassTrait>>instanceSide (in category 'accessing') ----- + instanceSide + ^self baseTrait! Item was changed: + OrderedCollection subclass: #TraitComposition + instanceVariableNames: '' - Object subclass: #TraitComposition - instanceVariableNames: 'transformations' classVariableNames: '' poolDictionaries: '' category: 'Traits-Composition'! + !TraitComposition commentStamp: 'ar 12/29/2009 18:13' prior: 0! + A trait composition is a collection of Traits or TraitTransformations.! - !TraitComposition commentStamp: '<historical>' prior: 0! - I hold a collection of trait transformations and provide important facilities to query the trait composition. For each trait in the composition clause there exists exactly one transformation in the collection. - - Note, that directly manipulating the composition of a class or trait does not effect changes automatically. Use PureBehavior>>setTraitComposition: to do this. You have to make a copy of the old trait composition before changing it because only the difference between the new and the old composition is updated!!! Item was added: + ----- Method: ClassTrait>>soleInstance (in category 'accessing') ----- + soleInstance + ^baseTrait! Item was added: + ----- Method: TraitAlias>>initialize (in category 'initialize-release') ----- + initialize + super initialize. + aliases := #().! Item was added: + ----- Method: TraitDescription>>addUser: (in category 'accessing') ----- + addUser: aTrait + ^self addTraitUser: aTrait! Item was changed: + ----- Method: TraitExclusion>>printOn: (in category 'composition') ----- - ----- Method: TraitExclusion>>printOn: (in category 'printing') ----- 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: '}'.! - super printOn: aStream. - aStream - space; - nextPut: $-; - space; - nextPut: ${. - self exclusions do: [:each | aStream print: each] - separatedBy: [aStream nextPutAll: '. ']. - aStream nextPut: $}! Item was added: + ----- Method: TraitExclusion>>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: Trait>>environment: (in category 'accessing') ----- + environment: anObject + environment := anObject! Item was added: + ----- Method: TraitDescription>>- (in category 'operations') ----- + - anArrayOfSelectors + "Creates an exclusion" + ^TraitExclusion + with: self + exclusions: anArrayOfSelectors! Item was added: + ----- Method: TraitTransformation>>isAliasSelector: (in category 'testing') ----- + isAliasSelector: selector + ^subject isAliasSelector: selector! Item was added: + ----- Method: TraitComposition>>addUser: (in category 'accessing') ----- + addUser: aUser + ^self addTraitUser: aUser! Item was added: + ----- Method: TraitTransformation>>allTraits (in category 'accessing') ----- + allTraits + ^subject allTraits! Item was added: + ----- Method: ClassTrait>>updateTraitsFrom: (in category 'initialize') ----- + updateTraitsFrom: instanceTraits + "Update me from the given instance traits" + | map newTraits trait | + map := Dictionary new. + self traitComposition do:[:composed| map at: composed trait put: composed]. + newTraits := (instanceTraits collect:[:composed| + trait := composed trait classTrait. + map at: trait ifAbsent:[trait]] + ), (self traitComposition select:[:comp| comp trait isBaseTrait]). + + self installTraitsFrom: newTraits! Item was added: + ----- Method: ClassTrait>>name (in category 'accessing') ----- + name + ^baseTrait name, ' classTrait'! Item was changed: TraitTransformation subclass: #TraitAlias instanceVariableNames: 'aliases' + classVariableNames: '' - classVariableNames: 'AliasMethodCache' poolDictionaries: '' category: 'Traits-Composition'! + !TraitAlias commentStamp: 'ar 12/29/2009 18:14' prior: 0! + A trait transformation representing the alias (->) operator.! - !TraitAlias commentStamp: '<historical>' prior: 0! - See comment of my superclass TraitTransformation.! Item was added: + ----- Method: TraitAlias>>@ (in category 'converting') ----- + @ anArrayOfAssociations + ^TraitAlias + with: subject + aliases: (anArrayOfAssociations, self aliases)! Item was added: + ----- Method: Trait>>theMetaClass (in category 'accessing') ----- + theMetaClass + ^self classTrait! Item was added: + ----- Method: TraitDescription>>removeUser: (in category 'accessing') ----- + removeUser: aTrait + ^self removeTraitUser: aTrait! Item was added: + ----- Method: TraitAlias>>initializeFrom: (in category 'initialize-release') ----- + initializeFrom: anArrayOfAssociations + | newNames | + newNames := (anArrayOfAssociations collect: [:each | each key]) asIdentitySet. + newNames size < anArrayOfAssociations size ifTrue: [ + TraitCompositionException signal: 'Cannot use the same alias name twice']. + anArrayOfAssociations do: [:each | + (newNames includes: each value) ifTrue: [ + TraitCompositionException signal: 'Cannot define an alias for an alias']]. + aliases := anArrayOfAssociations. + ! Item was changed: + ----- Method: TraitTransformation>>@ (in category 'converting') ----- - ----- Method: TraitTransformation>>@ (in category 'composition') ----- @ anArrayOfAssociations + ^self subclassResponsibility! - TraitCompositionException signal: 'Invalid trait exclusion. Aliases have to be specified before exclusions.'! Item was added: + ----- Method: TraitDescription 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: Trait>>definitionST80 (in category 'initialize') ----- + definitionST80 + ^String streamContents: [:stream | + stream nextPutAll: 'Trait named: '; + store: self name. + stream cr; tab; nextPutAll: 'uses: '; + nextPutAll: self traitComposition asString. + stream cr; tab; nextPutAll: 'category: '; + store: self category asString].! Item was added: + ----- Method: TraitComposition>>removeUser: (in category 'accessing') ----- + removeUser: aUser + ^self removeTraitUser: aUser! Item was added: + ----- Method: TraitDescription>>isTrait (in category 'testing') ----- + isTrait + ^true! Item was changed: ----- 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. + ^TraitDescription class compiledMethodAt: selector.! - ^NanoTraitDescription class compiledMethodAt: selector.! Item was changed: ----- Method: TraitComposition>>asTraitComposition (in category 'converting') ----- asTraitComposition ^self! Item was added: + ----- Method: TraitDescription class>>conflict: (in category 'conflict methods') ----- + conflict: arg1 + "This method has a trait conflict" + ^self traitConflict! Item was added: + ----- Method: TraitTransformation>>isTraitTransformation (in category 'testing') ----- + isTraitTransformation + "Polymorphic with Trait" + ^true! Item was added: + ----- Method: TraitDescription>>traitComposition (in category 'accessing') ----- + traitComposition + ^traitComposition ifNil:[traitComposition := TraitComposition new] + ! Item was added: + Object subclass: #TraitTransformation + instanceVariableNames: 'subject users' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-Composition'! + + !TraitTransformation commentStamp: 'ar 12/29/2009 18:14' 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: Trait>>environment (in category 'accessing') ----- + environment + ^environment! Item was added: + ----- Method: Trait>>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 added: + ----- Method: TraitTransformation>>traitsDo: (in category 'accessing') ----- + traitsDo: aBlock + ^subject traitsDo: aBlock! Item was added: + ----- Method: TraitDescription class>>conflict (in category 'conflict methods') ----- + conflict + "This method has a trait conflict" + ^self traitConflict! Item was changed: ----- Method: NanoTrait>>obsolete (in category 'initialize') ----- obsolete self name: ('AnObsolete' , self name) asSymbol. + self class obsolete. super obsolete! Item was changed: + ----- Method: TraitExclusion>>copyTraitExpression (in category 'composition') ----- - ----- Method: TraitExclusion>>copyTraitExpression (in category 'copying') ----- copyTraitExpression + "Copy all except the actual traits" + ^TraitExclusion + with: subject + exclusions: exclusions asArray! - ^super copyTraitExpression - exclusions: self exclusions deepCopy; - yourself! Item was added: + ----- Method: TraitTransformation>>isLocalAliasSelector: (in category 'testing') ----- + isLocalAliasSelector: selector + ^false! Item was added: + ----- Method: TraitTransformation>>updateTraits (in category 'operations') ----- + updateTraits + "Recompute my users traits composition" + users do:[:each| each updateTraits].! Item was added: + ----- Method: TraitDescription 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: Trait>>baseTrait (in category 'accessing') ----- + baseTrait + ^self! Item was added: + ----- Method: ClassTrait>>asMCDefinition (in category 'monticello') ----- + asMCDefinition + ^Smalltalk at: #MCClassTraitDefinition ifPresent:[:aClass| + aClass + baseTraitName: self baseTrait name + classTraitComposition: self traitCompositionString + ].! Item was added: + ----- Method: Trait>>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: TraitDescription>>users: (in category 'accessing') ----- + users: aCollection + users := aCollection! Item was added: + ----- Method: Trait>>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: Trait>>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: TraitTransformation>>asTraitTransform (in category 'converting') ----- + asTraitTransform + ^self! Item was added: + ----- Method: TraitTransformation>>includesTrait: (in category 'testing') ----- + includesTrait: aTrait + ^subject includesTrait: aTrait! Item was changed: ----- Method: CompiledMethod>>originalTraitMethod: (in category '*Traits-NanoKernel') ----- originalTraitMethod: aCompiledMethod "Remember the original trait method for the receiver." | methodState | + methodState := TraitMethodState newFrom: self properties. - methodState := NanoTraitMethodState newFrom: self properties. methodState originalTraitMethod: aCompiledMethod. self penultimateLiteral: methodState.! Item was added: + ----- Method: TraitDescription>>copyTraitExpression (in category 'copying') ----- + copyTraitExpression + "Copy all except the actual traits" + ^self! Item was changed: + ----- Method: TraitTransformation>>trait (in category 'accessing') ----- - ----- Method: TraitTransformation>>trait (in category 'enquiries') ----- trait + ^subject trait! - ^self subject trait! Item was changed: ----- Method: TraitAlias>>aliases (in category 'accessing') ----- aliases "Collection of associations where key is the alias and value the original selector." - ^aliases! Item was added: + ----- Method: Trait 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: TraitDescription>>users (in category 'accessing') ----- + users + ^users ifNil:[#()]! Item was added: + ----- Method: Trait 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: 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 added: + ----- Method: NanoTrait>>asTraitComposition (in category 'converting') ----- + asTraitComposition + "Convert me into a trait composition" + ^TraitComposition with: self! Item was added: + ----- Method: TraitComposition>>selectorsAndMethodsDo: (in category 'operations') ----- + selectorsAndMethodsDo: aBlock + "enumerates all selectors and methods in a trait composition" + self do:[:each| each selectorsAndMethodsDo: aBlock].! Item was changed: + ----- Method: TraitComposition>>copyTraitExpression (in category 'operations') ----- - ----- Method: TraitComposition>>copyTraitExpression (in category 'copying') ----- copyTraitExpression + "Copy all except the actual traits" + ^self collect:[:each| each copyTraitExpression].! - | newCopy | - newCopy := self shallowCopy. - newCopy transformations: (self transformations collect: [ : each | each copyTraitExpression ]). - ^ newCopy - ! Item was added: + ----- Method: TraitDescription>>addTraitUser: (in category 'accessing') ----- + addTraitUser: aTrait + users := self users copyWith: aTrait. + ! Item was added: + ----- Method: TraitComposition>>addTraitUser: (in category 'accessing') ----- + addTraitUser: aUser + self do:[:each| each addTraitUser: aUser]! Item was added: + ----- Method: ClassTrait>>isClassTrait (in category 'testing') ----- + isClassTrait + ^true! Item was added: + ----- Method: Trait>>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: ClassTrait>>theMetaClass (in category 'accessing') ----- + theMetaClass + ^self! Item was changed: ----- Method: NanoClassTrait>>uses: (in category 'initialize') ----- uses: aTraitComposition | newTraits | + newTraits := aTraitComposition asTraitComposition. - 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: Trait>>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: TraitExclusion>>@ (in category 'converting') ----- + @ anArrayOfAssociations + + TraitCompositionException signal: 'Invalid trait exclusion. Aliases have to be specified before exclusions.' + ! Item was added: + ----- Method: ClassTrait>>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: TraitMethodState>>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: Trait>>obsolete (in category 'initialize') ----- + obsolete + self name: ('AnObsolete' , self name) asSymbol. + self classTrait obsolete. + super obsolete! Item was added: + ----- Method: Trait>>initialize (in category 'initialize-release') ----- + initialize + super initialize. + classTrait := ClassTrait for: self.! Item was added: + ----- Method: TraitDescription>>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: TraitDescription>>traitComposition: (in category 'accessing') ----- + traitComposition: aTraitComposition + traitComposition := aTraitComposition. + ! Item was changed: + ----- Method: TraitComposition>>+ (in category 'converting') ----- + + aTrait + self traitsDo:[:t| (t == aTrait trait) ifTrue:[^TraitCompositionException + signal: 'Trait ' , aTrait trait asString, ' already in composition']]. + self addLast: aTrait. + ^self! - ----- Method: TraitComposition>>+ (in category 'composition') ----- - + aTraitExpression - ^ aTraitExpression addCompositionOnLeft: self. - ! Item was added: + ----- Method: TraitTransformation>>initialize (in category 'initialize') ----- + initialize + super initialize. + users := #().! Item was added: + ----- Method: TraitDescription>>isClassTrait (in category 'testing') ----- + isClassTrait + ^false! Item was added: + ----- Method: TraitDescription>>removeTraitUser: (in category 'accessing') ----- + removeTraitUser: aTrait + users := self users copyWithout: aTrait. + ! Item was changed: TraitTransformation subclass: #TraitExclusion instanceVariableNames: 'exclusions' classVariableNames: '' poolDictionaries: '' category: 'Traits-Composition'! + !TraitExclusion commentStamp: 'ar 12/29/2009 18:13' prior: 0! + A trait transformation representing the exclusion (-) operator.! - !TraitExclusion commentStamp: '<historical>' prior: 0! - See comment of my superclass TraitTransformation.! Item was added: + ----- Method: Trait 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 changed: ----- Method: ClassDescription>>localSelectors (in category '*Traits-NanoKernel') ----- localSelectors + ^self selectors select:[:sel| self includesLocalSelector: sel]! - ^(self traitComposition isKindOf: NanoTraitComposition) - ifTrue:[self selectors select:[:sel| self includesLocalSelector: sel]] - ifFalse:[super localSelectors]. - ! Item was changed: + ----- Method: TraitComposition>>isAliasSelector: (in category 'operations') ----- + isAliasSelector: selector + "enumerates all selectors and methods in a trait composition" + ^self anySatisfy:[:any| any isAliasSelector: selector]! - ----- Method: TraitComposition>>isAliasSelector: (in category 'testing') ----- - isAliasSelector: aSymbol - "Return true if the selector aSymbol is an alias defined - in this or in another composition somewhere deeper in - the tree of traits compositions." - - | methodDescription | - methodDescription := (self methodDescriptionsForSelector: aSymbol) - detect: [:each | each selector = aSymbol]. - ^methodDescription isAliasSelector! Item was added: + ----- Method: TraitDescription>>@ (in category 'operations') ----- + @ anArrayOfAssociations + "Creates an alias" + ^TraitAlias with: self aliases: anArrayOfAssociations! Item was changed: ----- Method: TraitComposition>>allTraits (in category 'accessing') ----- allTraits + ^self gather:[:each| each allTraits copyWith: each trait]! - ^self traits gather: [:trait | - trait hasTraitComposition - ifTrue: [trait traitComposition allTraits copyWith: trait] - ifFalse: [Array with: trait]]! Item was changed: + ----- Method: TraitComposition>>- (in category 'converting') ----- - ----- Method: TraitComposition>>- (in category 'composition') ----- - 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)! - self transformations - addLast: (self transformations removeLast - anArray)! Item was changed: ----- Method: TraitComposition>>removeTraitUser: (in category 'accessing') ----- + removeTraitUser: aUser + self do:[:each| each removeTraitUser: aUser]! - removeTraitUser: aClass - self traits do:[:each| each removeUser: aClass].! Item was added: + ----- Method: Trait>>isBaseTrait (in category 'testing') ----- + isBaseTrait + ^true! Item was added: + ----- Method: ClassTrait>>theNonMetaClass (in category 'accessing') ----- + theNonMetaClass + "Sent to a class or metaclass, always return the class" + ^baseTrait! Item was added: + ----- Method: ClassTrait>>baseTrait (in category 'accessing') ----- + baseTrait + ^baseTrait! Item was added: + ----- Method: Trait class>>newTraitComposition (in category 'public') ----- + newTraitComposition + "Creates a new TraitComposition" + ^TraitComposition new! Item was changed: + ----- Method: TraitAlias>>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: '}'. + ! - ----- Method: TraitAlias>>printOn: (in category 'printing') ----- - printOn: aStream - super printOn: aStream. - aStream - space; - nextPut: $@; - space; - nextPut: ${. - self aliases do: [:each | aStream print: each] - separatedBy: [aStream nextPutAll: '. ']. - aStream nextPut: $}! Item was added: + ----- Method: Trait>>asTraitComposition (in category 'converting') ----- + asTraitComposition + "Convert me into a trait composition" + ^TraitComposition with: self! Item was added: + ----- Method: Trait 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 := Trait new. + ] ifNotNil:[ + oldCategory := oldTrait category. + trait := oldTrait. + ]. + (trait isMemberOf: Trait) ifFalse: [ + ^self error: trait name , ' is not a Trait']. + trait + setName: aSymbol + andRegisterInCategory: systemCategory + environment: anEnvironment. + + trait uses: aTraitComposition. + + "... notify interested clients ..." + oldTrait ifNil:[ + SystemChangeNotifier uniqueInstance classAdded: trait inCategory: systemCategory. + ] ifNotNil:[ + systemCategory = oldCategory ifFalse:[ + SystemChangeNotifier uniqueInstance class: trait + recategorizedFrom: oldTrait category to: systemCategory]. + ]. + ^ trait! Item was added: + ----- Method: TraitTransformation>>asTraitComposition (in category 'converting') ----- + asTraitComposition + ^TraitComposition with: self! Item was changed: ----- Method: ClassDescription>>updateTraits (in category '*Traits-NanoKernel') ----- updateTraits "Recompute my local traits composition" + self installTraitsFrom: self traitComposition. - (self traitComposition isKindOf: NanoTraitComposition) - ifTrue:[self installTraitsFrom: self traitComposition]. ! Item was changed: + ----- Method: TraitComposition>>printOn: (in category 'converting') ----- - ----- Method: TraitComposition>>printOn: (in category 'printing') ----- printOn: aStream + "Answer the trait composition string (used for class definitions)" + aStream nextPutAll: self traitCompositionString. + ! - self transformations isEmptyOrNil - ifFalse: [ - self transformations - do: [:each | aStream print: each] - separatedBy: [aStream nextPutAll: ' + '] ] - ifTrue: [aStream nextPutAll: '{}'] - ! Item was added: + ----- Method: TraitDescription>>traitsDo: (in category 'operations') ----- + traitsDo: aBlock + aBlock value: self.! Item was added: + ----- Method: TraitMethodState>>originalTraitMethod: (in category 'accessing') ----- + originalTraitMethod: aCompiledMethod + "The original method from the trait" + originalTraitMethod := aCompiledMethod! Item was changed: ----- 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 classSide updateTraitsFrom: aTraitComposition].! - self isMeta ifFalse:[self class updateTraitsFrom: aTraitComposition].! Item was added: + ----- Method: TraitComposition>>traitsDo: (in category 'accessing') ----- + traitsDo: aBlock + ^self do:[:each| each traitsDo: aBlock]! Item was added: + ----- Method: Trait>>isObsolete (in category 'testing') ----- + isObsolete + "Return true if the receiver is obsolete." + ^(self environment at: name ifAbsent: [nil]) ~~ self! Item was added: + ----- Method: TraitDescription>>allClassVarNames (in category 'accessing') ----- + allClassVarNames + "Traits have no class var names" + ^#()! Item was changed: + ----- Method: TraitComposition>>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]]! - ----- Method: TraitComposition>>isLocalAliasSelector: (in category 'testing') ----- - isLocalAliasSelector: aSymbol - "Return true if the selector aSymbol is an alias defined - in this composition." - - | methodDescription | - methodDescription := (self methodDescriptionsForSelector: aSymbol) - detect: [:each | each selector = aSymbol]. - ^methodDescription isLocalAliasSelector! Item was added: + ----- Method: Trait>>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: Trait>>removeFromSystem: (in category 'initialize') ----- + removeFromSystem: logged + self environment forgetClass: self logged: logged. + self obsolete! Item was added: + AdditionalMethodState variableSubclass: #TraitMethodState + instanceVariableNames: 'originalTraitMethod' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-Kernel'! + + !TraitMethodState commentStamp: 'ar 12/29/2009 18:13' prior: 0! + Additional method state for trait provided methods.! Item was added: + ----- Method: ClassTrait>>baseTrait: (in category 'accessing') ----- + baseTrait: aTrait + baseTrait ifNotNil:[self error: 'Already initialized']. + baseTrait := aTrait.! Item was added: + ----- Method: TraitDescription>>includesTrait: (in category 'testing') ----- + includesTrait: aTrait + ^self == aTrait or:[super includesTrait: aTrait]! Item was added: + TraitDescription subclass: #ClassTrait + instanceVariableNames: 'baseTrait' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-Kernel'! + + !ClassTrait commentStamp: 'ar 12/29/2009 18:16' prior: 0! + The class of some trait. Just like the Class - Metaclass relationship.! Item was added: + ----- Method: TraitDescription>>trait (in category 'accessing') ----- + trait + ^self! Item was changed: ----- Method: TraitComposition>>includesTrait: (in category 'testing') ----- includesTrait: aTrait + ^self anySatisfy:[:each| each includesTrait: aTrait]! - ^self traits includes: aTrait! Item was added: + ----- Method: TraitDescription 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: TraitAlias>>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 changed: + ----- Method: TraitAlias>>copyTraitExpression (in category 'operations') ----- - ----- Method: TraitAlias>>copyTraitExpression (in category 'copying') ----- copyTraitExpression + "Copy all except the actual traits" + ^TraitAlias + with: subject + aliases: aliases! - ^super copyTraitExpression - aliases: self aliases deepCopy; - yourself! Item was added: + ----- Method: ClassTrait>>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: TraitDescription class>>conflict:with: (in category 'conflict methods') ----- + conflict: arg1 with: arg2 + "This method has a trait conflict" + ^self traitConflict! Item was changed: + ----- Method: TraitComposition>>removeFromComposition: (in category 'compat') ----- - ----- Method: TraitComposition>>removeFromComposition: (in category 'accessing') ----- removeFromComposition: aTrait + "--- ignore ---"! - self remove: - (self transformationOfTrait: aTrait)! Item was added: + TraitDescription subclass: #Trait + instanceVariableNames: 'name environment classTrait category' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-Kernel'! + + !Trait commentStamp: 'ar 12/29/2009 18:16' prior: 0! + Defines a trait in the system. Like Class, I concretize my superclass by providing instance variables for the name and the environment.! Item was added: + ----- Method: TraitExclusion>>initialize (in category 'initialize') ----- + initialize + super initialize. + exclusions := Set new. + ! Item was added: + ----- Method: ClassTrait>>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 added: + ----- Method: Trait>>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: ClassTrait>>classSide (in category 'accessing') ----- + classSide + ^self! Item was added: + ----- Method: Trait class>>allTraitsDo: (in category 'public') ----- + allTraitsDo: aBlock + "Evaluate aBlock with all the instance and class traits present in the system" + Trait allInstances do: [:aTrait| + aBlock value: aTrait instanceSide. + aBlock value: aTrait classSide. + ].! Item was added: + ----- Method: Trait>>hasClassTrait (in category 'testing') ----- + hasClassTrait + ^true! Item was added: + ----- Method: ClassTrait>>isMeta (in category 'testing') ----- + isMeta + ^true! Item was added: + TraitBehavior subclass: #TraitDescription + instanceVariableNames: 'users traitComposition' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-Kernel'! + + !TraitDescription commentStamp: 'ar 12/29/2009 18:15' prior: 0! + TraitDescription combines common behavior for both (instance) traits and (meta) class traits.! Item was changed: ----- Method: ClassDescription>>uses: (in category '*Traits-NanoKernel') ----- uses: aTraitComposition + + self installTraitsFrom: aTraitComposition asTraitComposition. - | 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 changed: ----- Method: TraitExclusion>>exclusions (in category 'accessing') ----- exclusions ^exclusions! Item was added: + ----- Method: TraitTransformation>>+ (in category 'converting') ----- + + aTrait + "Just like ordered collection" + ^TraitComposition withAll: {self. aTrait}! Item was added: + ----- Method: ClassTrait class>>for: (in category 'instance creation') ----- + for: baseTrait + ^self new baseTrait: baseTrait! Item was changed: ----- Method: TraitTransformation>>subject: (in category 'accessing') ----- + subject: aSubject + subject := aSubject.! - subject: aTraitTransformation - subject := aTraitTransformation! Item was added: + ----- Method: TraitAlias>>isAliasSelector: (in category 'testing') ----- + isAliasSelector: selector + ^(self isLocalAliasSelector: selector) or:[super isAliasSelector: selector]! Item was added: + ----- Method: Trait>>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: TraitDescription>>sharedPools (in category 'accessing') ----- + sharedPools + "Traits have no shared pools" + ^ Dictionary new! Item was changed: + ----- Method: TraitAlias>>- (in category 'converting') ----- - ----- Method: TraitAlias>>- (in category 'composition') ----- - anArrayOfSelectors ^TraitExclusion with: self exclusions: anArrayOfSelectors! Item was changed: ----- Method: TraitAlias class>>with:aliases: (in category 'instance creation') ----- with: aTraitComposition aliases: anArrayOfAssociations self assertValidAliasDefinition: anArrayOfAssociations. ^self new subject: aTraitComposition; + initializeFrom: anArrayOfAssociations; - aliases: anArrayOfAssociations; yourself! Item was added: + ----- Method: TraitComposition>>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: 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 added: + ----- Method: TraitDescription>>isBaseTrait (in category 'testing') ----- + isBaseTrait + ^false! Item was added: + ----- Method: TraitTransformation>>removeTraitUser: (in category 'accessing') ----- + removeTraitUser: aTrait + users := users copyWithout: aTrait. + subject removeTraitUser: aTrait.! Item was changed: + ----- Method: TraitTransformation>>- (in category 'converting') ----- + - anArrayOfSelectors + ^self subclassResponsibility! - ----- Method: TraitTransformation>>- (in category 'composition') ----- - - anArray - TraitCompositionException signal: 'Invalid trait exclusion. Exclusions have to be specified after aliases.'! Item was added: + ----- Method: Trait>>classTrait (in category 'accessing') ----- + classTrait + ^classTrait! Item was added: + ----- Method: Trait>>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: ClassTrait>>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: TraitDescription 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: TraitDescription>>asTraitComposition (in category 'converting') ----- + asTraitComposition + ^TraitComposition with: self! Item was changed: + ----- Method: TraitComposition>>@ (in category 'converting') ----- - ----- Method: TraitComposition>>@ (in category 'composition') ----- @ 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)! - self transformations - addLast: (self transformations removeLast @ anArrayOfAssociations)! Item was added: + ----- Method: TraitDescription>>isTraitTransformation (in category 'testing') ----- + isTraitTransformation + "Polymorphic with TraitTransformation" + ^false! Item was added: + ----- Method: TraitAlias>>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: + ----- Method: TraitDescription>>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: Trait>>name: (in category 'accessing') ----- + name: aSymbol + name := aSymbol! Item was added: + ----- Method: TraitDescription>>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: TraitComposition>>isTraitTransformation (in category 'testing') ----- + isTraitTransformation + "Polymorphic with TraitTransformation" + ^false! Item was changed: ----- Method: TraitAlias>>aliases: (in category 'accessing') ----- + aliases: aCollection + "Collection of associations where key is the + alias and value the original selector." + aliases := aCollection! - aliases: anArrayOfAssociations - | newNames | - newNames := (anArrayOfAssociations collect: [:each | each key]) asIdentitySet. - newNames size < anArrayOfAssociations size ifTrue: [ - TraitCompositionException signal: 'Cannot use the same alias name twice']. - anArrayOfAssociations do: [:each | - (newNames includes: each value) ifTrue: [ - TraitCompositionException signal: 'Cannot define an alias for an alias']]. - aliases := anArrayOfAssociations! Item was added: + ----- Method: TraitAlias>>isLocalAliasSelector: (in category 'testing') ----- + isLocalAliasSelector: selector + ^(aliases anySatisfy:[:assoc| assoc key == selector])! Item was changed: ----- Method: TraitExclusion class>>with:exclusions: (in category 'instance creation') ----- with: aTraitComposition exclusions: anArrayOfSelectors ^self new subject: aTraitComposition; exclusions: anArrayOfSelectors; yourself ! Item was added: + ----- Method: TraitMethodState>>originalTraitMethod (in category 'accessing') ----- + originalTraitMethod + "The original method from the trait" + ^originalTraitMethod! Item was added: + ----- Method: TraitDescription 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: TraitDescription>>classPool (in category 'accessing') ----- + classPool + "Traits have no class pool" + ^ Dictionary new! Item was added: + ----- Method: TraitExclusion>>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: Trait>>name (in category 'accessing') ----- + name + ^name! Item was added: + ----- Method: TraitDescription>>installTraitsFrom: (in category 'operations') ----- + installTraitsFrom: aTraitComposition + super installTraitsFrom: aTraitComposition. + self users do:[:each| each updateTraits].! Item was added: + ----- Method: TraitMethodState>>originalTraitOrClass (in category 'accessing') ----- + originalTraitOrClass + "The original trait for this method" + ^originalTraitMethod originalTraitOrClass! Item was changed: ----- Method: TraitAlias 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.']. - TraitCompositionException signal: 'Invalid alias definition: Not a collection of associations.']. (anArrayOfAssociations allSatisfy: [:association | (association key numArgs = association value numArgs and: [ (association key numArgs = -1) not])]) ifFalse: [ TraitCompositionException signal: 'Invalid alias definition: Alias and original selector have to have the same number of arguments.']! Item was added: + ----- Method: TraitDescription>>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: TraitTransformation>>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: TraitDescription>>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: TraitTransformation>>selectorsAndMethodsDo: (in category 'operations') ----- + selectorsAndMethodsDo: aBlock + "enumerates all selectors and methods in a trait composition" + ^self subclassResponsibility! Item was changed: + ----- Method: TraitTransformation>>copyTraitExpression (in category 'operations') ----- - ----- Method: TraitTransformation>>copyTraitExpression (in category 'copying') ----- copyTraitExpression + "Copy all except the actual traits" + ^self subclassResponsibility! - ^self shallowCopy - subject: self subject copyTraitExpression; - yourself! Item was changed: ----- Method: TraitComposition>>traits (in category 'accessing') ----- traits + ^Array streamContents:[:s| self traitsDo:[:t| s nextPut: t]]! - ^self transformations collect: [:each | - each trait]! Item was added: + ----- Method: Trait class>>initialize (in category 'class initialization') ----- + initialize + "Trait initialize" + self install.! Item was added: + ----- Method: TraitDescription>>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: TraitTransformation>>addTraitUser: (in category 'accessing') ----- + addTraitUser: aTrait + users := users copyWith: aTrait. + subject addTraitUser: aTrait. + ! Item was changed: + Error subclass: #TraitCompositionException - TraitException subclass: #TraitCompositionException instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Traits-Composition'! + !TraitCompositionException commentStamp: 'ar 12/29/2009 18:13' prior: 0! + Signals invalid trait compositions.! - !TraitCompositionException commentStamp: '<historical>' prior: 0! - Signal invalid trait compositions.! Item was changed: ----- Method: TraitExclusion>>exclusions: (in category 'accessing') ----- exclusions: aCollection + exclusions := Set withAll: aCollection! - exclusions := aCollection! Item was added: + ----- Method: TraitDescription 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: - ----- Method: TraitMethodDescription class>>new (in category 'instance creation') ----- - new - ^super new - initialize; - yourself! Item was removed: - ----- Method: TraitComposition>>printString (in category 'printing') ----- - printString - ^String streamContents: [:stream | - self printOn: stream]! Item was removed: - ----- Method: TraitComposition>>copy (in category 'copying') ----- - copy - self error: 'should not be called'. - ^super copy - transformations: (self transformations collect: [:each | each copy]); - yourself! Item was removed: - ----- Method: TraitComposition>>asArray (in category 'converting') ----- - asArray - ^self transformations asArray! Item was removed: - ----- Method: TraitComposition>>errorIfNotAddable: (in category 'error-handling') ----- - errorIfNotAddable: aTraitTransformation - (self includesTrait: aTraitTransformation trait) ifTrue: [ - ^TraitCompositionException - signal: 'Trait ' , aTraitTransformation trait asString, ' already in composition']! Item was removed: - ----- Method: TraitAlias>>allAliasesDict (in category 'enquiries') ----- - allAliasesDict - | dict | - dict := super allAliasesDict. - self aliases do: [:assoc | - dict at: assoc key put: assoc value]. - ^dict! Item was removed: - ----- Method: TraitMethodDescription>>size (in category 'accessing') ----- - size - ^self locatedMethods size! Item was removed: - ----- Method: TraitComposition>>methodDescriptionForSelector: (in category 'enquiries') ----- - methodDescriptionForSelector: aSymbol - "Return a TraitMethodDescription for the selector aSymbol." - - | description | - description := TraitMethodDescription selector: aSymbol. - self transformations do: [:each | - each collectMethodsFor: aSymbol into: description]. - ^description! Item was removed: - ----- Method: TraitMethodDescription>>isEmpty (in category 'testing') ----- - isEmpty - ^self size = 0! Item was removed: - ----- Method: TraitTransformation>>allAliasesDict (in category 'enquiries') ----- - allAliasesDict - "Return a dictionary with all alias associations that are defined in this transformation." - - ^self subject allAliasesDict! Item was removed: - ----- Method: TraitComposition>>assertValidUser: (in category 'error-handling') ----- - assertValidUser: aBehavior - "Assert that this trait composition set for aBehavior - does not introduce a cycle." - - (self allTraits includes: aBehavior) ifTrue: [ - TraitCompositionException signal: 'Cycle in compositions: The composition (in)directly includes this trait!!']! Item was removed: - ----- Method: TraitComposition>>includesMethod: (in category 'testing') ----- - includesMethod: aSelector - ^(self methodDescriptionForSelector: aSelector) isEmpty not! Item was removed: - ----- Method: TraitAlias>>allSelectors (in category 'enquiries') ----- - allSelectors - ^self subject allSelectors - addAll: (self aliases collect: [:each | each key]) asSet; - yourself! Item was removed: - ----- Method: TraitExclusion>>isEmpty (in category 'testing') ----- - isEmpty - ^self exclusions isEmpty! Item was removed: - ----- Method: TraitTransformation>>subject (in category 'accessing') ----- - subject - ^subject! Item was removed: - ----- Method: TraitTransformation>>allSelectors (in category 'enquiries') ----- - allSelectors - ^self subclassResponsibility! Item was removed: - ----- Method: TraitExclusion>>addExclusionOf: (in category 'composition') ----- - addExclusionOf: aSymbol - self exclusions: (self exclusions copyWith: aSymbol)! Item was removed: - ----- Method: TraitComposition>>methodDescriptionsForSelector: (in category 'enquiries') ----- - methodDescriptionsForSelector: aSymbol - "Return a collection of TraitMethodDescriptions for aSymbol and all the - aliases of aSymbol." - - | selectors collection | - selectors := IdentitySet with: aSymbol. - self transformations do: [:each | - selectors addAll: (each aliasesForSelector: aSymbol)]. - collection := OrderedCollection new: selectors size. - selectors do: [:each | - collection add: (self methodDescriptionForSelector: each)]. - ^collection! Item was removed: - ----- Method: TraitMethodDescription>>isProvided (in category 'testing') ----- - isProvided - ^ self providedMethod notNil! Item was removed: - ----- Method: TraitComposition>>size (in category 'accessing') ----- - size - ^transformations size! Item was removed: - ----- Method: TraitComposition>>isEmpty (in category 'testing') ----- - isEmpty - ^self transformations isEmpty! Item was removed: - ----- Method: TraitComposition>>transformations (in category 'accessing') ----- - transformations - ^transformations! Item was removed: - ----- Method: TraitMethodDescription>>isLocalAliasSelector (in category 'testing') ----- - isLocalAliasSelector - "Return true if the selector is an alias (if it is different - from the original selector). Return false, if not or if we - have a conflict." - - ^self size = 1 and: [ - (self locatedMethods anyOne selector ~= self selector)]! Item was removed: - ----- Method: TraitMethodDescription>>generateTemplateMethodWithMarker:forArgs:binary: (in category 'private') ----- - generateTemplateMethodWithMarker: aSymbol forArgs: aNumber binary: aBoolean - | source node | - source := String streamContents: [:stream | - aNumber < 1 - ifTrue: [stream nextPutAll: 'selector'] - ifFalse: [aBoolean - ifTrue: [ - stream nextPutAll: '* anObject'] - ifFalse: [ - 1 to: aNumber do: [:argumentNumber | - stream - nextPutAll: 'with:'; space; - nextPutAll: 'arg'; nextPutAll: argumentNumber asString; space]]]. - stream cr; tab; nextPutAll: 'self '; nextPutAll: aSymbol]. - node := self class compilerClass new - compile: source - in: self class - notifying: nil - ifFail: []. - ^node generate.! Item was removed: - ----- Method: TraitTransformation>>theNonMetaClass (in category 'accessing parallel hierarchy') ----- - theNonMetaClass - ^ self subject theNonMetaClass ! Item was removed: - ----- Method: TraitMethodDescription>>effectiveMethodCategoryCurrent:new: (in category 'accessing') ----- - effectiveMethodCategoryCurrent: currentCategoryOrNil new: newCategoryOrNil - | result size isCurrent isConflict | - size := self size. - size = 0 ifTrue: [^ nil]. - result := self locatedMethods anyOne category. - size = 1 ifTrue: [^ result]. - - isCurrent := currentCategoryOrNil isNil. - isConflict := false. - self locatedMethods do: [:each | | cat | - cat := each category. - isCurrent := isCurrent or: [cat == currentCategoryOrNil]. - isConflict := isConflict or: [cat ~~ result]]. - isConflict ifFalse: [^ result]. - (isCurrent not and: [newCategoryOrNil notNil]) ifTrue: [^ newCategoryOrNil]. - ^ ClassOrganizer ambiguous.! Item was removed: - ----- Method: TraitMethodDescription>>isBinarySelector (in category 'testing') ----- - isBinarySelector - ^self locatedMethods anyOne - isBinarySelector! Item was removed: - ----- Method: TraitMethodDescription>>requiredMethodForArguments:ifAbsentPut: (in category 'private') ----- - requiredMethodForArguments: aNumber ifAbsentPut: aBlock - "ConflictMethods is an array that caches the generated conflict - methods. At position 1: binary method; 2: unary method; - n+2: keywordmethod with n arguments." - - ^(RequiredMethods at: aNumber) - ifNil: [ConflictMethods at: aNumber put: aBlock value]! Item was removed: - ----- Method: TraitMethodDescription class>>selector: (in category 'instance creation') ----- - selector: aSymbol - ^self new - selector: aSymbol - yourself! Item was removed: - ----- Method: TraitMethodDescription>>selector (in category 'accessing') ----- - selector - ^selector! Item was removed: - ----- Method: TraitComposition>>addCompositionOnLeft: (in category 'private') ----- - addCompositionOnLeft: aTraitComposition - self transformations do: [ : each | aTraitComposition add: each ]. - ^ aTraitComposition! Item was removed: - ----- Method: TraitAlias>>collectMethodsFor:into: (in category 'enquiries') ----- - collectMethodsFor: aSelector into: methodDescription - | originalSelector association | - self subject - collectMethodsFor: aSelector - into: methodDescription. - association := self aliasNamed: aSelector ifAbsent: [nil]. - association notNil ifTrue: [ - originalSelector := association value. - self subject - collectMethodsFor: originalSelector - into: methodDescription]! Item was removed: - ----- Method: TraitAlias>>copy (in category 'copying') ----- - copy - ^super copy - aliases: self aliases copy; - yourself! Item was removed: - ----- Method: TraitComposition>>remove: (in category 'accessing') ----- - remove: aTransformation - self transformations - remove: aTransformation! Item was removed: - ----- Method: TraitComposition>>notEmpty (in category 'testing') ----- - notEmpty - ^self isEmpty not! Item was removed: - ----- Method: TraitExclusion>>allSelectors (in category 'enquiries') ----- - allSelectors - | selectors | - selectors := self subject allSelectors. - self exclusions do: [:each | - selectors remove: each ifAbsent: []]. - ^selectors! Item was removed: - ----- Method: TraitAlias>>removeAlias: (in category 'composition') ----- - removeAlias: aSymbol - self aliases: (self aliases - reject: [:each | each key = aSymbol])! Item was removed: - ----- Method: TraitComposition>>copyWithoutAlias:of: (in category 'copying') ----- - copyWithoutAlias: aSymbol of: aTrait - | composition transformation | - composition := self copyTraitExpression. - transformation := (composition transformationOfTrait: aTrait). - ^composition - remove: transformation; - add: (transformation removeAlias: aSymbol); - normalizeTransformations; - yourself! Item was removed: - ----- Method: TraitAlias>>aliasNamed:ifAbsent: (in category 'enumeration') ----- - aliasNamed: aSymbol ifAbsent: aBlock - ^self aliases - detect: [:association | association key = aSymbol] - ifNone: aBlock! Item was removed: - ----- Method: TraitTransformation>>removeAlias: (in category 'composition') ----- - removeAlias: aSymbol - self subject removeAlias: aSymbol! Item was removed: - ----- Method: TraitComposition>>copyWithExclusionOf:to: (in category 'copying') ----- - copyWithExclusionOf: aSymbol to: aTrait - | composition transformation | - composition := self copyTraitExpression. - transformation := (composition transformationOfTrait: aTrait). - ^composition - remove: transformation; - add: (transformation addExclusionOf: aSymbol); - yourself! Item was removed: - ----- Method: TraitMethodDescription>>isRequired (in category 'testing') ----- - isRequired - self isEmpty ifTrue: [^ false]. - ^ self locatedMethods allSatisfy: [:each | each method isRequired]! Item was removed: - ----- Method: TraitComposition>>transformationOfTrait: (in category 'accessing') ----- - transformationOfTrait: aTrait - "Return the transformation which holds aTrait - or nil if this composition doesn't include aTrait." - - ^self transformations - detect: [:each | each trait = aTrait] - ifNone: [nil]! Item was removed: - ----- Method: TraitMethodDescription>>effectiveMethodCategory (in category 'accessing') ----- - effectiveMethodCategory - ^ self effectiveMethodCategoryCurrent: nil new: nil! Item was removed: - ----- Method: TraitMethodDescription class>>maxArguments (in category 'private') ----- - maxArguments - ^30! Item was removed: - ----- Method: TraitComposition>>normalizeTransformations (in category 'composition') ----- - normalizeTransformations - self transformations: ( - self transformations collect: [:each | - each normalized])! Item was removed: - ----- Method: TraitTransformation>>isMeta (in category 'accessing parallel hierarchy') ----- - isMeta - ^self subject isMeta! Item was removed: - ----- Method: TraitAlias>>isEmpty (in category 'testing') ----- - isEmpty - ^self aliases isEmpty! Item was removed: - ----- Method: TraitComposition>>changedSelectorsComparedTo: (in category 'enquiries') ----- - changedSelectorsComparedTo: oldComposition - | changedSelectors traits | - changedSelectors := IdentitySet new. - traits := self traits asIdentitySet addAll: oldComposition traits asIdentitySet; yourself. - traits do: [:each | | oldTransformation newTransformation | - newTransformation := self transformationOfTrait: each. - oldTransformation := oldComposition transformationOfTrait: each. - (newTransformation isNil or: [oldTransformation isNil]) - ifTrue: [ - changedSelectors addAll: each selectors] - ifFalse: [ - changedSelectors addAll: - (newTransformation changedSelectorsComparedTo: oldTransformation)]]. - ^changedSelectors! Item was removed: - ----- Method: TraitMethodDescription class>>initialize (in category 'class initialization') ----- - initialize - " self initialize " - ConflictMethods := Array new: self maxArguments + 2. - RequiredMethods := Array new: self maxArguments + 2.! Item was removed: - ----- Method: TraitMethodDescription>>methodsDo: (in category 'enumeration') ----- - methodsDo: aBlock - self locatedMethods do: [:each | - aBlock value: each method]! Item was removed: - ----- Method: TraitMethodDescription>>getArgumentNames (in category 'private') ----- - getArgumentNames - | argumentNamesCollection names defaultName | - defaultName := 'arg'. - argumentNamesCollection := self locatedMethods - collect: [:each | each argumentNames ]. - names := Array new: argumentNamesCollection anyOne size. - argumentNamesCollection do: [:collection | - 1 to: names size do: [:index | - (names at: index) isNil - ifTrue: [names at: index put: (collection at: index)] - ifFalse: [(names at: index) ~= (collection at: index) - ifTrue: [names at: index put: defaultName, index asString]]]]. - ^names - ! Item was removed: - ----- Method: TraitComposition>>addOnTheLeft: (in category 'composition') ----- - addOnTheLeft: aTrait - self errorIfNotAddable: aTrait. - self transformations addFirst: aTrait! Item was removed: - ----- Method: TraitMethodDescription>>conflictMethodForArguments:ifAbsentPut: (in category 'private') ----- - conflictMethodForArguments: aNumber ifAbsentPut: aBlock - "ConflictMethods is an array that caches the generated conflict - methods. At position 1: binary method; 2: unary method; - n+2: keywordmethod with n arguments." - - ^(ConflictMethods at: aNumber) - ifNil: [ConflictMethods at: aNumber put: aBlock value]! Item was removed: - ----- Method: TraitExclusion>>methodReferencesInCategory: (in category 'accessing') ----- - methodReferencesInCategory: aCategoryName - ^(self organization listAtCategoryNamed: aCategoryName) - collect: [:ea | MethodReference new - setClassSymbol: self theNonMetaClass name - classIsMeta: self isMeta - methodSymbol: ea - stringVersion: ''] - ! Item was removed: - ----- Method: TraitMethodDescription>>isConflict (in category 'testing') ----- - isConflict - | count | - count := 0. - self methodsDo: [:each | - each isProvided ifTrue: [ - count := count + 1. - count > 1 ifTrue: [^true]]]. - ^false! Item was removed: - ----- Method: TraitAlias>>aliasesForSelector: (in category 'enquiries') ----- - aliasesForSelector: aSymbol - | selectors | - selectors := self aliases - select: [:association | association value = aSymbol] - thenCollect: [:association | association key]. - ^(super aliasesForSelector: aSymbol) - addAll: selectors; - yourself - ! Item was removed: - ----- Method: TraitTransformation>>normalized (in category 'accessing') ----- - normalized - ^self isEmpty - ifFalse: [ - self subject: self subject normalized. - self] - ifTrue: [self subject normalized] - - ! Item was removed: - ----- Method: TraitMethodDescription>>selector: (in category 'accessing') ----- - selector: aSymbol - selector := aSymbol! Item was removed: - ----- Method: TraitTransformation>>aliasesForSelector: (in category 'enquiries') ----- - aliasesForSelector: aSymbol - "Return a collection of alias selectors that are defined in this transformation." - - ^self subject aliasesForSelector: aSymbol! Item was removed: - Object subclass: #TraitMethodDescription - instanceVariableNames: 'selector locatedMethods' - classVariableNames: 'ConflictMethods RequiredMethods' - poolDictionaries: '' - category: 'Traits-Composition'! - - !TraitMethodDescription commentStamp: '<historical>' prior: 0! - Used by TraitComposition to encapsulates a collection of methods for one particular selector when querying for changes. According to the number and kind of those methods a provided method exists, there is a conflict or there are no provided nor conflicting methods at all. I provide the interface to query for those situations, e.g., effectiveMethod returns the provided method or the conflict marker method. - ! Item was removed: - ----- Method: TraitTransformation>>collectMethodsFor:into: (in category 'enquiries') ----- - collectMethodsFor: aSelector into: methodDescription - "Collect instances of LocatedMethod into methodDescription - for each method that has the selector aSelector and is not excluded - or for which aSelector is an alias." - - self subclassResponsibility! Item was removed: - ----- Method: TraitTransformation>>copy (in category 'copying') ----- - copy - self error: 'should not be called'. - ^super copy - subject: self subject copy; - yourself! Item was removed: - ----- Method: TraitTransformation>>sourceCodeTemplate (in category 'browser support') ----- - sourceCodeTemplate - ^ self subject sourceCodeTemplate! Item was removed: - ----- Method: TraitMethodDescription>>conflictMethod (in category 'accessing') ----- - conflictMethod - | templateMethod argumentNames binary numberOfArguments | - self isConflict ifFalse: [^nil]. - argumentNames := self getArgumentNames. - binary := self isBinarySelector. - numberOfArguments := binary - ifTrue: [1] - ifFalse: [argumentNames size + 2]. - templateMethod := self conflictMethodForArguments: numberOfArguments ifAbsentPut: [ - self - generateTemplateMethodWithMarker: CompiledMethod conflictMarker - forArgs: argumentNames size - binary: binary]. - ^templateMethod copyWithTempNames: argumentNames - - - ! Item was removed: - ----- Method: TraitComposition>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - transformations := OrderedCollection new! Item was removed: - ----- Method: TraitComposition>>add: (in category 'accessing') ----- - add: aTraitTransformation - self errorIfNotAddable: aTraitTransformation. - self transformations addLast: aTraitTransformation! Item was removed: - Error subclass: #TraitException - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Traits-Kernel'! - - !TraitException commentStamp: '<historical>' prior: 0! - General exception used for example to signal invalid trait compositions! Item was removed: - ----- Method: TraitMethodDescription>>effectiveMethod (in category 'accessing') ----- - effectiveMethod - "Return the effective compiled method of this method description." - - | locatedMethod method | - method := self providedMethod. - method isNil ifFalse: [^ method]. - method := self conflictMethod. - method isNil ifFalse: [^ method]. - ^ self requiredMethod.! Item was removed: - ----- Method: TraitComposition class>>with:with: (in category 'instance creation') ----- - with: aTraitTransformation with: anotherTraitTransformation - ^self new - add: aTraitTransformation; - add: anotherTraitTransformation; - yourself! Item was removed: - ----- Method: TraitMethodDescription>>addLocatedMethod: (in category 'accessing') ----- - addLocatedMethod: aLocatedMethod - locatedMethods add: aLocatedMethod! Item was removed: - ----- Method: TraitTransformation>>printOn: (in category 'printing') ----- - printOn: aStream - aStream print: self subject! Item was removed: - ----- 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 removed: - ----- Method: TraitTransformation>>changedSelectorsComparedTo: (in category 'enquiries') ----- - changedSelectorsComparedTo: aTraitTransformation - | selectors otherSelectors changedSelectors aliases otherAliases | - selectors := self allSelectors asIdentitySet. - otherSelectors := aTraitTransformation allSelectors asIdentitySet. - changedSelectors := IdentitySet withAll: ( - (selectors difference: otherSelectors) union: (otherSelectors difference: selectors)). - aliases := self allAliasesDict. - otherAliases := aTraitTransformation allAliasesDict. - aliases keysAndValuesDo: [:key :value | - (value ~~ (otherAliases at: key ifAbsent: [nil])) ifTrue: [changedSelectors add: key]]. - otherAliases keysAndValuesDo: [:key :value | - (value ~~ (aliases at: key ifAbsent: [nil])) ifTrue: [changedSelectors add: key]]. - ^ changedSelectors.! Item was removed: - ----- Method: TraitTransformation>>isEmpty (in category 'testing') ----- - isEmpty - self subclassResponsibility! Item was removed: - ----- Method: TraitTransformation>>selectors (in category 'enquiries') ----- - selectors - ^self allSelectors! Item was removed: - ----- Method: TraitMethodDescription>>isAliasSelector (in category 'testing') ----- - isAliasSelector - "Return true if the selector is an alias (if it is different - from the original selector) or already an aliased method - in the original location (recursively search the compositions). - Return false, if not or if we have a conflict." - - | locatedMethod | - ^self size = 1 and: [ - locatedMethod := self locatedMethods anyOne. - (locatedMethod selector ~= self selector) or: [ - locatedMethod location isAliasSelector: self selector]]! Item was removed: - ----- Method: TraitTransformation>>addExclusionOf: (in category 'composition') ----- - addExclusionOf: aSymbol - ^self - {aSymbol}! Item was removed: - ----- Method: TraitMethodDescription>>requiredMethod (in category 'accessing') ----- - requiredMethod - | templateMethod argumentNames numberOfArguments binary | - self isRequired ifFalse: [^nil]. - self size = 1 ifTrue: [^self locatedMethods anyOne method]. - - argumentNames := self getArgumentNames. - binary := self isBinarySelector. - numberOfArguments := binary - ifTrue: [1] - ifFalse: [argumentNames size + 2]. - templateMethod := self requiredMethodForArguments: numberOfArguments ifAbsentPut: [ - self - generateTemplateMethodWithMarker: CompiledMethod implicitRequirementMarker - forArgs: argumentNames size - binary: binary]. - ^templateMethod copyWithTempNames: argumentNames - - - ! Item was removed: - ----- Method: TraitMethodDescription>>locatedMethods (in category 'accessing') ----- - locatedMethods - ^locatedMethods! Item was removed: - ----- Method: TraitMethodDescription>>providedLocatedMethod (in category 'accessing') ----- - providedLocatedMethod - | locatedMethod | - locatedMethod := nil. - self locatedMethods do: [:each | - each method isProvided ifTrue: [ - locatedMethod isNil ifFalse: [^nil]. - locatedMethod := each]]. - ^locatedMethod! Item was removed: - ----- Method: TraitComposition class>>with: (in category 'instance creation') ----- - with: aTraitTransformation - ^self new - add: aTraitTransformation; - yourself! Item was removed: - ----- Method: TraitExclusion>>collectMethodsFor:into: (in category 'enquiries') ----- - collectMethodsFor: aSelector into: methodDescription - (self exclusions includes: aSelector) ifFalse: [ - self subject - collectMethodsFor: aSelector - into: methodDescription]! Item was removed: - ----- Method: TraitMethodDescription>>providedMethod (in category 'accessing') ----- - providedMethod - ^self providedLocatedMethod ifNotNil: [:locatedMethod | locatedMethod method]! Item was removed: - ----- Method: TraitExclusion>>copy (in category 'copying') ----- - copy - ^super copy - exclusions: self exclusions copy; - yourself! Item was removed: - ----- Method: TraitMethodDescription>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - locatedMethods := Set new! Item was removed: - ----- Method: TraitTransformation>>traitTransformations (in category 'enquiries') ----- - traitTransformations - ^ { subject }! Item was removed: - ----- Method: TraitComposition>>transformations: (in category 'private') ----- - transformations: aCollection - transformations := aCollection! |
Free forum by Nabble | Edit this page |