[squeak-dev] The Trunk: Traits-ar.253.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Dec 31 13:03:23 UTC 2009


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

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

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

Install NanoTraits.

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

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

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

Item was added:
+ ----- Method: Metaclass>>updateTraitsFrom: (in category '*Traits-NanoKernel') -----
+ updateTraitsFrom: instanceTraits
+ 	"Update me from the given instance traits"
+ 	| map newTraits trait |
+ 	((instanceTraits isKindOf: NanoTraitComposition) or:[instanceTraits isEmpty]) 
+ 		ifFalse:[self error: 'Invalid trait'].
+ 
+ 	map := Dictionary new.
+ 	self traitComposition isEmpty ifFalse:[
+ 		self traitComposition do:[:composed| map at: composed trait put: composed].
+ 	].
+ 
+ 	newTraits := (instanceTraits collect:[:composed|
+ 		trait := composed trait classTrait.
+ 		map at: trait ifAbsent:[trait]]).
+ 
+ 	self traitComposition isEmpty ifFalse:[
+ 		newTraits := newTraits, (self traitComposition select:[:comp| comp trait isBaseTrait]).
+ 	].
+ 	self installTraitsFrom: newTraits!

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

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

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

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

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

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

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

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

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

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

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

Item was added:
+ ----- Method: NanoTraitComposition>>@ (in category 'converting') -----
+ @ anArrayOfAssociations
+ 	"the modifier operators #@ and #- bind stronger than +.
+ 	Thus, #@ or #- sent to a sum will only affect the most right summand"
+ 
+ 	self addLast: (self removeLast @ anArrayOfAssociations)!

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Item was added:
+ ----- Method: ClassDescription>>isAliasSelector: (in category '*Traits-NanoKernel') -----
+ isAliasSelector: aSymbol
+ 	"Return true if the selector aSymbol is an alias defined
+ 	in my or in another composition somewhere deeper in 
+ 	the tree of traits compositions."
+ 
+ 	^(self includesLocalSelector: aSymbol) not
+ 		and: [self hasTraitComposition]
+ 		and: [self traitComposition isAliasSelector: aSymbol]!

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

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

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

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

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

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

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

Item was added:
+ ----- Method: ClassDescription>>isLocalAliasSelector: (in category '*Traits-NanoKernel') -----
+ isLocalAliasSelector: aSymbol
+ 	"Return true if the selector aSymbol is an alias defined
+ 	in my or in another composition somewhere deeper in 
+ 	the tree of traits compositions."
+ 
+ 	^(self includesLocalSelector: aSymbol) not
+ 		and: [self hasTraitComposition]
+ 		and: [self traitComposition isLocalAliasSelector: aSymbol]!

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

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

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

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

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

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

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

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

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

