'From Pharo3.0 of 18 March 2013 [Latest update: #30258] on 9 July 2013 at 5:48:50 pm'!

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
ultimateSourceCodeAt: selector ifAbsent: aBlock
	"Return the source code at selector, deferring to superclass if necessary"
	^ self sourceCodeAt: selector ifAbsent:
		[self superclass
			ifNil:
				[aBlock value]
			 ifNotNil:
				[self superclass ultimateSourceCodeAt: selector ifAbsent: aBlock]]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
compiledMethodAt: selector ifAbsent: aBlock
	"Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, return the value of aBlock"

	^ self methodDict at: selector ifAbsent: [aBlock value]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
allMethods
	"Return the collection of compiled method I and my superclasses are defining"
	"asArray is used to not bump into a bug when comparing compiled methods."
	
	^ self allSelectors asArray collect: [ :s | self lookupSelector: s ]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
deregisterLocalSelector: aSymbol
	self basicLocalSelectors notNil ifTrue: [
		self basicLocalSelectors remove: aSymbol ifAbsent: []]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
selectors
	"Answer a Set of all the message selectors specified in the receiver's 
	method dictionary."

	^ self methodDict keys! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
compress
	"Compact the method dictionary of the receiver."

	self methodDict rehash! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
methodDictionary
	"Convenience"
	^self methodDict! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSelectorsAboveUntil: aRootClass

	| coll |
	coll := IdentitySet new.
	(self allSuperclassesIncluding: aRootClass) 
		do: [:aClass | 
				aClass selectorsDo: [ :sel | coll add: sel ]].
	^ coll
	

! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
sourceCodeAt: selector

	^ (self methodDict at: selector) sourceCode.! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSelectorsBelow: topClass 
	| coll |
	coll := IdentitySet new.
	self withAllSuperclassesDo: 
			[:aClass | 
			aClass = topClass
				ifTrue: [^ coll ]
				ifFalse: [aClass selectorsDo: [ :sel | coll add: sel ]]].
	^ coll
	

! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
registerLocalSelector: aSymbol
	self basicLocalSelectors notNil ifTrue: [
		self basicLocalSelectors add: aSymbol]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
lookupSelector: selector
	"Look up the given selector in my methodDictionary.
	Return the corresponding method if found.
	Otherwise chase the superclass chain and try again.
	Return nil if no method is found."
	| lookupClass |
	lookupClass := self.
	[lookupClass == nil]
		whileFalse: 
			[(lookupClass includesSelector: selector)
				ifTrue: [^ lookupClass compiledMethodAt: selector].
			lookupClass := lookupClass superclass].
	^ nil! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
nextQuotePosIn: sourceString startingFrom: commentStart
	| pos nextQuotePos |
	pos := commentStart + 1.
	[((nextQuotePos := sourceString findString: '"' startingAt: pos) == (sourceString findString: '""' startingAt: pos)) and: [nextQuotePos ~= 0]]
		whileTrue:
			[pos := nextQuotePos + 2].
	^nextQuotePos! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSelectorsAbove

	^ self allSelectorsAboveUntil: ProtoObject 
	

! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
methodDictionary: aDictionary
	self methodDict: aDictionary! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
selectorsWithArgs: numberOfArgs
	"Return all selectors defined in this class that take this number of arguments"

	^ self selectors select: [:selector | selector numArgs = numberOfArgs]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
supermostPrecodeCommentFor: selector 
	"Answer a string representing the precode comment in the most distant 
	superclass's implementation of the selector. Return nil if none found."
	| aSuper superComment |
	(self == Behavior
			or: [self superclass == nil
					or: [(aSuper := self superclass whichClassIncludesSelector: selector) == nil]])
		ifFalse: ["There is a super implementor"
			superComment := aSuper supermostPrecodeCommentFor: selector].
	^ superComment
		ifNil: [self firstPrecodeCommentFor: selector
			"ActorState supermostPrecodeCommentFor: #printOn:"]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
changeRecordsAt: selector
	"Return a list of ChangeRecords for all versions of the method at selector. Source code can be retrieved by sending string to any one.  Return nil if the method is absent."

	"(Pen changeRecordsAt: #go:) collect: [:cRec | cRec string]"
	^ChangeSet 
		scanVersionsOf: (self compiledMethodAt: selector ifAbsent: [^ nil])
		class: self meta: self isMeta
		category: (self whichCategoryIncludesSelector: selector)
		selector: selector.! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
>> selector 
	"Answer the compiled method associated with the argument, selector (a 
	Symbol), a message selector in the receiver's method dictionary. If the 
	selector is not in the dictionary, create an error notification."

	^self compiledMethodAt: selector
! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
zapAllMethods
	"Remove all methods in this class which is assumed to be obsolete"

	self methodDict: self emptyMethodDictionary.
	self class isMeta ifTrue: [self class zapAllMethods]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSelectorsWithout: behaviors
      "Returns all the selectors of the receiver and its superclasses, except the ones define in behaviors"
	| selectors |
	selectors := IdentitySet new.
	self withAllSuperclassesDo: [:class | (behaviors includes: class)
											ifFalse: [selectors addAll: class selectors.]].
	^ selectors asOrderedCollection ! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
methods
	
	^ self methodDict values! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
firstCommentAt:  selector
	"Answer a string representing the first comment in the method associated with selector.  Return an empty string if the relevant source file is not available, or if the method's source code does not contain a comment.  Not smart enough to bypass quotes in string constants, but does map doubled quote into a single quote."

	|someComments|
	someComments := self commentsAt: selector.
	^someComments isEmpty ifTrue: [''] ifFalse: [someComments first]


"Behavior firstCommentAt: #firstCommentAt:"! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
selectorsAndMethodsDo: selectorAndMethodBlock
	"Evaluate selectorAndMethodBlock with two arguments for each selector/method pair in my method dictionary."

	^ self methodDict keysAndValuesDo: selectorAndMethodBlock! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
sourceCodeAt: selector ifAbsent: aBlock

	^ (self methodDict at: selector ifAbsent: [^ aBlock value]) sourceCode.! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
compiledMethodAt: selector 
	"Answer the compiled method associated with the argument, selector (a 
	Symbol), a message selector in the receiver's method dictionary. If the 
	selector is not in the dictionary, create an error notification."

	^ self methodDict at: selector! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
classAndMethodFor: aSymbol do: binaryBlock ifAbsent: absentBlock
	"Looks up the selector aSymbol in the class chain. If it is found, binaryBlock is evaluated
	with the class that defines the selector and the associated method. Otherwise
	absentBlock is evaluated."

	
	self withAllSuperclassesDo: [:class | | method |
		method := class compiledMethodAt: aSymbol ifAbsent: [nil].
		method ifNotNil: [^ binaryBlock value: class value: method].
	].
	^ absentBlock value.! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