Item was added:
+ ----- Method: ClassDescription>>installTraitsFrom: (in category '*Traits-NanoKernel') -----
+ installTraitsFrom: aTraitComposition
+ 	"Install the traits from the given composition"
+ 	| allTraits methods oldMethod removals oldCategories |
+ 	(aTraitComposition isKindOf: NanoTraitComposition) 
+ 		ifFalse:[self error: 'Invalid composition'].
+ 	(self traitComposition isEmpty and: [aTraitComposition isEmpty]) ifTrue: [^self].
+ 
+ 	"Check for cycles"
+ 	allTraits := aTraitComposition gather: [:t | t allTraits copyWith: t].
+ 	(allTraits includes: self) ifTrue:[^self error: 'Cyclic trait definition detected'].
+ 
+ 	"XXXX: addUser/removeUser should be part of setter, but subclass 
+ 	override prevents it until we've got rid of Traits mess."
+ 	self traitComposition removeTraitUser: self.
+ 	self traitComposition: aTraitComposition.
+ 	aTraitComposition addTraitUser: self.
+ 
+ 	"Assemble the methods in a new dictionary first.
+ 	Uses a Dictionary instead of a MethodDictionary for speed (MDs grow by #become:)"
+ 	methods := Dictionary new.
+ 
+ 	"Stick in the local methods first, since this avoids generating conflict methods unnecessarily"
+ 	self selectorsAndMethodsDo:[:sel :newMethod|
+ 		(self isLocalMethod: newMethod)
+ 			ifTrue:[methods at: sel put:newMethod]].
+ 
+ 	"Now assemble the traits methods"
+ 	aTraitComposition do:[:trait|
+ 		trait selectorsAndMethodsDo:[:sel :newMethod|
+ 			oldMethod := methods at: sel ifAbsentPut:[newMethod].
+ 			newMethod == oldMethod ifFalse:["a conflict"
+ 				(self isLocalMethod: oldMethod) ifFalse:[
+ 					methods at: sel put: (self resolveTraitsConflict: sel from: oldMethod to: newMethod).
+ 				].
+ 			].
+ 		].
+ 	].
+ 
+ 	"Apply the changes. We first add the new or changed methods."
+ 	oldCategories := Set new.
+ 	methods keysAndValuesDo:[:sel :newMethod|
+ 		oldMethod := self compiledMethodAt: sel ifAbsent:[nil].
+ 		oldMethod == newMethod ifFalse:[
+ 			self traitAddSelector: sel withMethod: newMethod.
+ 			(self organization categoryOfElement: sel) ifNotNil:[:cat| oldCategories add: cat].
+ 			self organization classify: sel under: 
+ 				(newMethod methodHome organization categoryOfElement: newMethod selector).
+ 		]].
+ 
+ 	"Now remove the old or obsoleted ones"
+ 	removals := OrderedCollection new.
+ 	self selectorsDo:[:sel| (methods includesKey: sel) ifFalse:[removals add: sel]].
+ 	removals do:[:sel| self traitRemoveSelector: sel].
+ 
+ 	"Clean out empty categories"
+ 	oldCategories do:[:cat|
+ 		(self organization isEmptyCategoryNamed: cat)
+ 			ifTrue:[self organization removeCategory: cat]].
+ 
+ 	self isMeta ifFalse:[self class updateTraitsFrom: aTraitComposition].!

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

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

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

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

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

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

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

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

Item was added:
+ ----- Method: NanoTraitAlias class>>assertValidAliasDefinition: (in category 'instance creation') -----
+ assertValidAliasDefinition: anArrayOfAssociations
+ 	"Throw an exceptions if the alias definition is not valid.
+ 	It is expected to be a collection of associations and
+ 	the number of arguments of the alias selector has to
+ 	be the same as the original selector."
+ 
+ 	((anArrayOfAssociations isKindOf: Collection) and: [
+ 		anArrayOfAssociations allSatisfy: [:each |
+ 			each isKindOf: Association]]) ifFalse: [
+ 		self error: 'Invalid alias definition: Not a collection of associations.'].
+ 	
+ 	(anArrayOfAssociations allSatisfy: [:association |
+ 		(association key numArgs = association value numArgs and: [
+ 			(association key numArgs = -1) not])]) ifFalse: [
+ 		NanoTraitCompositionException signal: 'Invalid alias definition: Alias and original selector have to have the same number of arguments.']!

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

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

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

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

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

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

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

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

Item was added:
+ ----- Method: NanoTrait>>category (in category 'accessing') -----
+ category
+ 	"Answer the system organization category for the receiver. First check whether the
+ 	category name stored in the ivar is still correct and only if this fails look it up
+ 	(latter is much more expensive)"
+ 
+ 	| result |
+ 	category ifNotNilDo: [ :symbol |
+ 		((SystemOrganization listAtCategoryNamed: symbol) includes: self name)
+ 			ifTrue: [ ^symbol ] ].
+ 	category := (result := SystemOrganization categoryOfElement: self name).
+ 	^result!

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Item was added:
+ ----- Method: NanoTrait>>rename: (in category 'initialize') -----
+ rename: aString 
+ 	"The new name of the receiver is the argument, aString."
+ 
+ 	| newName |
+ 	(newName := aString asSymbol) ~= self name
+ 		ifFalse: [^ self].
+ 	(self environment includesKey: newName)
+ 		ifTrue: [^ self error: newName , ' already exists'].
+ 	(Undeclared includesKey: newName)
+ 		ifTrue: [self inform: 'There are references to, ' , aString printString , '
+ from Undeclared. Check them after this change.'].
+ 	self environment renameClass: self as: newName.
+ 	name := newName!

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

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

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

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

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

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

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

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

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

Item was added:
+ ----- Method: NanoTrait class>>named:uses:category:env: (in category 'instance creation') -----
+ named: aSymbol uses: aTraitComposition category: aString env: anEnvironment
+ 	| trait oldTrait systemCategory oldCategory |
+ 	systemCategory := aString asSymbol.
+ 	oldTrait := anEnvironment at: aSymbol ifAbsent: [nil].
+ 	oldTrait ifNil:[
+ 		trait := NanoClassTrait new new.
+ 	] ifNotNil:[
+ 		oldCategory := oldTrait category.
+ 		trait := oldTrait.
+ 	].
+ 	(trait isKindOf: NanoTrait) ifFalse: [
+ 		^self error: trait name , ' is not a Trait'].
+ 	trait
+ 		setName: aSymbol
+ 		andRegisterInCategory: systemCategory
+ 		environment: anEnvironment.
+ 
+ 	trait uses: aTraitComposition.
+ 	
+ 	"... notify interested clients ..."
+ 	oldTrait ifNil:[
+ 		SystemChangeNotifier uniqueInstance classAdded: trait inCategory: systemCategory.
+ 	] ifNotNil:[
+ 		systemCategory = oldCategory  ifFalse:[
+ 			SystemChangeNotifier uniqueInstance class: trait 
+ 				recategorizedFrom: oldTrait category to: systemCategory].
+ 	].
+ 	^ trait!

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

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

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

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

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

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

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

Item was added:
+ ----- Method: NanoClassTrait>>uses: (in category 'initialize') -----
+ uses: aTraitComposition
+ 	| newTraits |
+ 	newTraits := (aTraitComposition isTrait or:[aTraitComposition isTraitTransformation]) 
+ 		ifTrue:[NanoTraitComposition with: aTraitComposition]
+ 		ifFalse:[(aTraitComposition isKindOf: SequenceableCollection)
+ 					ifTrue:[NanoTraitComposition withAll: aTraitComposition asArray]
+ 					ifFalse:[self error: 'Invalid traits specification']].
+ 	newTraits traitsDo:[:t|
+ 		(t isBaseTrait and:[t classSide hasMethods]) 
+ 			ifTrue:[self error: 'Cannot add: ', t].
+ 		(t isClassTrait and:[(baseTrait includesTrait: t baseTrait) not]) 
+ 			ifTrue:[self error: 'Cannot add: ', t].
+ 	].
+ 	self installTraitsFrom: newTraits.!

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Item was added:
+ ----- Method: NanoTrait>>setName:andRegisterInCategory:environment: (in category 'initialize') -----
+ setName: aSymbol andRegisterInCategory: categorySymbol environment: aSystemDictionary
+ 	(self isValidTraitName: aSymbol) ifFalse: [self error:'Invalid trait name'].
+ 
+ 	(self environment == aSystemDictionary
+ 		and: [self name = aSymbol
+ 			and: [self category = categorySymbol]]) ifTrue: [^self].
+ 		
+ 	((aSystemDictionary includes: aSymbol) and: [(aSystemDictionary at: aSymbol) ~~ self])
+ 		ifTrue: [self error: 'The name ''' , aSymbol , ''' is already used'].
+ 
+ 	(self environment notNil and: [self name notNil and: [self name ~= aSymbol]]) ifTrue: [
+ 		self environment renameClass: self as: aSymbol].
+ 	
+ 	self name: aSymbol.
+ 	self environment: aSystemDictionary.	
+ 	self environment at: self name put: self.
+ 	self environment organization classify: self name under: categorySymbol.
+ 	^ true!

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

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

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

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

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

Item was added:
+ ----- Method: NanoTrait>>category: (in category 'accessing') -----
+ category: aString 
+ 	"Categorize the receiver under the system category, aString, removing it from 
+ 	any previous categorization."
+ 
+ 	| oldCategory |
+ 	oldCategory := category.
+ 	aString isString
+ 		ifTrue: [
+ 			category := aString asSymbol.
+ 			SystemOrganization classify: self name under: category ]
+ 		ifFalse: [self errorCategoryName].
+ 	SystemChangeNotifier uniqueInstance
+ 		class: self recategorizedFrom: oldCategory to: category!

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

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

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

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

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

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

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

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

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

Item was added:
+ ----- Method: NanoTraitComposition>>- (in category 'converting') -----
+ - anArray
+ 	"the modifier operators #@ and #- bind stronger than +.
+ 	Thus, #@ or #- sent to a sum will only affect the most right summand"
+ 	
+ 	self addLast: (self removeLast - anArray)!

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

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

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

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

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

Item was added:
+ ----- Method: NanoClassTrait>>updateTraitsFrom: (in category 'initialize') -----
+ updateTraitsFrom: instanceTraits
+ 	"Update me from the given instance traits"
+ 	| map newTraits trait |
+ 	map := Dictionary new.
+ 	self traitComposition do:[:composed| map at: composed trait put: composed].
+ 	newTraits := (instanceTraits collect:[:composed|
+ 		trait := composed trait classTrait.
+ 		map at: trait ifAbsent:[trait]] 
+ 	), (self traitComposition select:[:comp| comp trait isBaseTrait]).
+ 
+ 	self installTraitsFrom: newTraits!

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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




More information about the Squeak-dev mailing list