firstPrecodeCommentFor:  selector
	"If there is a comment in the source code at the given selector that preceeds the body of the method, return it here, else return nil"

	| method |
	"Behavior firstPrecodeCommentFor: #firstPrecodeCommentFor:"
	(#(Comment Definition Hierarchy) includes: selector)
		ifTrue: [^ nil].
	method := self compiledMethodAt: selector asSymbol ifAbsent: [^ nil].
	^method ast firstPrecodeComment.
	! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
commentsAt:  selector
	"Answer a string representing the first comment in the method associated with selector.  Return an empty string if the relevant source file is not available, or if the method's source code does not contain a comment.  Not smart enough to bypass quotes in string constants, but does map doubled quote into a single quote."


	^self commentsIn:  (self sourceCodeAt: selector) asString.
	
"Behavior commentsAt: #commentsAt:"! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
precodeCommentOrInheritedCommentFor: selector 
	"Answer a string representing the first comment in the method associated 
	with selector, considering however only comments that occur before the 
	beginning of the actual code. If the version recorded in the receiver is 
	uncommented, look up the inheritance chain. Return nil if none found."
	
	| aSuper aComment |
	^ (aComment := self firstPrecodeCommentFor: selector) isEmptyOrNil
		ifTrue: [(self == Behavior
					or: [self superclass == nil
							or: [(aSuper := self superclass whichClassIncludesSelector: selector) == nil]])
				ifFalse: [aSuper precodeCommentOrInheritedCommentFor: selector]]
		ifFalse: [aComment]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
commentsIn: sourceString

	
	| commentStart nextQuotePos someComments aPos |
	('*"*' match: sourceString) ifFalse: [^#()].
	someComments:= OrderedCollection new.
	sourceString size = 0 ifTrue: [^ someComments].
	aPos:=1.
	nextQuotePos:= 0.
	[commentStart := sourceString findString: '"' startingAt: aPos.
	nextQuotePos:= self nextQuotePosIn: sourceString startingFrom: commentStart.
	(commentStart ~= 0 and: [nextQuotePos >commentStart])] whileTrue: [
		commentStart ~= nextQuotePos ifTrue: [
			someComments add: ((sourceString copyFrom: commentStart + 1 to: nextQuotePos - 1) copyReplaceAll: '""' with: '"').].
	aPos := nextQuotePos+1].
	^someComments! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
methodsDo: aBlock
	"Evaluate aBlock for all the compiled methods in my method dictionary."

	^ self methodDict valuesDo: aBlock! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
selectorsDo: selectorBlock
	"Evaluate selectorBlock for all the message selectors in my method dictionary."

	^ self methodDict keysDo: selectorBlock! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSelectors
	"Answer all selectors understood by instances of the receiver"

	^ self allSelectorsBelow: nil! !

!TraitBehavior methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/9/2013 17:48'!
initialize
	"moved here from the class side's #new"
	super initialize.
	self superclass: Object.
	"no longer sending any messages, some of them crash the VM"
	self methodDict: self emptyMethodDictionary.
	self setFormat: Object format.
	self traitComposition: nil.
	self users: IdentitySet new.! !

!TraitBehavior methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/9/2013 17:48'!
nonObsoleteClass
	"Attempt to find and return the current version of this obsolete class"

	| obsName |
	obsName := self name.
	[obsName beginsWith: 'AnObsolete']
		whileTrue: [obsName := obsName copyFrom: 'AnObsolete' size + 1 to: obsName size].
	^ self environment at: obsName asSymbol! !

!TraitBehavior methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/9/2013 17:48'!
superclass: aClass methodDictionary: mDict format: fmt
	"Basic initialization of the receiver.
	Must only be sent to a new instance; else we would need Object flushCache."
	self superclass: aClass.
	self setFormat: fmt.
	self methodDict: mDict.
	self traitComposition: nil! !

!TraitBehavior methodsFor: 'obsolete subclasses' stamp: 'SebastianTleye 7/9/2013 17:48'!
allLocalCallsOn: aSymbol
	"Answer a SortedCollection of all the methods that call on aSymbol, anywhere in my class hierarchy."

	^(SystemNavigation new allLocalCallsOn: aSymbol ofClass: (self theNonMetaClass)).
! !

!TraitBehavior methodsFor: 'obsolete subclasses' stamp: 'SebastianTleye 7/9/2013 17:48'!
addObsoleteSubclass: aClass
	"Weakly remember that aClass was a subclass of the receiver and is now obsolete"
	| obs |

	obs := self basicObsoleteSubclasses at: self ifAbsent:[WeakArray new].
	(obs includes: aClass) ifTrue:[^self].
	obs := obs copyWithout: nil.
	obs := obs copyWith: aClass.
	self basicObsoleteSubclasses at: self put: obs.! !

!TraitBehavior methodsFor: 'obsolete subclasses' stamp: 'SebastianTleye 7/9/2013 17:48'!
removeAllObsoleteSubclasses
	"Remove all the obsolete subclasses of the receiver"
	self basicObsoleteSubclasses removeKey: self ifAbsent: [].
! !

!TraitBehavior methodsFor: 'obsolete subclasses' stamp: 'SebastianTleye 7/9/2013 17:48'!
removeObsoleteSubclass: aClass
	"Remove aClass from the weakly remembered obsolete subclasses"
	| obs |
	obs := self basicObsoleteSubclasses at: self ifAbsent:[^ self].
	(obs includes: aClass) ifFalse:[^self].
	obs := obs copyWithout: aClass.
	obs := obs copyWithout: nil.
	self basicObsoleteSubclasses at: self put: obs! !

!TraitBehavior methodsFor: 'obsolete subclasses' stamp: 'SebastianTleye 7/9/2013 17:48'!
obsoleteSubclasses
	"Return all the weakly remembered obsolete subclasses of the receiver"
	| obs |
	obs := self basicObsoleteSubclasses at: self ifAbsent: [^ #()].
	^ obs copyWithout: nil! !

!TraitBehavior methodsFor: '*NativeBoost-Core' stamp: 'SebastianTleye 7/9/2013 17:48'!
nbBindingOf: aName
	"answer a binding for a type name,
	by default use smalltalk name bindings"
	^ self bindingOf: aName! !

!TraitBehavior methodsFor: '*NativeBoost-Core' stamp: 'SebastianTleye 7/9/2013 17:48'!
externalTypeAlias: aTypeName
	"override, if you want to introduce type aliases.
	Answering nil means no type alias for given type name exists"
	^ nil! !

!TraitBehavior methodsFor: '*NativeBoost-Core' stamp: 'SebastianTleye 7/9/2013 17:48'!
nbFnArgument: argName generator: gen

	"Load the instance variable with given name" 

	(self allInstVarNames includes: argName) ifFalse: [ ^ nil ].
	^ NBSTIvarArgument new receiverClass: self; ivarName: argName! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
someInstance
	"Primitive. Answer the first instance in the enumeration of all instances 
	of the receiver. Fails if there are none. Essential. See Object 
	documentation whatIsAPrimitive."

	<primitive: 77>
	^nil! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
includesSharedPoolNamed:  aSharedPoolString 
	"Answer whether the receiver uses the shared pool named aSharedPoolString"
	
	^ (self sharedPools anySatisfy: [:each | each name = aSharedPoolString])! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
allClassVarNames
	"Answer a Set of the names of the receiver's and the receiver's ancestor's 
	class variables."

	^self superclass allClassVarNames! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
classVarNames
	"Answer a collection of the receiver's class variable names."

	^#()! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
instVarNames
	"Answer an Array of the instance variable names. Behaviors must make 
	up fake local instance variable names because Behaviors have instance 
	variables for the purpose of compiling methods, but these are not named 
	instance variables."

	| mySize superSize |
	mySize := self instSize.
	superSize := 
		self superclass == nil
			ifTrue: [0]
			ifFalse: [self superclass instSize].
	mySize = superSize ifTrue: [^#()].	
	^(superSize + 1 to: mySize) collect: [:i | 'inst' , i printString]! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
instanceCount
	"Answer the number of instances of the receiver that are currently in 
	use."

	| count |
	count := 0.
	self allInstancesDo: [:x | count := count + 1].
	^count! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSharedPools
	"Answer an ordered collection of the shared pools that the receiver and the receiver's ancestors share."

	^self superclass allSharedPools! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
allowsSubInstVars
	"Classes that allow instances to change classes among its subclasses will want to override this and return false, so inst vars are not accidentally added to its subclasses."

	^ true! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSubInstances 
	"Answer a list of all current instances of the receiver and all of its subclasses."
	| aCollection |
	aCollection := OrderedCollection new.
	self allSubInstancesDo:
		[:x | x == aCollection ifFalse: [aCollection add: x]].
	^ aCollection! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
allInstances
	"Answer a collection of all current instances of the receiver."

	| all inst next |
	all := OrderedCollection new.
	inst := self someInstance.
	[inst == nil]
		whileFalse: [
		next := inst nextInstance.
		inst == all ifFalse: [all add: inst].
		inst := next].
	^ all asArray! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
sharedPools
	"Answer an ordered collection of  the shared pools that the receiver shares"

	^ OrderedCollection new! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
subclassInstVarNames
	"Answer a Set of the names of the receiver's subclasses' instance 
	variables."
	| vars |
	vars := Set new.
	self allSubclasses do: [:aSubclass | vars addAll: aSubclass instVarNames].
	^vars! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
allInstVarNames
	"Answer an Array of the names of the receiver's instance variables. The 
	Array ordering is the order in which the variables are stored and 
	accessed by the interpreter."

	| vars |
	self superclass == nil
		ifTrue: [vars := self instVarNames copy]	"Guarantee a copy is answered."
		ifFalse: [vars := self superclass allInstVarNames , self instVarNames].
	^vars! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
decompilerClass
	self deprecated: 'use #compilerClass' on: '02 May 2013' in: 'Pharo 3.0'.
	^ self compilerClass! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
binding
	^ nil -> self! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
parserClass
	self deprecated: 'use #compilerClass' on: '29 April 2013' in: 'Pharo 3.0'.
	^self compilerClass! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
compile: code 
	"Compile the argument, code, as source code in the context of the 
	receiver. Create an error notification if the code can not be compiled. 
	The argument is either a string or an object that converts to a string or a 
	PositionableStream on an object that converts to a string."

	^self compile: code notifying: nil! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
compile: code classified: category notifying: requestor trailer: bytes ifFail: aBlock
	"Compile code without logging the source in the changes file"

	| methodNode |
	methodNode := self compiler
		compile: code
		in: self
		classified: category
		notifying: requestor
		ifFail: aBlock.
	^ methodNode generate: bytes! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
compiler
	"Answer a compiler appropriate for source methods of this class."

	^self compilerClass new
		environment: self environment;
		class: self! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
defaultMethodTrailer
	^ CompiledMethodTrailer empty! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
evaluatorClass
	"Answer an evaluator class appropriate for evaluating expressions in the 
	context of this class."
	self deprecated: 'use #compilerClass' on: '02 May 2013' in: 'Pharo 3.0'.
	^self compilerClass! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
compile: code notifying: requestor 
	"Compile the argument, code, as source code in the context of the 
	receiver and insEtall the result in the receiver's method dictionary. The 
	second argument, requestor, is to be notified if an error occurs. The 
	argument code is either a string or an object that converts to a string or 
	a PositionableStream. This method also saves the source code."
	
	| method |
	method  := self
		compile: code "a Text"
		classified: nil
		notifying: requestor
		trailer: self defaultMethodTrailer
		ifFail: [ ^nil ].
		
	method putSource: code inFile: 2
			withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Behavior method'; cr].
	self addSelector: method selector withMethod: method notifying: requestor.
	^ method selector! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
compileAll
	^ self compileAllFrom: self! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
evaluate: aString
	^self compiler evaluate: aString! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
compileAllFrom: oldClass
	"Compile all the methods in the receiver's method dictionary.
	This validates sourceCode and variable references and forces
	all methods to use the current bytecode set"
	
	oldClass selectorsDo: [:sel | self recompile: sel from: oldClass].
	! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
compilerClass
	"Answer a compiler class appropriate for source methods of this class."

	^Smalltalk compilerClass! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
recompileChanges
	"Compile all the methods that are in the changes file.
	This validates sourceCode and variable references and forces
	methods to use the current bytecode set"

	self selectorsAndMethodsDo:
		[:sel :meth | meth fileIndex > 1 ifTrue:
			[self recompile: sel from: self]]! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
sourceCodeTemplate
	"Answer an expression to be edited and evaluated in order to define 
	methods in this class or trait."

	^'message selector and argument names
	"comment stating purpose of message"

	| temporary variable names |
	statements'! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
recompile: selector
	"Compile the method associated with selector in the receiver's method dictionary."
	^self recompile: selector from: self! !

!TraitBehavior methodsFor: 'memory usage' stamp: 'SebastianTleye 7/9/2013 17:48'!
instancesSizeInMemory
	"Answers the number of bytes consumed by all its instances including their object header"
	
	| bytes |
	bytes := 0.
	self allInstancesDo: [:each | bytes := bytes + each sizeInMemory  ].
	^ bytes! !

!TraitBehavior methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
protocols
	
	^ self organization categories copy! !

!TraitBehavior methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
methodNamed: aSelector

	^ self methodDict at: aSelector! !

!TraitBehavior methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
methodsInProtocol: aString

	^ (self organization listAtCategoryNamed: aString) 
			collect: [:each | (self methodDict at: each) ]! !

!TraitBehavior methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 17:48'!
instVarNamesAndOffsetsDo: aBinaryBlock
	"This is part of the interface between the compiler and a class's instance or field names.
	 The class should enumerate aBinaryBlock with the instance variable name strings and
	 their integer offsets.  The order is important. Names evaluated later will override the
	 same names occurring earlier."

	"Nothing to do here; ClassDescription introduces named instance variables"
	^self! !

!TraitBehavior methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 17:48'!
variablesAndOffsetsDo: aBinaryBlock
	"This is the interface between the compiler and a class's instance or field names.  The
	 class should enumerate aBinaryBlock with the field definitions (with nil offsets) followed
	 by the instance variable name strings and their integer offsets (1-relative).  The order is
	 important; names evaluated later will override the same names occurring earlier."

	"Only need to do instance variables here.  CProtoObject introduces field definitions."
	self instVarNamesAndOffsetsDo: aBinaryBlock! !

!TraitBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/9/2013 17:48'!
new: sizeRequested 
	"Answer an initialized instance of this class with the number of indexable
	variables specified by the argument, sizeRequested."

	^ (self basicNew: sizeRequested) initialize  ! !

!TraitBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/9/2013 17:48'!
basicNew: sizeRequested 
	"Primitive. Answer an instance of this class with the number
	of indexable variables specified by the argument, sizeRequested.
	Fail if this class is not indexable or if the argument is not a
	positive Integer, or if there is not enough memory available. 
	Essential. See Object documentation whatIsAPrimitive."

	<primitive: 71>
	self isVariable ifFalse:
		[self error: self printString, ' cannot have variable sized instances'].
	(sizeRequested isInteger and: [sizeRequested >= 0]) ifTrue:
		["arg okay; space must be low."
		OutOfMemory signal.
		^ self basicNew: sizeRequested  "retry if user proceeds"].
	self primitiveFailed! !

!TraitBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/9/2013 17:48'!
basicNew
	"Primitive. Answer an instance of the receiver (which is a class) with no 
	indexable variables. Fail if the class is indexable. Essential. See Object 
	documentation whatIsAPrimitive."

	<primitive: 70>
	self isVariable ifTrue: [ ^ self basicNew: 0 ].
	"space must be low"
	OutOfMemory signal.
	^ self basicNew  "retry if user proceeds"
! !

!TraitBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/9/2013 17:48'!
new
	"Answer a new initialized instance of the receiver (which is a class) with no indexable variables. Fail if the class is indexable."

	^ self basicNew initialize
! !

!TraitBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:48'!
printHierarchy
	"Answer a description containing the names and instance variable names 
	of all of the subclasses and superclasses of the receiver."

	| aStream index |
	index := 0.
	aStream := (String new: 16) writeStream.
	self allSuperclasses reverseDo: 
		[:aClass | 
		aStream crtab: index.
		index := index + 1.
		aStream nextPutAll: aClass name.
		aStream space.
		aStream print: aClass instVarNames].
	aStream cr.
	self printSubclassesOn: aStream level: index.
	^aStream contents! !

!TraitBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:48'!
literalScannedAs: scannedLiteral notifying: requestor
	"Postprocesses a literal scanned by Scanner scanToken (esp. xLitQuote).
	If scannedLiteral is not an association, answer it.
	Else, if it is of the form:
		nil->#NameOfMetaclass
	answer nil->theMetaclass, if any has that name, else report an error.
	Else, if it is of the form:
		#NameOfGlobalVariable->anythiEng
	answer the global, class, or pool association with that nameE, if any, else
	add it to Undeclared a answer the new Association."

	| key value |
	(scannedLiteral isVariableBinding)
		ifFalse: [^ scannedLiteral].
	key := scannedLiteral key.
	value := scannedLiteral value.
	key isNil 
		ifTrue: "###<metaclass soleInstance name>"
			[(self bindingOf: value) ifNotNil:[:assoc|
				 (assoc value isKindOf: Behavior)
					ifTrue: [^ nil->assoc value class]].
			 requestor notify: 'No such metaclass'.
			 ^false].
	(key isSymbol)
		ifTrue: "##<global var name>"
			[(self bindingOf: key) ifNotNil:[:assoc | ^assoc].
			Undeclared at: key put: nil.
			 ^Undeclared bindingOf: key].
	requestor notify: '## must be followed by a non-local variable name'.
	^false

"	Form literalScannedAs: 14 notifying: nil 14
	Form literalScannedAs: #OneBitForm notiEfying: nil  OneBitForm
	Form literalScannedAs: ##OneBitForm notifying: nil  OneBitForm->a Form
	Form literalScannedAs: ##Form notifying: nil   Form->Form
	Form literalScannedAs: ###Form notifying: nil   nilE->Form class
"! !

!TraitBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:48'!
storeLiteral: aCodeLiteral on: aStream
	"Store aCodeLiteral on aStream, changing an Association to ##GlobalName
	 or ###MetaclassSoleInstanceName format if appropriate"
	| key value |
	(aCodeLiteral isVariableBinding)
		ifFalse:
			[aCodeLiteral storeOn: aStream.
			 ^self].
	key := aCodeLiteral key.
	(key isNil and: [(value := aCodeLiteral value) isMemberOf: Metaclass])
		ifTrue:
			[aStream nextPutAll: '###'; nextPutAll: value soleInstance name.
			 ^self].
	(key isSymbol and: [(self bindingOf: key) notNil])
		ifTrue:
			[aStream nextPutAll: '##'; nextPutAll: key.
			 ^self].
	aCodeLiteral storeOn: aStream! !

!TraitBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:48'!
longPrintOn: aStream
	"Append to the argument, aStream, the names and values of all of the receiver's instance variables.  But, not useful for a class with a method dictionary."

	aStream nextPutAll: '<<too complex to show>>'; cr.! !

!TraitBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:48'!
printOn: aStream 
	"Refer to the comment in Object|printOn:." 

	aStream nextPutAll: 'a descendent of '.
	self superclass printOn: aStream! !

!TraitBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isComposedBy: aTrait
	"Answers if this object includes trait aTrait into its composition"
	aTrait isTrait ifFalse: [ ^false].
	^self hasTraitComposition 
		ifTrue: [ self traitComposition includesTrait: aTrait ]
		ifFalse: [ false ]! !

!TraitBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/9/2013 17:48'!
poolDictionaryNames
	^ self sharedPools collect: [:ea | self environment keyAtIdentityValue: ea]! !

!TraitBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/9/2013 17:48'!
classDepth

	self superclass ifNil: [^ 1].
	^ self superclass classDepth + 1! !

!TraitBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/9/2013 17:48'!
typeOfClass
	"Answer a symbol uniquely describing the type of the receiver"
	self instSpec = CompiledMethod instSpec ifTrue:[^#compiledMethod]. "Very special!!"
	self isBytes ifTrue:[^#bytes].
	(self isWords and:[self isPointers not]) ifTrue:[^#words].
	self isWeak ifTrue:[^#weak].
	self isVariable ifTrue:[^#variable].
	^#normal.! !

!TraitBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/9/2013 17:48'!
numberOfInstanceVariables
	^ self instVarNames size
! !

!TraitBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/9/2013 17:48'!
classPool
	^ Dictionary new! !

!TraitBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:48'!
spaceUsed
	"Answer a rough estimate of number of bytes used by this class and its metaclass. Does not include space used by class variables."

	| space |
	space := 0.
	self methodsDo: [:method  |
		space := space + 16.  "dict and org'n space"
		space := space + (method size + 6 "hdr + avg pad").
		method literalsDo: [:lit |
			(lit isMemberOf: Array) ifTrue: [space := space + ((lit size + 1) * 4)].
			(lit isMemberOf: Float) ifTrue: [space := space + 12].
			(lit isMemberOf: ByteString) ifTrue: [space := space + (lit size + 6)].
			(lit isMemberOf: LargeNegativeInteger) ifTrue: [space := space + ((lit size + 1) * 4)].
			(lit isMemberOf: LargePositiveInteger) ifTrue: [space := space + ((lit size + 1) * 4)]]].
		^ space! !

!TraitBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:48'!
becomeCompactSimplyAt: index
	"Make me compact, but don't update the instances.  For importing segments."
"Here are the restrictions on compact classes in order for export segments to work:  A compact class index may not be reused.  If a class was compact in a release of Pharo, no other class may use that index.  The class might not be compact later, and there should be nil in its place in the array."

	| cct |
	self isWeak ifTrue: [^ Halt halt: 'You must not make a weak class compact'].
	cct := Smalltalk compactClassesArray.
	(self isCompact or: [cct includes: self])
		ifTrue: [^ self halt: self name , 'is already compact'].
	(cct at: index) ifNotNil: [^ self halt: 'compact table slot already in use'].
	"Install this class in the compact class table"
	cct at: index put: self.
	"Update instspec so future instances will be compact"
	self setFormat: self format + (index bitShift: 11).
	"Caller must convert the instances"
! !

!TraitBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:48'!
checkCanBeUncompact 
	"Certain classes cannot be uncompacted in CogVM.  If you download VMMaker and see the VM code, these are as defined by StackInterpreter>>#checkAssumedCompactClasses and the ones that can't be uncompacted are the following: "
	({ Array. LargeNegativeInteger. LargePositiveInteger. Float. MethodContext } includes: self)
		 ifTrue: [ self error: 'Class ', self name, ' cannot be uncompact. ' ]
! !

!TraitBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:48'!
becomeCompact
	"Here are the restrictions on compact classes in order for export segments to work:  A compact class index may not be reused.  If a class was compact in a release of Pharo, no other class may use that index.  The class might not be compact later, and there should be nil in its place in the array."
	| cct index |

	self isWeak ifTrue: [^ Halt halt: 'You must not make a weak class compact'].
	cct := Smalltalk compactClassesArray.
	(self isCompact or: [cct includes: self])
		ifTrue: [^ self halt: self name , 'is already compact'].
	index := cct indexOf: nil
		ifAbsent: [^ self halt: 'compact class table is full'].
	"Install this class in the compact class table"
	cct at: index put: self.
	"Update instspec so future instances will be compact"
	self setFormat: self format + (index bitShift: 11).
	"Make up new instances and become old ones into them"
	self updateInstancesFrom: self.
	"Purge any old instances"
	Smalltalk garbageCollect.! !

!TraitBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:48'!
flushCache
	"Tell the interpreter to remove the contents of its method lookup cache, if it has 
	one.  Essential.  See Object documentation whatIsAPrimitive."

	<primitive: 89>
	self primitiveFailed! !

!TraitBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:48'!
becomeUncompact
	| cct index |
	cct := Smalltalk compactClassesArray.
	(index := self indexIfCompact) = 0
		ifTrue: [^ self].
	(cct includes: self)
		ifFalse: [^ self halt  "inconsistent state"].
	self checkCanBeUncompact. 
	"Update instspec so future instances will not be compact"
	self setFormat: self format - (index bitShift: 11).
	"Make up new instances and become old ones into them"
	self updateInstancesFrom: self.
	"Make sure there are no compact ones left around"
	Smalltalk garbageCollect.
	"Remove this class from the compact class table"
	cct at: index put: nil.
! !

!TraitBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:48'!
indexIfCompact
	"If these 5 bits are non-zero, then instances of this class
	will be compact.  It is crucial that there be an entry in
	Smalltalk compactClassesArray for any class so optimized.
	See the msgs becomeCompact and becomeUncompact."
	^ (self format bitShift: -11) bitAnd: 16r1F


"
Array indexIfCompact

Verify if the compactClassesArray and indexIfCompact are coheren
Smalltalk compactClassesArray doWithIndex: 
	[:c :i | c == nil ifFalse:
		[c indexIfCompact = i ifFalse: [self halt]]]
"! !

!TraitBehavior methodsFor: 'testing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
kindOfSubclass
	"Answer a String that is the keyword that describes the receiver's kind 
	of subclass, either a regular subclass, a variableSubclass, a  
	variableByteSubclass, a variableWordSubclass, or a weakSubclass."
	self isWeak
		ifTrue: [^ ' weakSubclass: '].
	^ self isVariable
		ifTrue: [self isBits
				ifTrue: [self isBytes
						ifTrue: [ ' variableByteSubclass: ']
						ifFalse: [ ' variableWordSubclass: ']]
				ifFalse: [ ' variableSubclass: ']]
		ifFalse: [ ' subclass: ']! !

!TraitBehavior methodsFor: 'testing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
inheritsFrom: aClass 
	"Answer whether the argument, aClass, is on the receiver's superclass 
	chain."

	| aSuperclass |
	aSuperclass := self superclass.
	[aSuperclass == nil]
		whileFalse: 
			[aSuperclass == aClass ifTrue: [^true].
			aSuperclass := aSuperclass superclass].
	^false! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
selectSuperclasses: aBlock 
	"Evaluate the argument, aBlock, with the receiver's superclasses as the 
	argument. Collect into an OrderedCollection only those superclasses for 
	which aBlock evaluates to true. In addition, evaluate aBlock for the 
	superclasses of each of these successful superclasses and collect into the 
	OrderedCollection ones for which aBlock evaluates to true. Answer the 
	resulting OrderedCollection."

	| aSet |
	aSet := Set new.
	self allSuperclasses do: 
		[:aSuperclass | 
		(aBlock value: aSuperclass) ifTrue: [aSet add: aSuperclass]].
	^aSet! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
subclassesDo: aBlock
	"Evaluate the argument, aBlock, for each of the receiver's immediate subclasses."
	self subclasses do: aBlock! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
selectSubclasses: aBlock 
	"Evaluate the argument, aBlock, with each of the receiver's (next level) 
	subclasses as its argument. Collect into a Set only those subclasses for 
	which aBlock evaluates to true. In addition, evaluate aBlock for the 
	subclasses of each of these successful subclasses and collect into the set 
	those for which aBlock evaluates true. Answer the resulting set."

	| aSet |
	aSet := Set new.
	self allSubclasses do: 
		[:aSubclass | 
		(aBlock value: aSubclass) ifTrue: [aSet add: aSubclass]].
	^aSet! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
withAllSuperclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's superclasses."
	aBlock value: self.
	self superclass == nil
		ifFalse: [self superclass withAllSuperclassesDo: aBlock]! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSubclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's subclasses."

	self subclassesDo: 
		[:cl | 
		aBlock value: cl.
		cl allSubclassesDo: aBlock]! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
withAllSuperAndSubclassesDo: aBlock
	self allSuperclassesDo: aBlock.
	aBlock value: self.
	self allSubclassesDo: aBlock! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSubInstancesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the current instances of the 
	receiver and all its subclasses."

	self allInstancesDo: aBlock.
	self allSubclassesDo: [:sub | sub allInstancesDo: aBlock]! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
allUnreferencedInstanceVariables
	"Return a list of the instance variables known to the receiver which are not referenced in the receiver or any of its subclasses OR superclasses"

	^ self allInstVarNames reject: [:ivn |
		| definingClass |		
		definingClass := self classThatDefinesInstanceVariable: ivn.
		definingClass withAllSubclasses anySatisfy: [:class |  
				(class whichSelectorsAccess: ivn asSymbol) notEmpty]]! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSuperclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's superclasses."

	self superclass == nil
		ifFalse: [aBlock value: self superclass.
				self superclass allSuperclassesDo: aBlock]! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
allInstancesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the current instances of the 
	receiver.
	
	Because aBlock might change the class of inst (for example, using become:),
	it is essential to compute next before aBlock value: inst."
	| inst next |
	inst := self someInstance.
	[inst == nil]
		whileFalse:
		[
		next := inst nextInstance.
		aBlock value: inst.
		inst := next]! !

!TraitBehavior methodsFor: '*Tools-Inspector' stamp: 'SebastianTleye 7/9/2013 17:48'!
inspectAllInstances 
	"Inspect all instances of the receiver."

	| all allSize prefix |
	all := self allInstances.
	(allSize := all size) isZero ifTrue: [^ self inform: 'There are no 
instances of ', self name].
	prefix := allSize = 1
		ifTrue: 	['The lone instance']
		ifFalse:	['The ', allSize printString, ' instances'].
	
	all asArray inspectWithLabel: (prefix, ' of ', self name)! !

!TraitBehavior methodsFor: '*Tools-Inspector' stamp: 'SebastianTleye 7/9/2013 17:48'!
inspectSubInstances 
	"Inspect all instances of the receiver and all its subclasses.  CAUTION - don't do this for something as generic as Object!!"

	| all allSize prefix |
	all := self allSubInstances.
	(allSize := all size) isZero ifTrue: [^ self inform: 'There are no 
instances of ', self name, '
or any of its subclasses'].
	prefix := allSize = 1
		ifTrue: 	['The lone instance']
		ifFalse:	['The ', allSize printString, ' instances'].
	
	all asArray inspectWithLabel: (prefix, ' of ', self name, ' & its subclasses')! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
thoroughHasSelectorReferringTo: literal special: specialFlag byte: specialByte
	"Answer true if any of my methods access the argument as a 
	literal. Dives into the compact literal notation, making it slow but 
	thorough "

	
	self methodsDo: [ :method |
		((method hasLiteralThorough: literal) or: [specialFlag and: [method scanFor: specialByte]])
			ifTrue: [^true]].
	^false! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
isLocalAliasSelector: aSymbol
	"Return true if the selector aSymbol is an alias defined
	in my trait composition."

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

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
classBindingOf: varName
	"Answer the binding of some variable resolved in the scope of the receiver's class"
	^self bindingOf: varName! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichSelectorsReferTo: literal special: specialFlag byte: specialByte
	"Answer a set of selectors whose methods access the argument as a literal."

	| who |
	who := IdentitySet new.
	self selectorsAndMethodsDo: 
		[:sel :method |
		((method hasLiteral: literal) or: [specialFlag and: [method scanFor: specialByte]])
			ifTrue:
				[((literal isVariableBinding) not
					or: [method literals allButLast includes: literal])
						ifTrue: [who add: sel]]].
	^ who! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
isDisabledSelector: selector
	^ self classAndMethodFor: selector do: [:c :m | m isDisabled] ifAbsent: [false]! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
hasMethods
	"Answer whether the receiver has any methods in its method dictionary."

	^ self methodDict notEmpty! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
canUnderstand: selector
	"Answer whether the receiver can respond to the message whose selector 
	is the argument."

	^ self classAndMethodFor: selector do: [:c :m | m isProvided] ifAbsent: [false].! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
thoroughWhichSelectorsReferTo: literal special: specialFlag byte: specialByte
	"Answer a set of selectors whose methods access the argument as a 
	literal. Dives into the compact literal notation, making it slow but 
	thorough "
	| selectors |
	selectors := IdentitySet new.
	self selectorsAndMethodsDo: 
		[ :sel :method |
			((self isTrait ifTrue: [method hasLiteralThorough: literal]
				     		 ifFalse: [method refersToLiteral: literal]) or: [specialFlag and: [method scanFor: specialByte]]) ifTrue: [selectors add: sel]].
	^ selectors! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
includesLocalSelector: aSymbol
	^self basicLocalSelectors isNil
		ifTrue: [self includesSelector: aSymbol]
		ifFalse: [self localSelectors includes: aSymbol]! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichClassIncludesSelector: aSymbol 
	"Answer the class on the receiver's superclass chain where the 
	argument, aSymbol (a message selector), will be found. Answer nil if none found."
	"Rectangle whichClassIncludesSelector: #inspect."
	(self includesSelector: aSymbol)
		ifTrue: [^ self].
	self superclass == nil
		ifTrue: [^ nil].
	^ self superclass whichClassIncludesSelector: aSymbol! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
canPerform: selector
	"Answer whether the receiver can safely perform to the message whose selector 
	is the argument: it is not an abstract or cancelled method"

	^ self classAndMethodFor: selector do: [:c :m | m isProvided] ifAbsent: [false].! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichSelectorsReferTo: literal 
	"Answer a Set of selectors whose methods access the argument as a
literal."

	| special byte |
	special := Smalltalk hasSpecialSelector: literal ifTrueSetByte: [:b |
byte := b].
	^self whichSelectorsReferTo: literal special: special byte: byte

	"Rectangle whichSelectorsReferTo: #+."! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichSelectorsAccess: instVarName 
	"Answer a set of selectors whose methods access the argument, 
	instVarName, as a named instance variable."

	| instVarIndex |
	instVarIndex := self instVarIndexFor: instVarName ifAbsent: [^IdentitySet new].
	^ self selectors select:  [:sel | 
		((self methodDict at: sel)
			readsField: instVarIndex)
			or: [(self methodDict at: sel) writesField: instVarIndex]]

	"Point whichSelectorsAccess: 'x'."! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichSelectorsStoreInto: instVarName 
	"Answer a Set of selectors whose methods access the argument, 
	instVarName, as a named instance variable."
	| instVarIndex |
	instVarIndex := self instVarIndexFor: instVarName ifAbsent: [^IdentitySet new].
	^ self selectors select: [:sel | (self methodDict at: sel) writesField: instVarIndex]

	"Point whichSelectorsStoreInto: 'x'."! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
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]]! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
includesSelector: aSymbol 
	"Answer whether the message whose selector is the argument is in the 
	method dictionary of the receiver's class."

	^ self methodDict includesKey: aSymbol! !

!TraitBehavior methodsFor: 'naming' stamp: 'SebastianTleye 7/9/2013 17:48'!
environment
	"Return the environment in which the receiver is visible"
	^Smalltalk globals! !

!TraitBehavior methodsFor: '*System-Support' stamp: 'SebastianTleye 7/9/2013 17:48'!
allCallsOn: aSymbol
	"Answer a SortedCollection of all the methods that call on aSymbol."

	^ self  systemNavigation allCallsOn: aSymbol from: self .
	! !

!TraitBehavior methodsFor: '*System-Support' stamp: 'SebastianTleye 7/9/2013 17:48'!
allUnsentMessages
	"Answer an array of all the messages defined by the receiver that are not sent anywhere in the system."

	^ SystemNavigation new allUnsentMessagesIn: self selectors! !

!TraitBehavior methodsFor: '*System-Support' stamp: 'SebastianTleye 7/9/2013 17:48'!
allCallsOn
	"Answer a SortedCollection of all the methods that refer to me by name or as part of an association in a global dict."
	
	^ (self allCallsOnIn: self systemNavigation)! !

!TraitBehavior methodsFor: '*System-Support' stamp: 'SebastianTleye 7/9/2013 17:48'!
referencedClasses
	"Return the set of classes that are directly referenced by my methods"

	| answer |
	answer := Set new.
	self methods do: [ :cm |
		answer addAll: 
			( cm literals select: [ :l | l isKindOf: Association ] thenCollect: #value ) ].
		
	^ answer! !

!TraitBehavior methodsFor: '*System-Support' stamp: 'SebastianTleye 7/9/2013 17:48'!
allCallsOnIn: aSystemNavigation
	"Answer a SortedCollection of all the methods that refer to me by name or as part of an association in a global dict."

	^ (aSystemNavigation 
		allReferencesTo: (self environment associationAt: self theNonMetaClass name)), 
		(aSystemNavigation allCallsOn: self theNonMetaClass name)	! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSubclasses
	"Answer an orderedCollection of the receiver's and the receiver's descendent's subclasses. "

	| scan scanTop |
	scan := OrderedCollection withAll: self subclasses.
	scanTop := 1.
	[scanTop > scan size]
		whileFalse: [scan addAll: (scan at: scanTop) subclasses.
			scanTop := scanTop + 1].
	^ scan! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
withAllSubclasses
	"Answer a Set of the receiver, the receiver's descendent's, and the  
	receiver's descendent's subclasses."

	^ self allSubclasses add: self;
		 yourself! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
withAllSuperclasses
	"Answer an OrderedCollection of the receiver and the receiver's 
	superclasses. The first element is the receiver, 
	followed by its superclass; the last element is Object."

	| temp |
	temp := self allSuperclasses.
	temp addFirst: self.
	^ temp! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSuperclassesIncluding: aClass
	"Answer an OrderedCollection of the receiver's and the receiver's  ancestor's superclasses
	up to aClass included. If aClass is not part of the receiver's superclass, returns up to the root."
	| temp |
	self class == ProtoObject class ifTrue: [ ^ OrderedCollection new].
	^ self superclass == aClass
		ifTrue: [ OrderedCollection with: aClass]
		ifFalse: [temp := self superclass allSuperclassesIncluding: aClass.
			temp addFirst: self superclass.
			temp]! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
withAllSubclassesDo: aBlock
	"Evaluate the argument, aBlock, for the receiver and each of its 
	subclasses."
	self withAllSubclasses do: [ :subclass | aBlock value: subclass ].! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSubclassesWithLevelDo: classAndLevelBlock startingLevel: level 
	"Walk the tree of subclasses, giving the class and its level"
	| subclassNames |
	classAndLevelBlock value: self value: level.
	self == Class ifTrue:  [^ self].  "Don't visit all the metaclasses"
	"Visit subclasses in alphabetical order"
	subclassNames := SortedCollection new.
	self subclassesDo: [:subC | subclassNames add: subC name].
	subclassNames do:
		[:name | (self environment at: name)
			allSubclassesWithLevelDo: classAndLevelBlock
			startingLevel: level+1]! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSuperclasses
	"Answer an OrderedCollection of the receiver's and the receiver's  
	ancestor's superclasses. The first element is the receiver's immediate  
	superclass, followed by its superclass; the last element is Object."
	| temp |
	^ self superclass == nil
		ifTrue: [ OrderedCollection new]
		ifFalse: [temp := self superclass allSuperclasses.
			temp addFirst: self superclass.
			temp]! !

!TraitBehavior methodsFor: '*Rpackage-Core' stamp: 'SebastianTleye 7/9/2013 17:48'!
originalName
	^self isObsolete 
		ifTrue: [ (self name copyFrom:   'AnObsolete' size + 1 to: self name size ) asSymbol ]
		ifFalse:  [  self name asSymbol ].! !

!TraitBehavior methodsFor: '*Manifest-Core' stamp: 'SebastianTleye 7/9/2013 17:48'!
isManifest

	^ self name beginsWith: 'Manifest'! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
adoptInstance: anInstance
	"Change the class of anInstance to me.
	Primitive (found in Cog and new VMs)  follows the same rules as primitiveChangeClassTo:, but returns the 	class rather than the modified instance"
	<primitive: 160 error: ec>
	anInstance primitiveChangeClassTo: self basicNew.
	^self! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
localSelectors
	"Return a set of selectors defined locally.
	The instance variable is lazily initialized. If it is nil then there
	are no non-local selectors"

	^ self basicLocalSelectors isNil
		ifTrue: [self selectors asSet]
		ifFalse: [self basicLocalSelectors].! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
basicRemoveSelector: selector 
	"Assuming that the argument, selector (a Symbol), is a message selector 
	in my method dictionary, remove it and its method."

	| oldMethod |
	oldMethod := self methodDict at: selector ifAbsent: [^ self].
	self methodDict removeKey: selector.

	"Now flush the method cache"
	oldMethod flushCache.
	selector flushCache.! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
addSelector: selector withMethod: compiledMethod notifying: requestor
	^ self addSelectorSilently: selector withMethod: compiledMethod! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
methodDictAddSelectorSilently: selector withMethod: compiledMethod
	self basicAddSelector: selector withMethod: compiledMethod! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
basicAddSelector: selector withMethod: compiledMethod 
	"Add the message selector with the corresponding compiled method to the 
	receiver's method dictionary.
	Do this without sending system change notifications"

	| oldMethodOrNil |	
	oldMethodOrNil := self lookupSelector: selector.
	self methodDict at: selector put: compiledMethod.
	compiledMethod methodClass: self.
	compiledMethod selector: selector.

	"Now flush Pharo's method cache, either by selector or by method"
	oldMethodOrNil ifNotNil: [oldMethodOrNil flushCache].
	selector flushCache.! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
addSelector: selector withMethod: compiledMethod 
	^ self addSelector: selector withMethod: compiledMethod notifying: nil! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
localSelectors: aSet 
	self basicLocalSelectors: aSet.! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
removeSelectorSilently: selector 
	"Remove selector without sending system change notifications"

	^ SystemAnnouncer uniqueInstance suspendAllWhile: [self removeSelector: selector].! !

!TraitBehavior methodsFor: 'system startup' stamp: 'SebastianTleye 7/9/2013 17:48'!
shutDown: quitting
	"This message is sent on system shutdown to registered classes"
	^self shutDown.! !

!TraitBehavior methodsFor: 'system startup' stamp: 'SebastianTleye 7/9/2013 17:48'!
shutDown
	"This message is sent on system shutdown to registered classes"
! !

!TraitBehavior methodsFor: 'system startup' stamp: 'SebastianTleye 7/9/2013 17:48'!
startUp
	"This message is sent to registered classes when the system is coming up."
 ! !

!TraitBehavior methodsFor: 'system startup' stamp: 'SebastianTleye 7/9/2013 17:48'!
startUp: resuming
	"This message is sent to registered classes when the system is coming up."
	^self startUp! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isObsolete
	"Return true if the receiver is obsolete."
	^self instanceCount = 0! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
includesBehavior: aClass
	
	self isTrait ifTrue: [ ^false ].
	^self == aClass or:[self inheritsFrom: aClass]! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isBytes
	"Answer whether the receiver has 8-bit instance variables."

	^ self instSpec >= 8! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isAnonymous
	^true! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isBits
	"Answer whether the receiver contains just bits (not pointers)."

	^ self instSpec >= 6! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
hasAbstractMethods
	"Tells whether the receiver locally defines an abstract method, i.e., a method sending subclassResponsibility"
	
	^ (self methods anySatisfy: [:cm | cm sendsSelector: #subclassResponsibility ])! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
canZapMethodDictionary
	"Return true if it is safe to zap the method dictionary on #obsolete"
	^true! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isCompact

	^self indexIfCompact ~= 0! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isWeak
	"Answer whether the receiver has contains weak references."
	^ self instSpec = 4! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isPointers
	"Answer whether the receiver contains just pointers (not bits)."

	^self isBits not! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
shouldNotBeRedefined
	"Return true if the receiver should not be redefined.
	The assumption is that compact classes,
	classes in Smalltalk specialObjects and 
	Behaviors should not be redefined"

	^(Smalltalk compactClassesArray includes: self)
		or:[(Smalltalk specialObjectsArray includes: self)
			or: [self isKindOf: self]]! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isMeta
	^ false! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isWords
	"Answer true if the receiver is made of 32-bit instance variables."

	^self isBytes not! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isVariable
	"Answer whether the receiver has indexable variables."

	^ self instSpec >= 2! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
sourceMatchesBytecodeAt: selector
	"Answers true if the source code at the selector compiles to the bytecode at the selector, and false
	otherwise. Implemented to detect an error where Monticello did not recompile sources when the class
	shape changed"

	"This code was copied from #recompile:from:, with few changes. Several methods would benefit from a
	method which turned a selector and class into a CompiledMethod, without  installing it into the 
	methodDictionary"

	| method newMethod |

	method := self compiledMethodAt: selector.
	newMethod := self compiler
			source: (self sourceCodeAt: selector);
			class: self;
			failBlock: [^ false];
			compiledMethodTrailer: method trailer;
			compile.   "Assume OK after proceed from SyntaxError"
	selector == newMethod selector ifFalse: [self error: 'selector changed!!!!'].
	^ newMethod = method! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isFixed
	"Answer whether the receiver does not have a variable (indexable) part."

	^self isVariable not! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
instSpec
	^ (self format bitShift: -7) bitAnd: 16rF! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichSelectorsAssign: instVarName 
	"Answer a Set of selectors whose methods store into the argument, 
	instVarName, as a named instance variable."
	^self whichSelectorsStoreInto: instVarName! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
copiedMethodsFromSuperclass
	"Returns the methods that the receiver copied with its ancestors"
	
	| methods |
	methods := OrderedCollection new.
	self methodsDo: [ :method|
		methods addAll:  (self copiedFromSuperclass: method)].
	^ methods! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichClassDefinesInstVar: aString 
	^self 
		whichSuperclassSatisfies: [:aClass | aClass instVarNames includes: aString]! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichSuperclassSatisfies: aBlock 
	(aBlock value: self) ifTrue: [^self].
	^self superclass isNil 
		ifTrue: [nil]
		ifFalse: [self superclass whichSuperclassSatisfies: aBlock]! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
copiesFromSuperclass: method
	"Checks whether the receiver copied the argument,  method, from its superclasses"
	
	self allSuperclassesDo: [ :cls|
		(cls includesSelector: method selector)
			ifTrue: [ ^ (cls >> method selector) sourceCode  = method sourceCode]].
	^ false! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichSelectorsRead: instVarName 
	"Answer a Set of selectors whose methods access the argument, 
	instVarName, as a named instance variable."
	^self whichSelectorsAccess: instVarName! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
copiedFromSuperclass: method
	"Returns the methods that the receiver copied with its ancestors"
	
	self allSuperclassesDo: [ :cls|
		(cls includesSelector: method selector)
			ifTrue: [ 
				((cls >> method selector) sourceCode  = method sourceCode)
					ifTrue: [ ^ {cls >> method selector}]
					ifFalse: [ ^ #()]]].
	^ #().
	! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichClassDefinesClassVar: aString 
	Symbol hasInterned: aString ifTrue: [ :aSymbol |
		^self whichSuperclassSatisfies: 
			[:aClass | 
			aClass classVarNames anySatisfy: [:each | each = aSymbol]]].
	^#()! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
copiesMethodsFromSuperclass
	"Checks whether the receiver copied some method from its superclass"

	self methodsDo: [ :method|
		(self copiesFromSuperclass: method)
			ifTrue: [ ^ true ]].
	^ false! !

!TraitBehavior methodsFor: '*Nautilus' stamp: 'SebastianTleye 7/9/2013 17:48'!
realClass

	^ self! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
addTraitSelector: aSymbol withMethod: aCompiledMethod
	"Add aMethod with selector aSymbol to my
	methodDict. aMethod must not be defined locally."

	| source method |
	[(self includesLocalSelector: aSymbol) not] assert.
	self ensureLocalSelectors.
		
	source := aCompiledMethod getSourceReplacingSelectorWith: aSymbol.
	method  := self
		compile: source
		classified: aCompiledMethod category
		notifying: nil
		trailer: self defaultMethodTrailer
		ifFail: [ ^nil ].
		
	method putSource: source inFile: 2
		withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Trait method'; cr].
	
	self isTrait ifFalse: [ method properties at: #traitSource put: aCompiledMethod].
	
	self basicAddSelector: aSymbol withMethod: method! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
flattenDownAllTraits
	self traitComposition allTraits do: [:each | self flattenDown: each].
	[ self traitComposition isEmpty ] assert.
	self traitComposition: nil.! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
traits
	"Returns a collection of all traits used by the receiver"
	^ self traitComposition traits! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
flattenDown: aTrait
	| selectors |
	[self hasTraitComposition and: [self traitComposition allTraits includes: aTrait]] assert.
	selectors := (self traitComposition transformationOfTrait: aTrait) selectors.
	self basicLocalSelectors: self basicLocalSelectors , selectors.
	self removeFromComposition: aTrait.! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
classesComposedWithMe
	self isTrait 
		ifTrue: [ ^self users gather: [:u | u classesComposedWithMe]]
		ifFalse: [ ^{self} ].! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
traitsProvidingSelector: aSymbol
	| result |
	result := OrderedCollection new.
	self hasTraitComposition ifFalse: [^result].
	(self traitComposition methodDescriptionsForSelector: aSymbol)
		do: [:methodDescription | methodDescription selector = aSymbol ifTrue: [
			result addAll: (methodDescription locatedMethods
				collect: [:each | each methodClass])]].
	^result! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
traitOrClassOfSelector: aSymbol
	"Return the trait or the class which originally defines the method aSymbol
	or return self if locally defined or if it is a conflict marker method.
	This is primarly used by Debugger to determin the behavior in which a recompiled
	method should be put. If a conflict method is recompiled it should be put into
	the class, thus return self. Also see TraitComposition>>traitProvidingSelector:"
	
	((self includesLocalSelector: aSymbol) or: [
		self hasTraitComposition not]) ifTrue: [^self].
	^(self traitComposition traitProvidingSelector: aSymbol) ifNil: [self]! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
removeUser: aClassOrTrait
	self users remove: aClassOrTrait ifAbsent: []! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
notifyUsersOfChangedSelector: aSelector
	self notifyUsersOfChangedSelectors: (Array with: aSelector)! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
traitCompositionIncludes: aTrait
	^self == aTrait or: 
		[self hasTraitComposition and: 
			[self traitComposition allTraits includes: aTrait]]! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
updateMethodDictionarySelector: aSymbol
	"A method with selector aSymbol in myself or my traitComposition has been changed.
	Do the appropriate update to my methodDict (remove or update method) and
	return all affected selectors of me so that my useres get notified."

	| modifiedSelectors descriptions oldProtocol |
	modifiedSelectors := IdentitySet new.
	descriptions := self traitComposition methodDescriptionsForSelector: aSymbol.
	descriptions do: [:methodDescription | | effectiveMethod selector |
		selector := methodDescription selector.
		(self includesLocalSelector: selector) ifFalse: [
			methodDescription isEmpty
				ifTrue: [
					self removeTraitSelector: selector.
					modifiedSelectors add: selector]
				ifFalse: [
					effectiveMethod := methodDescription effectiveMethod.
					self addTraitSelector: selector withMethod: effectiveMethod.
					
					"If the method was not categorized yet, we categorize it "
					oldProtocol := self organization categoryOfElement: selector.
					(oldProtocol isNil or: [ oldProtocol = Protocol unclassified ]) 
						ifTrue: [ self organization classify: selector under: methodDescription effectiveMethodCategory. ].
					
					modifiedSelectors add: selector]]].
	^modifiedSelectors! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
purgeLocalSelectors
	self basicLocalSelectors: nil! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
noteChangedSelectors: aCollection
	"Start update of my methodDict (after changes to traits in traitComposition
	or after a local method was removed from my methodDict). The argument 
	is a collection of method selectors that may have been changed. Most of the time
	aCollection only holds one selector. But when there are aliases involved 
	there may be several method changes that have to be propagated to users."

	| affectedSelectors |
	affectedSelectors := IdentitySet new.
	aCollection do: [:selector |
		affectedSelectors addAll: (self updateMethodDictionarySelector: selector)].
	self notifyUsersOfChangedSelectors: affectedSelectors.
	^ affectedSelectors! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
removeFromComposition: aTrait
	self setTraitComposition: (self traitComposition copyTraitExpression
		removeFromComposition: aTrait)! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
hasTraitComposition

	^ self traitComposition notEmpty.! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
traitTransformations 
	^ self traitComposition transformations ! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
setTraitCompositionFrom: aTraitExpression
	^ self setTraitComposition: aTraitExpression asTraitComposition! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
traitCompositionString
	^self hasTraitComposition
		ifTrue: [self traitComposition asString]
		ifFalse: ['{}']! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
setTraitComposition: aTraitComposition
	| oldComposition |
	(self hasTraitComposition not and: [aTraitComposition isEmpty]) ifTrue: [^self].
	aTraitComposition assertValidUser: self.

	oldComposition := self traitComposition.
	self traitComposition: aTraitComposition.
	self applyChangesOfNewTraitCompositionReplacing: oldComposition.
	
	oldComposition traits do: [:each | each removeUser: self].
	aTraitComposition traits do: [:each | each addUser: self]! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
notifyUsersOfChangedSelectors: aCollection! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
removeTraitSelector: aSymbol
	[(self includesLocalSelector: aSymbol) not] assert.
	self basicRemoveSelector: aSymbol! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
applyChangesOfNewTraitCompositionReplacing: oldComposition
	| changedSelectors |
	changedSelectors := self traitComposition
		changedSelectorsComparedTo: oldComposition.
	changedSelectors isEmpty ifFalse: [
		self noteChangedSelectors: changedSelectors].
	self traitComposition isEmpty ifTrue: [
		self purgeLocalSelectors].
	^changedSelectors! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
ensureLocalSelectors
	"Ensures that the instance variable localSelectors is effectively used to maintain
	the set of local selectors.
	This method must be called before any non-local selectors are added to the
	method dictionary!!"

	self basicLocalSelectors isNil 
		ifTrue: [self basicLocalSelectors: self selectors asSet]! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
addUser: aClassOrTrait
	self users add: aClassOrTrait.! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
addToComposition: aTrait
	self setTraitComposition: (self traitComposition copyTraitExpression
		add: aTrait;
		yourself)! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
addExclusionOf: aSymbol to: aTrait
	self setTraitComposition: (
		self traitComposition copyWithExclusionOf: aSymbol to: aTrait)! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
removeAlias: aSymbol of: aTrait
	self setTraitComposition: (
		self traitComposition copyWithoutAlias: aSymbol of: aTrait)! !

!TraitBehavior methodsFor: 'initialization' stamp: 'SebastianTleye 7/9/2013 17:48'!
emptyMethodDictionary

	^ MethodDictionary new! !

!TraitBehavior methodsFor: 'initialization' stamp: 'SebastianTleye 7/9/2013 17:48'!
obsolete
	"Invalidate and recycle local methods,
	e.g., zap the method dictionary if can be done safely."
	self canZapMethodDictionary
		ifTrue: [self methodDict: self emptyMethodDictionary].
	self hasTraitComposition ifTrue: [
		self traitComposition traits do: [:each |
			each removeUser: self]]! !

!TraitBehavior methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 17:48'!
deepCopy
	"Classes should only be shallowCopied or made anew."

	^ self shallowCopy! !

!TraitBehavior methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 17:48'!
copyOfMethodDictionary
	"Return a copy of the receiver's method dictionary"

	^ self methodDict copy! !

!TraitBehavior methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 17:48'!
postCopy
	super postCopy.
	self methodDict: self copyOfMethodDictionary! !

!TraitBehavior methodsFor: 'cleanup' stamp: 'SebastianTleye 7/9/2013 17:48'!
cleanUp
	"Clean out any caches and other state that should be flushed when trying to get an image into a pristine state. Subclasses may override #cleanUp: to provide different levels of cleanliness"
! !

!TraitBehavior methodsFor: 'cleanup' stamp: 'SebastianTleye 7/9/2013 17:48'!
cleanUp: aggressive
	"Clean out any caches and other state that should be flushed when trying to get an image into a pristine state. The argument should be used to indicate how aggressive the cleanup should be. Some subclasses may act differently depending on its value - for example, ChangeSet will only delete all unused and reinitialize the current change set if we're asking it to be aggressive."

	^self cleanUp! !

!TraitBehavior methodsFor: 'user interface' stamp: 'SebastianTleye 7/9/2013 17:48'!
withAllSubAndSuperclassesDo: aBlock

	self withAllSubclassesDo: aBlock.
	self allSuperclassesDo: aBlock.
! !

!TraitBehavior methodsFor: 'user interface' stamp: 'SebastianTleye 7/9/2013 17:48'!
unreferencedInstanceVariables
	"Return a list of the instance variables defined in the receiver which are not referenced in the receiver or any of its subclasses."

	^ self instVarNames reject: [:ivn | 
		self withAllSubclasses anySatisfy: [:class | 
			(class whichSelectorsAccess: ivn) notEmpty]]! !

!TraitBehavior methodsFor: '*ast-core' stamp: 'SebastianTleye 7/9/2013 17:48'!
parseTreeFor: aSymbol	
	^ RBParser parseMethod: (self sourceCodeAt: aSymbol) onError: [ :msg :pos | ^ nil ]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
ultimateSourceCodeAt: selector ifAbsent: aBlock
	"Return the source code at selector, deferring to superclass if necessary"
	^ self sourceCodeAt: selector ifAbsent:
		[self superclass
			ifNil:
				[aBlock value]
			 ifNotNil:
				[self superclass ultimateSourceCodeAt: selector ifAbsent: aBlock]]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
compiledMethodAt: selector ifAbsent: aBlock
	"Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, return the value of aBlock"

	^ self methodDict at: selector ifAbsent: [aBlock value]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
allMethods
	"Return the collection of compiled method I and my superclasses are defining"
	"asArray is used to not bump into a bug when comparing compiled methods."
	
	^ self allSelectors asArray collect: [ :s | self lookupSelector: s ]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
deregisterLocalSelector: aSymbol
	self basicLocalSelectors notNil ifTrue: [
		self basicLocalSelectors remove: aSymbol ifAbsent: []]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
selectors
	"Answer a Set of all the message selectors specified in the receiver's 
	method dictionary."

	^ self methodDict keys! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
compress
	"Compact the method dictionary of the receiver."

	self methodDict rehash! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
methodDictionary
	"Convenience"
	^self methodDict! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSelectorsAboveUntil: aRootClass

	| coll |
	coll := IdentitySet new.
	(self allSuperclassesIncluding: aRootClass) 
		do: [:aClass | 
				aClass selectorsDo: [ :sel | coll add: sel ]].
	^ coll
	

! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
sourceCodeAt: selector

	^ (self methodDict at: selector) sourceCode.! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSelectorsBelow: topClass 
	| coll |
	coll := IdentitySet new.
	self withAllSuperclassesDo: 
			[:aClass | 
			aClass = topClass
				ifTrue: [^ coll ]
				ifFalse: [aClass selectorsDo: [ :sel | coll add: sel ]]].
	^ coll
	

! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
registerLocalSelector: aSymbol
	self basicLocalSelectors notNil ifTrue: [
		self basicLocalSelectors add: aSymbol]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
lookupSelector: selector
	"Look up the given selector in my methodDictionary.
	Return the corresponding method if found.
	Otherwise chase the superclass chain and try again.
	Return nil if no method is found."
	| lookupClass |
	lookupClass := self.
	[lookupClass == nil]
		whileFalse: 
			[(lookupClass includesSelector: selector)
				ifTrue: [^ lookupClass compiledMethodAt: selector].
			lookupClass := lookupClass superclass].
	^ nil! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
nextQuotePosIn: sourceString startingFrom: commentStart
	| pos nextQuotePos |
	pos := commentStart + 1.
	[((nextQuotePos := sourceString findString: '"' startingAt: pos) == (sourceString findString: '""' startingAt: pos)) and: [nextQuotePos ~= 0]]
		whileTrue:
			[pos := nextQuotePos + 2].
	^nextQuotePos! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSelectorsAbove

	^ self allSelectorsAboveUntil: ProtoObject 
	

! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
methodDictionary: aDictionary
	self methodDict: aDictionary! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
selectorsWithArgs: numberOfArgs
	"Return all selectors defined in this class that take this number of arguments"

	^ self selectors select: [:selector | selector numArgs = numberOfArgs]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
supermostPrecodeCommentFor: selector 
	"Answer a string representing the precode comment in the most distant 
	superclass's implementation of the selector. Return nil if none found."
	| aSuper superComment |
	(self == Behavior
			or: [self superclass == nil
					or: [(aSuper := self superclass whichClassIncludesSelector: selector) == nil]])
		ifFalse: ["There is a super implementor"
			superComment := aSuper supermostPrecodeCommentFor: selector].
	^ superComment
		ifNil: [self firstPrecodeCommentFor: selector
			"ActorState supermostPrecodeCommentFor: #printOn:"]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
changeRecordsAt: selector
	"Return a list of ChangeRecords for all versions of the method at selector. Source code can be retrieved by sending string to any one.  Return nil if the method is absent."

	"(Pen changeRecordsAt: #go:) collect: [:cRec | cRec string]"
	^ChangeSet 
		scanVersionsOf: (self compiledMethodAt: selector ifAbsent: [^ nil])
		class: self meta: self isMeta
		category: (self whichCategoryIncludesSelector: selector)
		selector: selector.! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
>> selector 
	"Answer the compiled method associated with the argument, selector (a 
	Symbol), a message selector in the receiver's method dictionary. If the 
	selector is not in the dictionary, create an error notification."

	^self compiledMethodAt: selector
! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
zapAllMethods
	"Remove all methods in this class which is assumed to be obsolete"

	self methodDict: self emptyMethodDictionary.
	self class isMeta ifTrue: [self class zapAllMethods]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSelectorsWithout: behaviors
      "Returns all the selectors of the receiver and its superclasses, except the ones define in behaviors"
	| selectors |
	selectors := IdentitySet new.
	self withAllSuperclassesDo: [:class | (behaviors includes: class)
											ifFalse: [selectors addAll: class selectors.]].
	^ selectors asOrderedCollection ! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
methods
	
	^ self methodDict values! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
firstCommentAt:  selector
	"Answer a string representing the first comment in the method associated with selector.  Return an empty string if the relevant source file is not available, or if the method's source code does not contain a comment.  Not smart enough to bypass quotes in string constants, but does map doubled quote into a single quote."

	|someComments|
	someComments := self commentsAt: selector.
	^someComments isEmpty ifTrue: [''] ifFalse: [someComments first]


"Behavior firstCommentAt: #firstCommentAt:"! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
selectorsAndMethodsDo: selectorAndMethodBlock
	"Evaluate selectorAndMethodBlock with two arguments for each selector/method pair in my method dictionary."

	^ self methodDict keysAndValuesDo: selectorAndMethodBlock! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
sourceCodeAt: selector ifAbsent: aBlock

	^ (self methodDict at: selector ifAbsent: [^ aBlock value]) sourceCode.! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
compiledMethodAt: selector 
	"Answer the compiled method associated with the argument, selector (a 
	Symbol), a message selector in the receiver's method dictionary. If the 
	selector is not in the dictionary, create an error notification."

	^ self methodDict at: selector! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
classAndMethodFor: aSymbol do: binaryBlock ifAbsent: absentBlock
	"Looks up the selector aSymbol in the class chain. If it is found, binaryBlock is evaluated
	with the class that defines the selector and the associated method. Otherwise
	absentBlock is evaluated."

	
	self withAllSuperclassesDo: [:class | | method |
		method := class compiledMethodAt: aSymbol ifAbsent: [nil].
		method ifNotNil: [^ binaryBlock value: class value: method].
	].
	^ absentBlock value.! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
firstPrecodeCommentFor:  selector
	"If there is a comment in the source code at the given selector that preceeds the body of the method, return it here, else return nil"

	| method |
	"Behavior firstPrecodeCommentFor: #firstPrecodeCommentFor:"
	(#(Comment Definition Hierarchy) includes: selector)
		ifTrue: [^ nil].
	method := self compiledMethodAt: selector asSymbol ifAbsent: [^ nil].
	^method ast firstPrecodeComment.
	! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
commentsAt:  selector
	"Answer a string representing the first comment in the method associated with selector.  Return an empty string if the relevant source file is not available, or if the method's source code does not contain a comment.  Not smart enough to bypass quotes in string constants, but does map doubled quote into a single quote."


	^self commentsIn:  (self sourceCodeAt: selector) asString.
	
"Behavior commentsAt: #commentsAt:"! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
precodeCommentOrInheritedCommentFor: selector 
	"Answer a string representing the first comment in the method associated 
	with selector, considering however only comments that occur before the 
	beginning of the actual code. If the version recorded in the receiver is 
	uncommented, look up the inheritance chain. Return nil if none found."
	
	| aSuper aComment |
	^ (aComment := self firstPrecodeCommentFor: selector) isEmptyOrNil
		ifTrue: [(self == Behavior
					or: [self superclass == nil
							or: [(aSuper := self superclass whichClassIncludesSelector: selector) == nil]])
				ifFalse: [aSuper precodeCommentOrInheritedCommentFor: selector]]
		ifFalse: [aComment]! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
commentsIn: sourceString

	
	| commentStart nextQuotePos someComments aPos |
	('*"*' match: sourceString) ifFalse: [^#()].
	someComments:= OrderedCollection new.
	sourceString size = 0 ifTrue: [^ someComments].
	aPos:=1.
	nextQuotePos:= 0.
	[commentStart := sourceString findString: '"' startingAt: aPos.
	nextQuotePos:= self nextQuotePosIn: sourceString startingFrom: commentStart.
	(commentStart ~= 0 and: [nextQuotePos >commentStart])] whileTrue: [
		commentStart ~= nextQuotePos ifTrue: [
			someComments add: ((sourceString copyFrom: commentStart + 1 to: nextQuotePos - 1) copyReplaceAll: '""' with: '"').].
	aPos := nextQuotePos+1].
	^someComments! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
methodsDo: aBlock
	"Evaluate aBlock for all the compiled methods in my method dictionary."

	^ self methodDict valuesDo: aBlock! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
selectorsDo: selectorBlock
	"Evaluate selectorBlock for all the message selectors in my method dictionary."

	^ self methodDict keysDo: selectorBlock! !

!TraitBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSelectors
	"Answer all selectors understood by instances of the receiver"

	^ self allSelectorsBelow: nil! !

!TraitBehavior methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/9/2013 17:48'!
initialize
	"moved here from the class side's #new"
	super initialize.
	self superclass: Object.
	"no longer sending any messages, some of them crash the VM"
	self methodDict: self emptyMethodDictionary.
	self setFormat: Object format.
	self traitComposition: nil.
	self users: IdentitySet new.! !

!TraitBehavior methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/9/2013 17:48'!
nonObsoleteClass
	"Attempt to find and return the current version of this obsolete class"

	| obsName |
	obsName := self name.
	[obsName beginsWith: 'AnObsolete']
		whileTrue: [obsName := obsName copyFrom: 'AnObsolete' size + 1 to: obsName size].
	^ self environment at: obsName asSymbol! !

!TraitBehavior methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/9/2013 17:48'!
superclass: aClass methodDictionary: mDict format: fmt
	"Basic initialization of the receiver.
	Must only be sent to a new instance; else we would need Object flushCache."
	self superclass: aClass.
	self setFormat: fmt.
	self methodDict: mDict.
	self traitComposition: nil! !

!TraitBehavior methodsFor: 'obsolete subclasses' stamp: 'SebastianTleye 7/9/2013 17:48'!
allLocalCallsOn: aSymbol
	"Answer a SortedCollection of all the methods that call on aSymbol, anywhere in my class hierarchy."

	^(SystemNavigation new allLocalCallsOn: aSymbol ofClass: (self theNonMetaClass)).
! !

!TraitBehavior methodsFor: 'obsolete subclasses' stamp: 'SebastianTleye 7/9/2013 17:48'!
addObsoleteSubclass: aClass
	"Weakly remember that aClass was a subclass of the receiver and is now obsolete"
	| obs |

	obs := self basicObsoleteSubclasses at: self ifAbsent:[WeakArray new].
	(obs includes: aClass) ifTrue:[^self].
	obs := obs copyWithout: nil.
	obs := obs copyWith: aClass.
	self basicObsoleteSubclasses at: self put: obs.! !

!TraitBehavior methodsFor: 'obsolete subclasses' stamp: 'SebastianTleye 7/9/2013 17:48'!
removeAllObsoleteSubclasses
	"Remove all the obsolete subclasses of the receiver"
	self basicObsoleteSubclasses removeKey: self ifAbsent: [].
! !

!TraitBehavior methodsFor: 'obsolete subclasses' stamp: 'SebastianTleye 7/9/2013 17:48'!
removeObsoleteSubclass: aClass
	"Remove aClass from the weakly remembered obsolete subclasses"
	| obs |
	obs := self basicObsoleteSubclasses at: self ifAbsent:[^ self].
	(obs includes: aClass) ifFalse:[^self].
	obs := obs copyWithout: aClass.
	obs := obs copyWithout: nil.
	self basicObsoleteSubclasses at: self put: obs! !

!TraitBehavior methodsFor: 'obsolete subclasses' stamp: 'SebastianTleye 7/9/2013 17:48'!
obsoleteSubclasses
	"Return all the weakly remembered obsolete subclasses of the receiver"
	| obs |
	obs := self basicObsoleteSubclasses at: self ifAbsent: [^ #()].
	^ obs copyWithout: nil! !

!TraitBehavior methodsFor: '*NativeBoost-Core' stamp: 'SebastianTleye 7/9/2013 17:48'!
nbBindingOf: aName
	"answer a binding for a type name,
	by default use smalltalk name bindings"
	^ self bindingOf: aName! !

!TraitBehavior methodsFor: '*NativeBoost-Core' stamp: 'SebastianTleye 7/9/2013 17:48'!
externalTypeAlias: aTypeName
	"override, if you want to introduce type aliases.
	Answering nil means no type alias for given type name exists"
	^ nil! !

!TraitBehavior methodsFor: '*NativeBoost-Core' stamp: 'SebastianTleye 7/9/2013 17:48'!
nbFnArgument: argName generator: gen

	"Load the instance variable with given name" 

	(self allInstVarNames includes: argName) ifFalse: [ ^ nil ].
	^ NBSTIvarArgument new receiverClass: self; ivarName: argName! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
someInstance
	"Primitive. Answer the first instance in the enumeration of all instances 
	of the receiver. Fails if there are none. Essential. See Object 
	documentation whatIsAPrimitive."

	<primitive: 77>
	^nil! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
includesSharedPoolNamed:  aSharedPoolString 
	"Answer whether the receiver uses the shared pool named aSharedPoolString"
	
	^ (self sharedPools anySatisfy: [:each | each name = aSharedPoolString])! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
allClassVarNames
	"Answer a Set of the names of the receiver's and the receiver's ancestor's 
	class variables."

	^self superclass allClassVarNames! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
classVarNames
	"Answer a collection of the receiver's class variable names."

	^#()! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
instVarNames
	"Answer an Array of the instance variable names. Behaviors must make 
	up fake local instance variable names because Behaviors have instance 
	variables for the purpose of compiling methods, but these are not named 
	instance variables."

	| mySize superSize |
	mySize := self instSize.
	superSize := 
		self superclass == nil
			ifTrue: [0]
			ifFalse: [self superclass instSize].
	mySize = superSize ifTrue: [^#()].	
	^(superSize + 1 to: mySize) collect: [:i | 'inst' , i printString]! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
instanceCount
	"Answer the number of instances of the receiver that are currently in 
	use."

	| count |
	count := 0.
	self allInstancesDo: [:x | count := count + 1].
	^count! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSharedPools
	"Answer an ordered collection of the shared pools that the receiver and the receiver's ancestors share."

	^self superclass allSharedPools! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
allowsSubInstVars
	"Classes that allow instances to change classes among its subclasses will want to override this and return false, so inst vars are not accidentally added to its subclasses."

	^ true! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSubInstances 
	"Answer a list of all current instances of the receiver and all of its subclasses."
	| aCollection |
	aCollection := OrderedCollection new.
	self allSubInstancesDo:
		[:x | x == aCollection ifFalse: [aCollection add: x]].
	^ aCollection! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
allInstances
	"Answer a collection of all current instances of the receiver."

	| all inst next |
	all := OrderedCollection new.
	inst := self someInstance.
	[inst == nil]
		whileFalse: [
		next := inst nextInstance.
		inst == all ifFalse: [all add: inst].
		inst := next].
	^ all asArray! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
sharedPools
	"Answer an ordered collection of  the shared pools that the receiver shares"

	^ OrderedCollection new! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
subclassInstVarNames
	"Answer a Set of the names of the receiver's subclasses' instance 
	variables."
	| vars |
	vars := Set new.
	self allSubclasses do: [:aSubclass | vars addAll: aSubclass instVarNames].
	^vars! !

!TraitBehavior methodsFor: 'accessing instances and variables' stamp: 'SebastianTleye 7/9/2013 17:48'!
allInstVarNames
	"Answer an Array of the names of the receiver's instance variables. The 
	Array ordering is the order in which the variables are stored and 
	accessed by the interpreter."

	| vars |
	self superclass == nil
		ifTrue: [vars := self instVarNames copy]	"Guarantee a copy is answered."
		ifFalse: [vars := self superclass allInstVarNames , self instVarNames].
	^vars! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
decompilerClass
	self deprecated: 'use #compilerClass' on: '02 May 2013' in: 'Pharo 3.0'.
	^ self compilerClass! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
binding
	^ nil -> self! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
parserClass
	self deprecated: 'use #compilerClass' on: '29 April 2013' in: 'Pharo 3.0'.
	^self compilerClass! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
compile: code 
	"Compile the argument, code, as source code in the context of the 
	receiver. Create an error notification if the code can not be compiled. 
	The argument is either a string or an object that converts to a string or a 
	PositionableStream on an object that converts to a string."

	^self compile: code notifying: nil! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
compile: code classified: category notifying: requestor trailer: bytes ifFail: aBlock
	"Compile code without logging the source in the changes file"

	| methodNode |
	methodNode := self compiler
		compile: code
		in: self
		classified: category
		notifying: requestor
		ifFail: aBlock.
	^ methodNode generate: bytes! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
compiler
	"Answer a compiler appropriate for source methods of this class."

	^self compilerClass new
		environment: self environment;
		class: self! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
defaultMethodTrailer
	^ CompiledMethodTrailer empty! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
evaluatorClass
	"Answer an evaluator class appropriate for evaluating expressions in the 
	context of this class."
	self deprecated: 'use #compilerClass' on: '02 May 2013' in: 'Pharo 3.0'.
	^self compilerClass! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
compile: code notifying: requestor 
	"Compile the argument, code, as source code in the context of the 
	receiver and insEtall the result in the receiver's method dictionary. The 
	second argument, requestor, is to be notified if an error occurs. The 
	argument code is either a string or an object that converts to a string or 
	a PositionableStream. This method also saves the source code."
	
	| method |
	method  := self
		compile: code "a Text"
		classified: nil
		notifying: requestor
		trailer: self defaultMethodTrailer
		ifFail: [ ^nil ].
		
	method putSource: code inFile: 2
			withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Behavior method'; cr].
	self addSelector: method selector withMethod: method notifying: requestor.
	^ method selector! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
compileAll
	^ self compileAllFrom: self! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
evaluate: aString
	^self compiler evaluate: aString! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
compileAllFrom: oldClass
	"Compile all the methods in the receiver's method dictionary.
	This validates sourceCode and variable references and forces
	all methods to use the current bytecode set"
	
	oldClass selectorsDo: [:sel | self recompile: sel from: oldClass].
	! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
compilerClass
	"Answer a compiler class appropriate for source methods of this class."

	^Smalltalk compilerClass! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
recompileChanges
	"Compile all the methods that are in the changes file.
	This validates sourceCode and variable references and forces
	methods to use the current bytecode set"

	self selectorsAndMethodsDo:
		[:sel :meth | meth fileIndex > 1 ifTrue:
			[self recompile: sel from: self]]! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
sourceCodeTemplate
	"Answer an expression to be edited and evaluated in order to define 
	methods in this class or trait."

	^'message selector and argument names
	"comment stating purpose of message"

	| temporary variable names |
	statements'! !

!TraitBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
recompile: selector
	"Compile the method associated with selector in the receiver's method dictionary."
	^self recompile: selector from: self! !

!TraitBehavior methodsFor: 'memory usage' stamp: 'SebastianTleye 7/9/2013 17:48'!
instancesSizeInMemory
	"Answers the number of bytes consumed by all its instances including their object header"
	
	| bytes |
	bytes := 0.
	self allInstancesDo: [:each | bytes := bytes + each sizeInMemory  ].
	^ bytes! !

!TraitBehavior methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
protocols
	
	^ self organization categories copy! !

!TraitBehavior methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
methodNamed: aSelector

	^ self methodDict at: aSelector! !

!TraitBehavior methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/9/2013 17:48'!
methodsInProtocol: aString

	^ (self organization listAtCategoryNamed: aString) 
			collect: [:each | (self methodDict at: each) ]! !

!TraitBehavior methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 17:48'!
instVarNamesAndOffsetsDo: aBinaryBlock
	"This is part of the interface between the compiler and a class's instance or field names.
	 The class should enumerate aBinaryBlock with the instance variable name strings and
	 their integer offsets.  The order is important. Names evaluated later will override the
	 same names occurring earlier."

	"Nothing to do here; ClassDescription introduces named instance variables"
	^self! !

!TraitBehavior methodsFor: 'compiling' stamp: 'SebastianTleye 7/9/2013 17:48'!
variablesAndOffsetsDo: aBinaryBlock
	"This is the interface between the compiler and a class's instance or field names.  The
	 class should enumerate aBinaryBlock with the field definitions (with nil offsets) followed
	 by the instance variable name strings and their integer offsets (1-relative).  The order is
	 important; names evaluated later will override the same names occurring earlier."

	"Only need to do instance variables here.  CProtoObject introduces field definitions."
	self instVarNamesAndOffsetsDo: aBinaryBlock! !

!TraitBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/9/2013 17:48'!
new: sizeRequested 
	"Answer an initialized instance of this class with the number of indexable
	variables specified by the argument, sizeRequested."

	^ (self basicNew: sizeRequested) initialize  ! !

!TraitBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/9/2013 17:48'!
basicNew: sizeRequested 
	"Primitive. Answer an instance of this class with the number
	of indexable variables specified by the argument, sizeRequested.
	Fail if this class is not indexable or if the argument is not a
	positive Integer, or if there is not enough memory available. 
	Essential. See Object documentation whatIsAPrimitive."

	<primitive: 71>
	self isVariable ifFalse:
		[self error: self printString, ' cannot have variable sized instances'].
	(sizeRequested isInteger and: [sizeRequested >= 0]) ifTrue:
		["arg okay; space must be low."
		OutOfMemory signal.
		^ self basicNew: sizeRequested  "retry if user proceeds"].
	self primitiveFailed! !

!TraitBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/9/2013 17:48'!
basicNew
	"Primitive. Answer an instance of the receiver (which is a class) with no 
	indexable variables. Fail if the class is indexable. Essential. See Object 
	documentation whatIsAPrimitive."

	<primitive: 70>
	self isVariable ifTrue: [ ^ self basicNew: 0 ].
	"space must be low"
	OutOfMemory signal.
	^ self basicNew  "retry if user proceeds"
! !

!TraitBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/9/2013 17:48'!
new
	"Answer a new initialized instance of the receiver (which is a class) with no indexable variables. Fail if the class is indexable."

	^ self basicNew initialize
! !

!TraitBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:48'!
printHierarchy
	"Answer a description containing the names and instance variable names 
	of all of the subclasses and superclasses of the receiver."

	| aStream index |
	index := 0.
	aStream := (String new: 16) writeStream.
	self allSuperclasses reverseDo: 
		[:aClass | 
		aStream crtab: index.
		index := index + 1.
		aStream nextPutAll: aClass name.
		aStream space.
		aStream print: aClass instVarNames].
	aStream cr.
	self printSubclassesOn: aStream level: index.
	^aStream contents! !

!TraitBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:48'!
literalScannedAs: scannedLiteral notifying: requestor
	"Postprocesses a literal scanned by Scanner scanToken (esp. xLitQuote).
	If scannedLiteral is not an association, answer it.
	Else, if it is of the form:
		nil->#NameOfMetaclass
	answer nil->theMetaclass, if any has that name, else report an error.
	Else, if it is of the form:
		#NameOfGlobalVariable->anythiEng
	answer the global, class, or pool association with that nameE, if any, else
	add it to Undeclared a answer the new Association."

	| key value |
	(scannedLiteral isVariableBinding)
		ifFalse: [^ scannedLiteral].
	key := scannedLiteral key.
	value := scannedLiteral value.
	key isNil 
		ifTrue: "###<metaclass soleInstance name>"
			[(self bindingOf: value) ifNotNil:[:assoc|
				 (assoc value isKindOf: Behavior)
					ifTrue: [^ nil->assoc value class]].
			 requestor notify: 'No such metaclass'.
			 ^false].
	(key isSymbol)
		ifTrue: "##<global var name>"
			[(self bindingOf: key) ifNotNil:[:assoc | ^assoc].
			Undeclared at: key put: nil.
			 ^Undeclared bindingOf: key].
	requestor notify: '## must be followed by a non-local variable name'.
	^false

"	Form literalScannedAs: 14 notifying: nil 14
	Form literalScannedAs: #OneBitForm notiEfying: nil  OneBitForm
	Form literalScannedAs: ##OneBitForm notifying: nil  OneBitForm->a Form
	Form literalScannedAs: ##Form notifying: nil   Form->Form
	Form literalScannedAs: ###Form notifying: nil   nilE->Form class
"! !

!TraitBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:48'!
storeLiteral: aCodeLiteral on: aStream
	"Store aCodeLiteral on aStream, changing an Association to ##GlobalName
	 or ###MetaclassSoleInstanceName format if appropriate"
	| key value |
	(aCodeLiteral isVariableBinding)
		ifFalse:
			[aCodeLiteral storeOn: aStream.
			 ^self].
	key := aCodeLiteral key.
	(key isNil and: [(value := aCodeLiteral value) isMemberOf: Metaclass])
		ifTrue:
			[aStream nextPutAll: '###'; nextPutAll: value soleInstance name.
			 ^self].
	(key isSymbol and: [(self bindingOf: key) notNil])
		ifTrue:
			[aStream nextPutAll: '##'; nextPutAll: key.
			 ^self].
	aCodeLiteral storeOn: aStream! !

!TraitBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:48'!
longPrintOn: aStream
	"Append to the argument, aStream, the names and values of all of the receiver's instance variables.  But, not useful for a class with a method dictionary."

	aStream nextPutAll: '<<too complex to show>>'; cr.! !

!TraitBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:48'!
printOn: aStream 
	"Refer to the comment in Object|printOn:." 

	aStream nextPutAll: 'a descendent of '.
	self superclass printOn: aStream! !

!TraitBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isComposedBy: aTrait
	"Answers if this object includes trait aTrait into its composition"
	aTrait isTrait ifFalse: [ ^false].
	^self hasTraitComposition 
		ifTrue: [ self traitComposition includesTrait: aTrait ]
		ifFalse: [ false ]! !

!TraitBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/9/2013 17:48'!
poolDictionaryNames
	^ self sharedPools collect: [:ea | self environment keyAtIdentityValue: ea]! !

!TraitBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/9/2013 17:48'!
classDepth

	self superclass ifNil: [^ 1].
	^ self superclass classDepth + 1! !

!TraitBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/9/2013 17:48'!
typeOfClass
	"Answer a symbol uniquely describing the type of the receiver"
	self instSpec = CompiledMethod instSpec ifTrue:[^#compiledMethod]. "Very special!!"
	self isBytes ifTrue:[^#bytes].
	(self isWords and:[self isPointers not]) ifTrue:[^#words].
	self isWeak ifTrue:[^#weak].
	self isVariable ifTrue:[^#variable].
	^#normal.! !

!TraitBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/9/2013 17:48'!
numberOfInstanceVariables
	^ self instVarNames size
! !

!TraitBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/9/2013 17:48'!
classPool
	^ Dictionary new! !

!TraitBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:48'!
spaceUsed
	"Answer a rough estimate of number of bytes used by this class and its metaclass. Does not include space used by class variables."

	| space |
	space := 0.
	self methodsDo: [:method  |
		space := space + 16.  "dict and org'n space"
		space := space + (method size + 6 "hdr + avg pad").
		method literalsDo: [:lit |
			(lit isMemberOf: Array) ifTrue: [space := space + ((lit size + 1) * 4)].
			(lit isMemberOf: Float) ifTrue: [space := space + 12].
			(lit isMemberOf: ByteString) ifTrue: [space := space + (lit size + 6)].
			(lit isMemberOf: LargeNegativeInteger) ifTrue: [space := space + ((lit size + 1) * 4)].
			(lit isMemberOf: LargePositiveInteger) ifTrue: [space := space + ((lit size + 1) * 4)]]].
		^ space! !

!TraitBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:48'!
becomeCompactSimplyAt: index
	"Make me compact, but don't update the instances.  For importing segments."
"Here are the restrictions on compact classes in order for export segments to work:  A compact class index may not be reused.  If a class was compact in a release of Pharo, no other class may use that index.  The class might not be compact later, and there should be nil in its place in the array."

	| cct |
	self isWeak ifTrue: [^ Halt halt: 'You must not make a weak class compact'].
	cct := Smalltalk compactClassesArray.
	(self isCompact or: [cct includes: self])
		ifTrue: [^ self halt: self name , 'is already compact'].
	(cct at: index) ifNotNil: [^ self halt: 'compact table slot already in use'].
	"Install this class in the compact class table"
	cct at: index put: self.
	"Update instspec so future instances will be compact"
	self setFormat: self format + (index bitShift: 11).
	"Caller must convert the instances"
! !

!TraitBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:48'!
checkCanBeUncompact 
	"Certain classes cannot be uncompacted in CogVM.  If you download VMMaker and see the VM code, these are as defined by StackInterpreter>>#checkAssumedCompactClasses and the ones that can't be uncompacted are the following: "
	({ Array. LargeNegativeInteger. LargePositiveInteger. Float. MethodContext } includes: self)
		 ifTrue: [ self error: 'Class ', self name, ' cannot be uncompact. ' ]
! !

!TraitBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:48'!
becomeCompact
	"Here are the restrictions on compact classes in order for export segments to work:  A compact class index may not be reused.  If a class was compact in a release of Pharo, no other class may use that index.  The class might not be compact later, and there should be nil in its place in the array."
	| cct index |

	self isWeak ifTrue: [^ Halt halt: 'You must not make a weak class compact'].
	cct := Smalltalk compactClassesArray.
	(self isCompact or: [cct includes: self])
		ifTrue: [^ self halt: self name , 'is already compact'].
	index := cct indexOf: nil
		ifAbsent: [^ self halt: 'compact class table is full'].
	"Install this class in the compact class table"
	cct at: index put: self.
	"Update instspec so future instances will be compact"
	self setFormat: self format + (index bitShift: 11).
	"Make up new instances and become old ones into them"
	self updateInstancesFrom: self.
	"Purge any old instances"
	Smalltalk garbageCollect.! !

!TraitBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:48'!
flushCache
	"Tell the interpreter to remove the contents of its method lookup cache, if it has 
	one.  Essential.  See Object documentation whatIsAPrimitive."

	<primitive: 89>
	self primitiveFailed! !

!TraitBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:48'!
becomeUncompact
	| cct index |
	cct := Smalltalk compactClassesArray.
	(index := self indexIfCompact) = 0
		ifTrue: [^ self].
	(cct includes: self)
		ifFalse: [^ self halt  "inconsistent state"].
	self checkCanBeUncompact. 
	"Update instspec so future instances will not be compact"
	self setFormat: self format - (index bitShift: 11).
	"Make up new instances and become old ones into them"
	self updateInstancesFrom: self.
	"Make sure there are no compact ones left around"
	Smalltalk garbageCollect.
	"Remove this class from the compact class table"
	cct at: index put: nil.
! !

!TraitBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:48'!
indexIfCompact
	"If these 5 bits are non-zero, then instances of this class
	will be compact.  It is crucial that there be an entry in
	Smalltalk compactClassesArray for any class so optimized.
	See the msgs becomeCompact and becomeUncompact."
	^ (self format bitShift: -11) bitAnd: 16r1F


"
Array indexIfCompact

Verify if the compactClassesArray and indexIfCompact are coheren
Smalltalk compactClassesArray doWithIndex: 
	[:c :i | c == nil ifFalse:
		[c indexIfCompact = i ifFalse: [self halt]]]
"! !

!TraitBehavior methodsFor: 'testing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
kindOfSubclass
	"Answer a String that is the keyword that describes the receiver's kind 
	of subclass, either a regular subclass, a variableSubclass, a  
	variableByteSubclass, a variableWordSubclass, or a weakSubclass."
	self isWeak
		ifTrue: [^ ' weakSubclass: '].
	^ self isVariable
		ifTrue: [self isBits
				ifTrue: [self isBytes
						ifTrue: [ ' variableByteSubclass: ']
						ifFalse: [ ' variableWordSubclass: ']]
				ifFalse: [ ' variableSubclass: ']]
		ifFalse: [ ' subclass: ']! !

!TraitBehavior methodsFor: 'testing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
inheritsFrom: aClass 
	"Answer whether the argument, aClass, is on the receiver's superclass 
	chain."

	| aSuperclass |
	aSuperclass := self superclass.
	[aSuperclass == nil]
		whileFalse: 
			[aSuperclass == aClass ifTrue: [^true].
			aSuperclass := aSuperclass superclass].
	^false! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
selectSuperclasses: aBlock 
	"Evaluate the argument, aBlock, with the receiver's superclasses as the 
	argument. Collect into an OrderedCollection only those superclasses for 
	which aBlock evaluates to true. In addition, evaluate aBlock for the 
	superclasses of each of these successful superclasses and collect into the 
	OrderedCollection ones for which aBlock evaluates to true. Answer the 
	resulting OrderedCollection."

	| aSet |
	aSet := Set new.
	self allSuperclasses do: 
		[:aSuperclass | 
		(aBlock value: aSuperclass) ifTrue: [aSet add: aSuperclass]].
	^aSet! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
subclassesDo: aBlock
	"Evaluate the argument, aBlock, for each of the receiver's immediate subclasses."
	self subclasses do: aBlock! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
selectSubclasses: aBlock 
	"Evaluate the argument, aBlock, with each of the receiver's (next level) 
	subclasses as its argument. Collect into a Set only those subclasses for 
	which aBlock evaluates to true. In addition, evaluate aBlock for the 
	subclasses of each of these successful subclasses and collect into the set 
	those for which aBlock evaluates true. Answer the resulting set."

	| aSet |
	aSet := Set new.
	self allSubclasses do: 
		[:aSubclass | 
		(aBlock value: aSubclass) ifTrue: [aSet add: aSubclass]].
	^aSet! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
withAllSuperclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's superclasses."
	aBlock value: self.
	self superclass == nil
		ifFalse: [self superclass withAllSuperclassesDo: aBlock]! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSubclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's subclasses."

	self subclassesDo: 
		[:cl | 
		aBlock value: cl.
		cl allSubclassesDo: aBlock]! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
withAllSuperAndSubclassesDo: aBlock
	self allSuperclassesDo: aBlock.
	aBlock value: self.
	self allSubclassesDo: aBlock! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSubInstancesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the current instances of the 
	receiver and all its subclasses."

	self allInstancesDo: aBlock.
	self allSubclassesDo: [:sub | sub allInstancesDo: aBlock]! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
allUnreferencedInstanceVariables
	"Return a list of the instance variables known to the receiver which are not referenced in the receiver or any of its subclasses OR superclasses"

	^ self allInstVarNames reject: [:ivn |
		| definingClass |		
		definingClass := self classThatDefinesInstanceVariable: ivn.
		definingClass withAllSubclasses anySatisfy: [:class |  
				(class whichSelectorsAccess: ivn asSymbol) notEmpty]]! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSuperclassesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the receiver's superclasses."

	self superclass == nil
		ifFalse: [aBlock value: self superclass.
				self superclass allSuperclassesDo: aBlock]! !

!TraitBehavior methodsFor: 'enumerating' stamp: 'SebastianTleye 7/9/2013 17:48'!
allInstancesDo: aBlock 
	"Evaluate the argument, aBlock, for each of the current instances of the 
	receiver.
	
	Because aBlock might change the class of inst (for example, using become:),
	it is essential to compute next before aBlock value: inst."
	| inst next |
	inst := self someInstance.
	[inst == nil]
		whileFalse:
		[
		next := inst nextInstance.
		aBlock value: inst.
		inst := next]! !

!TraitBehavior methodsFor: '*Tools-Inspector' stamp: 'SebastianTleye 7/9/2013 17:48'!
inspectAllInstances 
	"Inspect all instances of the receiver."

	| all allSize prefix |
	all := self allInstances.
	(allSize := all size) isZero ifTrue: [^ self inform: 'There are no 
instances of ', self name].
	prefix := allSize = 1
		ifTrue: 	['The lone instance']
		ifFalse:	['The ', allSize printString, ' instances'].
	
	all asArray inspectWithLabel: (prefix, ' of ', self name)! !

!TraitBehavior methodsFor: '*Tools-Inspector' stamp: 'SebastianTleye 7/9/2013 17:48'!
inspectSubInstances 
	"Inspect all instances of the receiver and all its subclasses.  CAUTION - don't do this for something as generic as Object!!"

	| all allSize prefix |
	all := self allSubInstances.
	(allSize := all size) isZero ifTrue: [^ self inform: 'There are no 
instances of ', self name, '
or any of its subclasses'].
	prefix := allSize = 1
		ifTrue: 	['The lone instance']
		ifFalse:	['The ', allSize printString, ' instances'].
	
	all asArray inspectWithLabel: (prefix, ' of ', self name, ' & its subclasses')! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
thoroughHasSelectorReferringTo: literal special: specialFlag byte: specialByte
	"Answer true if any of my methods access the argument as a 
	literal. Dives into the compact literal notation, making it slow but 
	thorough "

	
	self methodsDo: [ :method |
		((method hasLiteralThorough: literal) or: [specialFlag and: [method scanFor: specialByte]])
			ifTrue: [^true]].
	^false! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
isLocalAliasSelector: aSymbol
	"Return true if the selector aSymbol is an alias defined
	in my trait composition."

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

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
classBindingOf: varName
	"Answer the binding of some variable resolved in the scope of the receiver's class"
	^self bindingOf: varName! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichSelectorsReferTo: literal special: specialFlag byte: specialByte
	"Answer a set of selectors whose methods access the argument as a literal."

	| who |
	who := IdentitySet new.
	self selectorsAndMethodsDo: 
		[:sel :method |
		((method hasLiteral: literal) or: [specialFlag and: [method scanFor: specialByte]])
			ifTrue:
				[((literal isVariableBinding) not
					or: [method literals allButLast includes: literal])
						ifTrue: [who add: sel]]].
	^ who! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
isDisabledSelector: selector
	^ self classAndMethodFor: selector do: [:c :m | m isDisabled] ifAbsent: [false]! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
hasMethods
	"Answer whether the receiver has any methods in its method dictionary."

	^ self methodDict notEmpty! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
canUnderstand: selector
	"Answer whether the receiver can respond to the message whose selector 
	is the argument."

	^ self classAndMethodFor: selector do: [:c :m | m isProvided] ifAbsent: [false].! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
thoroughWhichSelectorsReferTo: literal special: specialFlag byte: specialByte
	"Answer a set of selectors whose methods access the argument as a 
	literal. Dives into the compact literal notation, making it slow but 
	thorough "
	| selectors |
	selectors := IdentitySet new.
	self selectorsAndMethodsDo: 
		[ :sel :method |
			((self isTrait ifTrue: [method hasLiteralThorough: literal]
				     		 ifFalse: [method refersToLiteral: literal]) or: [specialFlag and: [method scanFor: specialByte]]) ifTrue: [selectors add: sel]].
	^ selectors! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
includesLocalSelector: aSymbol
	^self basicLocalSelectors isNil
		ifTrue: [self includesSelector: aSymbol]
		ifFalse: [self localSelectors includes: aSymbol]! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichClassIncludesSelector: aSymbol 
	"Answer the class on the receiver's superclass chain where the 
	argument, aSymbol (a message selector), will be found. Answer nil if none found."
	"Rectangle whichClassIncludesSelector: #inspect."
	(self includesSelector: aSymbol)
		ifTrue: [^ self].
	self superclass == nil
		ifTrue: [^ nil].
	^ self superclass whichClassIncludesSelector: aSymbol! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
canPerform: selector
	"Answer whether the receiver can safely perform to the message whose selector 
	is the argument: it is not an abstract or cancelled method"

	^ self classAndMethodFor: selector do: [:c :m | m isProvided] ifAbsent: [false].! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichSelectorsReferTo: literal 
	"Answer a Set of selectors whose methods access the argument as a
literal."

	| special byte |
	special := Smalltalk hasSpecialSelector: literal ifTrueSetByte: [:b |
byte := b].
	^self whichSelectorsReferTo: literal special: special byte: byte

	"Rectangle whichSelectorsReferTo: #+."! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichSelectorsAccess: instVarName 
	"Answer a set of selectors whose methods access the argument, 
	instVarName, as a named instance variable."

	| instVarIndex |
	instVarIndex := self instVarIndexFor: instVarName ifAbsent: [^IdentitySet new].
	^ self selectors select:  [:sel | 
		((self methodDict at: sel)
			readsField: instVarIndex)
			or: [(self methodDict at: sel) writesField: instVarIndex]]

	"Point whichSelectorsAccess: 'x'."! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichSelectorsStoreInto: instVarName 
	"Answer a Set of selectors whose methods access the argument, 
	instVarName, as a named instance variable."
	| instVarIndex |
	instVarIndex := self instVarIndexFor: instVarName ifAbsent: [^IdentitySet new].
	^ self selectors select: [:sel | (self methodDict at: sel) writesField: instVarIndex]

	"Point whichSelectorsStoreInto: 'x'."! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
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]]! !

!TraitBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:48'!
includesSelector: aSymbol 
	"Answer whether the message whose selector is the argument is in the 
	method dictionary of the receiver's class."

	^ self methodDict includesKey: aSymbol! !

!TraitBehavior methodsFor: 'naming' stamp: 'SebastianTleye 7/9/2013 17:48'!
environment
	"Return the environment in which the receiver is visible"
	^Smalltalk globals! !

!TraitBehavior methodsFor: '*System-Support' stamp: 'SebastianTleye 7/9/2013 17:48'!
allCallsOn: aSymbol
	"Answer a SortedCollection of all the methods that call on aSymbol."

	^ self  systemNavigation allCallsOn: aSymbol from: self .
	! !

!TraitBehavior methodsFor: '*System-Support' stamp: 'SebastianTleye 7/9/2013 17:48'!
allUnsentMessages
	"Answer an array of all the messages defined by the receiver that are not sent anywhere in the system."

	^ SystemNavigation new allUnsentMessagesIn: self selectors! !

!TraitBehavior methodsFor: '*System-Support' stamp: 'SebastianTleye 7/9/2013 17:48'!
allCallsOn
	"Answer a SortedCollection of all the methods that refer to me by name or as part of an association in a global dict."
	
	^ (self allCallsOnIn: self systemNavigation)! !

!TraitBehavior methodsFor: '*System-Support' stamp: 'SebastianTleye 7/9/2013 17:48'!
referencedClasses
	"Return the set of classes that are directly referenced by my methods"

	| answer |
	answer := Set new.
	self methods do: [ :cm |
		answer addAll: 
			( cm literals select: [ :l | l isKindOf: Association ] thenCollect: #value ) ].
		
	^ answer! !

!TraitBehavior methodsFor: '*System-Support' stamp: 'SebastianTleye 7/9/2013 17:48'!
allCallsOnIn: aSystemNavigation
	"Answer a SortedCollection of all the methods that refer to me by name or as part of an association in a global dict."

	^ (aSystemNavigation 
		allReferencesTo: (self environment associationAt: self theNonMetaClass name)), 
		(aSystemNavigation allCallsOn: self theNonMetaClass name)	! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSubclasses
	"Answer an orderedCollection of the receiver's and the receiver's descendent's subclasses. "

	| scan scanTop |
	scan := OrderedCollection withAll: self subclasses.
	scanTop := 1.
	[scanTop > scan size]
		whileFalse: [scan addAll: (scan at: scanTop) subclasses.
			scanTop := scanTop + 1].
	^ scan! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
withAllSubclasses
	"Answer a Set of the receiver, the receiver's descendent's, and the  
	receiver's descendent's subclasses."

	^ self allSubclasses add: self;
		 yourself! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
withAllSuperclasses
	"Answer an OrderedCollection of the receiver and the receiver's 
	superclasses. The first element is the receiver, 
	followed by its superclass; the last element is Object."

	| temp |
	temp := self allSuperclasses.
	temp addFirst: self.
	^ temp! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSuperclassesIncluding: aClass
	"Answer an OrderedCollection of the receiver's and the receiver's  ancestor's superclasses
	up to aClass included. If aClass is not part of the receiver's superclass, returns up to the root."
	| temp |
	self class == ProtoObject class ifTrue: [ ^ OrderedCollection new].
	^ self superclass == aClass
		ifTrue: [ OrderedCollection with: aClass]
		ifFalse: [temp := self superclass allSuperclassesIncluding: aClass.
			temp addFirst: self superclass.
			temp]! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
withAllSubclassesDo: aBlock
	"Evaluate the argument, aBlock, for the receiver and each of its 
	subclasses."
	self withAllSubclasses do: [ :subclass | aBlock value: subclass ].! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSubclassesWithLevelDo: classAndLevelBlock startingLevel: level 
	"Walk the tree of subclasses, giving the class and its level"
	| subclassNames |
	classAndLevelBlock value: self value: level.
	self == Class ifTrue:  [^ self].  "Don't visit all the metaclasses"
	"Visit subclasses in alphabetical order"
	subclassNames := SortedCollection new.
	self subclassesDo: [:subC | subclassNames add: subC name].
	subclassNames do:
		[:name | (self environment at: name)
			allSubclassesWithLevelDo: classAndLevelBlock
			startingLevel: level+1]! !

!TraitBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:48'!
allSuperclasses
	"Answer an OrderedCollection of the receiver's and the receiver's  
	ancestor's superclasses. The first element is the receiver's immediate  
	superclass, followed by its superclass; the last element is Object."
	| temp |
	^ self superclass == nil
		ifTrue: [ OrderedCollection new]
		ifFalse: [temp := self superclass allSuperclasses.
			temp addFirst: self superclass.
			temp]! !

!TraitBehavior methodsFor: '*Rpackage-Core' stamp: 'SebastianTleye 7/9/2013 17:48'!
originalName
	^self isObsolete 
		ifTrue: [ (self name copyFrom:   'AnObsolete' size + 1 to: self name size ) asSymbol ]
		ifFalse:  [  self name asSymbol ].! !

!TraitBehavior methodsFor: '*Manifest-Core' stamp: 'SebastianTleye 7/9/2013 17:48'!
isManifest

	^ self name beginsWith: 'Manifest'! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
adoptInstance: anInstance
	"Change the class of anInstance to me.
	Primitive (found in Cog and new VMs)  follows the same rules as primitiveChangeClassTo:, but returns the 	class rather than the modified instance"
	<primitive: 160 error: ec>
	anInstance primitiveChangeClassTo: self basicNew.
	^self! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
localSelectors
	"Return a set of selectors defined locally.
	The instance variable is lazily initialized. If it is nil then there
	are no non-local selectors"

	^ self basicLocalSelectors isNil
		ifTrue: [self selectors asSet]
		ifFalse: [self basicLocalSelectors].! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
basicRemoveSelector: selector 
	"Assuming that the argument, selector (a Symbol), is a message selector 
	in my method dictionary, remove it and its method."

	| oldMethod |
	oldMethod := self methodDict at: selector ifAbsent: [^ self].
	self methodDict removeKey: selector.

	"Now flush the method cache"
	oldMethod flushCache.
	selector flushCache.! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
addSelector: selector withMethod: compiledMethod notifying: requestor
	^ self addSelectorSilently: selector withMethod: compiledMethod! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
methodDictAddSelectorSilently: selector withMethod: compiledMethod
	self basicAddSelector: selector withMethod: compiledMethod! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
basicAddSelector: selector withMethod: compiledMethod 
	"Add the message selector with the corresponding compiled method to the 
	receiver's method dictionary.
	Do this without sending system change notifications"

	| oldMethodOrNil |	
	oldMethodOrNil := self lookupSelector: selector.
	self methodDict at: selector put: compiledMethod.
	compiledMethod methodClass: self.
	compiledMethod selector: selector.

	"Now flush Pharo's method cache, either by selector or by method"
	oldMethodOrNil ifNotNil: [oldMethodOrNil flushCache].
	selector flushCache.! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
addSelector: selector withMethod: compiledMethod 
	^ self addSelector: selector withMethod: compiledMethod notifying: nil! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
localSelectors: aSet 
	self basicLocalSelectors: aSet.! !

!TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:48'!
removeSelectorSilently: selector 
	"Remove selector without sending system change notifications"

	^ SystemAnnouncer uniqueInstance suspendAllWhile: [self removeSelector: selector].! !

!TraitBehavior methodsFor: 'system startup' stamp: 'SebastianTleye 7/9/2013 17:48'!
shutDown: quitting
	"This message is sent on system shutdown to registered classes"
	^self shutDown.! !

!TraitBehavior methodsFor: 'system startup' stamp: 'SebastianTleye 7/9/2013 17:48'!
shutDown
	"This message is sent on system shutdown to registered classes"
! !

!TraitBehavior methodsFor: 'system startup' stamp: 'SebastianTleye 7/9/2013 17:48'!
startUp
	"This message is sent to registered classes when the system is coming up."
 ! !

!TraitBehavior methodsFor: 'system startup' stamp: 'SebastianTleye 7/9/2013 17:48'!
startUp: resuming
	"This message is sent to registered classes when the system is coming up."
	^self startUp! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isObsolete
	"Return true if the receiver is obsolete."
	^self instanceCount = 0! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
includesBehavior: aClass
	
	self isTrait ifTrue: [ ^false ].
	^self == aClass or:[self inheritsFrom: aClass]! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isBytes
	"Answer whether the receiver has 8-bit instance variables."

	^ self instSpec >= 8! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isAnonymous
	^true! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isBits
	"Answer whether the receiver contains just bits (not pointers)."

	^ self instSpec >= 6! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
hasAbstractMethods
	"Tells whether the receiver locally defines an abstract method, i.e., a method sending subclassResponsibility"
	
	^ (self methods anySatisfy: [:cm | cm sendsSelector: #subclassResponsibility ])! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
canZapMethodDictionary
	"Return true if it is safe to zap the method dictionary on #obsolete"
	^true! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isCompact

	^self indexIfCompact ~= 0! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isWeak
	"Answer whether the receiver has contains weak references."
	^ self instSpec = 4! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isPointers
	"Answer whether the receiver contains just pointers (not bits)."

	^self isBits not! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
shouldNotBeRedefined
	"Return true if the receiver should not be redefined.
	The assumption is that compact classes,
	classes in Smalltalk specialObjects and 
	Behaviors should not be redefined"

	^(Smalltalk compactClassesArray includes: self)
		or:[(Smalltalk specialObjectsArray includes: self)
			or: [self isKindOf: self]]! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isMeta
	^ false! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isWords
	"Answer true if the receiver is made of 32-bit instance variables."

	^self isBytes not! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isVariable
	"Answer whether the receiver has indexable variables."

	^ self instSpec >= 2! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
sourceMatchesBytecodeAt: selector
	"Answers true if the source code at the selector compiles to the bytecode at the selector, and false
	otherwise. Implemented to detect an error where Monticello did not recompile sources when the class
	shape changed"

	"This code was copied from #recompile:from:, with few changes. Several methods would benefit from a
	method which turned a selector and class into a CompiledMethod, without  installing it into the 
	methodDictionary"

	| method newMethod |

	method := self compiledMethodAt: selector.
	newMethod := self compiler
			source: (self sourceCodeAt: selector);
			class: self;
			failBlock: [^ false];
			compiledMethodTrailer: method trailer;
			compile.   "Assume OK after proceed from SyntaxError"
	selector == newMethod selector ifFalse: [self error: 'selector changed!!!!'].
	^ newMethod = method! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
isFixed
	"Answer whether the receiver does not have a variable (indexable) part."

	^self isVariable not! !

!TraitBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:48'!
instSpec
	^ (self format bitShift: -7) bitAnd: 16rF! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichSelectorsAssign: instVarName 
	"Answer a Set of selectors whose methods store into the argument, 
	instVarName, as a named instance variable."
	^self whichSelectorsStoreInto: instVarName! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
copiedMethodsFromSuperclass
	"Returns the methods that the receiver copied with its ancestors"
	
	| methods |
	methods := OrderedCollection new.
	self methodsDo: [ :method|
		methods addAll:  (self copiedFromSuperclass: method)].
	^ methods! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichClassDefinesInstVar: aString 
	^self 
		whichSuperclassSatisfies: [:aClass | aClass instVarNames includes: aString]! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichSuperclassSatisfies: aBlock 
	(aBlock value: self) ifTrue: [^self].
	^self superclass isNil 
		ifTrue: [nil]
		ifFalse: [self superclass whichSuperclassSatisfies: aBlock]! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
copiesFromSuperclass: method
	"Checks whether the receiver copied the argument,  method, from its superclasses"
	
	self allSuperclassesDo: [ :cls|
		(cls includesSelector: method selector)
			ifTrue: [ ^ (cls >> method selector) sourceCode  = method sourceCode]].
	^ false! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichSelectorsRead: instVarName 
	"Answer a Set of selectors whose methods access the argument, 
	instVarName, as a named instance variable."
	^self whichSelectorsAccess: instVarName! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
copiedFromSuperclass: method
	"Returns the methods that the receiver copied with its ancestors"
	
	self allSuperclassesDo: [ :cls|
		(cls includesSelector: method selector)
			ifTrue: [ 
				((cls >> method selector) sourceCode  = method sourceCode)
					ifTrue: [ ^ {cls >> method selector}]
					ifFalse: [ ^ #()]]].
	^ #().
	! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
whichClassDefinesClassVar: aString 
	Symbol hasInterned: aString ifTrue: [ :aSymbol |
		^self whichSuperclassSatisfies: 
			[:aClass | 
			aClass classVarNames anySatisfy: [:each | each = aSymbol]]].
	^#()! !

!TraitBehavior methodsFor: 'queries' stamp: 'SebastianTleye 7/9/2013 17:48'!
copiesMethodsFromSuperclass
	"Checks whether the receiver copied some method from its superclass"

	self methodsDo: [ :method|
		(self copiesFromSuperclass: method)
			ifTrue: [ ^ true ]].
	^ false! !

!TraitBehavior methodsFor: '*Nautilus' stamp: 'SebastianTleye 7/9/2013 17:48'!
realClass

	^ self! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
addTraitSelector: aSymbol withMethod: aCompiledMethod
	"Add aMethod with selector aSymbol to my
	methodDict. aMethod must not be defined locally."

	| source method |
	[(self includesLocalSelector: aSymbol) not] assert.
	self ensureLocalSelectors.
		
	source := aCompiledMethod getSourceReplacingSelectorWith: aSymbol.
	method  := self
		compile: source
		classified: aCompiledMethod category
		notifying: nil
		trailer: self defaultMethodTrailer
		ifFail: [ ^nil ].
		
	method putSource: source inFile: 2
		withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Trait method'; cr].
	
	self isTrait ifFalse: [ method properties at: #traitSource put: aCompiledMethod].
	
	self basicAddSelector: aSymbol withMethod: method! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
flattenDownAllTraits
	self traitComposition allTraits do: [:each | self flattenDown: each].
	[ self traitComposition isEmpty ] assert.
	self traitComposition: nil.! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
traits
	"Returns a collection of all traits used by the receiver"
	^ self traitComposition traits! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
flattenDown: aTrait
	| selectors |
	[self hasTraitComposition and: [self traitComposition allTraits includes: aTrait]] assert.
	selectors := (self traitComposition transformationOfTrait: aTrait) selectors.
	self basicLocalSelectors: self basicLocalSelectors , selectors.
	self removeFromComposition: aTrait.! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
classesComposedWithMe
	self isTrait 
		ifTrue: [ ^self users gather: [:u | u classesComposedWithMe]]
		ifFalse: [ ^{self} ].! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
traitsProvidingSelector: aSymbol
	| result |
	result := OrderedCollection new.
	self hasTraitComposition ifFalse: [^result].
	(self traitComposition methodDescriptionsForSelector: aSymbol)
		do: [:methodDescription | methodDescription selector = aSymbol ifTrue: [
			result addAll: (methodDescription locatedMethods
				collect: [:each | each methodClass])]].
	^result! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
traitOrClassOfSelector: aSymbol
	"Return the trait or the class which originally defines the method aSymbol
	or return self if locally defined or if it is a conflict marker method.
	This is primarly used by Debugger to determin the behavior in which a recompiled
	method should be put. If a conflict method is recompiled it should be put into
	the class, thus return self. Also see TraitComposition>>traitProvidingSelector:"
	
	((self includesLocalSelector: aSymbol) or: [
		self hasTraitComposition not]) ifTrue: [^self].
	^(self traitComposition traitProvidingSelector: aSymbol) ifNil: [self]! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
removeUser: aClassOrTrait
	self users remove: aClassOrTrait ifAbsent: []! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
notifyUsersOfChangedSelector: aSelector
	self notifyUsersOfChangedSelectors: (Array with: aSelector)! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
traitCompositionIncludes: aTrait
	^self == aTrait or: 
		[self hasTraitComposition and: 
			[self traitComposition allTraits includes: aTrait]]! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
updateMethodDictionarySelector: aSymbol
	"A method with selector aSymbol in myself or my traitComposition has been changed.
	Do the appropriate update to my methodDict (remove or update method) and
	return all affected selectors of me so that my useres get notified."

	| modifiedSelectors descriptions oldProtocol |
	modifiedSelectors := IdentitySet new.
	descriptions := self traitComposition methodDescriptionsForSelector: aSymbol.
	descriptions do: [:methodDescription | | effectiveMethod selector |
		selector := methodDescription selector.
		(self includesLocalSelector: selector) ifFalse: [
			methodDescription isEmpty
				ifTrue: [
					self removeTraitSelector: selector.
					modifiedSelectors add: selector]
				ifFalse: [
					effectiveMethod := methodDescription effectiveMethod.
					self addTraitSelector: selector withMethod: effectiveMethod.
					
					"If the method was not categorized yet, we categorize it "
					oldProtocol := self organization categoryOfElement: selector.
					(oldProtocol isNil or: [ oldProtocol = Protocol unclassified ]) 
						ifTrue: [ self organization classify: selector under: methodDescription effectiveMethodCategory. ].
					
					modifiedSelectors add: selector]]].
	^modifiedSelectors! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
purgeLocalSelectors
	self basicLocalSelectors: nil! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
noteChangedSelectors: aCollection
	"Start update of my methodDict (after changes to traits in traitComposition
	or after a local method was removed from my methodDict). The argument 
	is a collection of method selectors that may have been changed. Most of the time
	aCollection only holds one selector. But when there are aliases involved 
	there may be several method changes that have to be propagated to users."

	| affectedSelectors |
	affectedSelectors := IdentitySet new.
	aCollection do: [:selector |
		affectedSelectors addAll: (self updateMethodDictionarySelector: selector)].
	self notifyUsersOfChangedSelectors: affectedSelectors.
	^ affectedSelectors! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
removeFromComposition: aTrait
	self setTraitComposition: (self traitComposition copyTraitExpression
		removeFromComposition: aTrait)! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
hasTraitComposition

	^ self traitComposition notEmpty.! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
traitTransformations 
	^ self traitComposition transformations ! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
setTraitCompositionFrom: aTraitExpression
	^ self setTraitComposition: aTraitExpression asTraitComposition! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
traitCompositionString
	^self hasTraitComposition
		ifTrue: [self traitComposition asString]
		ifFalse: ['{}']! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
setTraitComposition: aTraitComposition
	| oldComposition |
	(self hasTraitComposition not and: [aTraitComposition isEmpty]) ifTrue: [^self].
	aTraitComposition assertValidUser: self.

	oldComposition := self traitComposition.
	self traitComposition: aTraitComposition.
	self applyChangesOfNewTraitCompositionReplacing: oldComposition.
	
	oldComposition traits do: [:each | each removeUser: self].
	aTraitComposition traits do: [:each | each addUser: self]! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
notifyUsersOfChangedSelectors: aCollection! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
removeTraitSelector: aSymbol
	[(self includesLocalSelector: aSymbol) not] assert.
	self basicRemoveSelector: aSymbol! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
applyChangesOfNewTraitCompositionReplacing: oldComposition
	| changedSelectors |
	changedSelectors := self traitComposition
		changedSelectorsComparedTo: oldComposition.
	changedSelectors isEmpty ifFalse: [
		self noteChangedSelectors: changedSelectors].
	self traitComposition isEmpty ifTrue: [
		self purgeLocalSelectors].
	^changedSelectors! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
ensureLocalSelectors
	"Ensures that the instance variable localSelectors is effectively used to maintain
	the set of local selectors.
	This method must be called before any non-local selectors are added to the
	method dictionary!!"

	self basicLocalSelectors isNil 
		ifTrue: [self basicLocalSelectors: self selectors asSet]! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
addUser: aClassOrTrait
	self users add: aClassOrTrait.! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
addToComposition: aTrait
	self setTraitComposition: (self traitComposition copyTraitExpression
		add: aTrait;
		yourself)! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
addExclusionOf: aSymbol to: aTrait
	self setTraitComposition: (
		self traitComposition copyWithExclusionOf: aSymbol to: aTrait)! !

!TraitBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:48'!
removeAlias: aSymbol of: aTrait
	self setTraitComposition: (
		self traitComposition copyWithoutAlias: aSymbol of: aTrait)! !

!TraitBehavior methodsFor: 'initialization' stamp: 'SebastianTleye 7/9/2013 17:48'!
emptyMethodDictionary

	^ MethodDictionary new! !

!TraitBehavior methodsFor: 'initialization' stamp: 'SebastianTleye 7/9/2013 17:48'!
obsolete
	"Invalidate and recycle local methods,
	e.g., zap the method dictionary if can be done safely."
	self canZapMethodDictionary
		ifTrue: [self methodDict: self emptyMethodDictionary].
	self hasTraitComposition ifTrue: [
		self traitComposition traits do: [:each |
			each removeUser: self]]! !

!TraitBehavior methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 17:48'!
deepCopy
	"Classes should only be shallowCopied or made anew."

	^ self shallowCopy! !

!TraitBehavior methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 17:48'!
copyOfMethodDictionary
	"Return a copy of the receiver's method dictionary"

	^ self methodDict copy! !

!TraitBehavior methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 17:48'!
postCopy
	super postCopy.
	self methodDict: self copyOfMethodDictionary! !

!TraitBehavior methodsFor: 'cleanup' stamp: 'SebastianTleye 7/9/2013 17:48'!
cleanUp
	"Clean out any caches and other state that should be flushed when trying to get an image into a pristine state. Subclasses may override #cleanUp: to provide different levels of cleanliness"
! !

!TraitBehavior methodsFor: 'cleanup' stamp: 'SebastianTleye 7/9/2013 17:48'!
cleanUp: aggressive
	"Clean out any caches and other state that should be flushed when trying to get an image into a pristine state. The argument should be used to indicate how aggressive the cleanup should be. Some subclasses may act differently depending on its value - for example, ChangeSet will only delete all unused and reinitialize the current change set if we're asking it to be aggressive."

	^self cleanUp! !

!TraitBehavior methodsFor: 'user interface' stamp: 'SebastianTleye 7/9/2013 17:48'!
withAllSubAndSuperclassesDo: aBlock

	self withAllSubclassesDo: aBlock.
	self allSuperclassesDo: aBlock.
! !

!TraitBehavior methodsFor: 'user interface' stamp: 'SebastianTleye 7/9/2013 17:48'!
unreferencedInstanceVariables
	"Return a list of the instance variables defined in the receiver which are not referenced in the receiver or any of its subclasses."

	^ self instVarNames reject: [:ivn | 
		self withAllSubclasses anySatisfy: [:class | 
			(class whichSelectorsAccess: ivn) notEmpty]]! !

!TraitBehavior methodsFor: '*ast-core' stamp: 'SebastianTleye 7/9/2013 17:48'!
parseTreeFor: aSymbol	
	^ RBParser parseMethod: (self sourceCodeAt: aSymbol) onError: [ :msg :pos | ^ nil ]! !