requires: {}. provides: {#Derivable}. Derivable traits addImmutableSlot: #parentNames valued: {#parent0. #parent1. #parent2. #parent3. #parent4. #parent5. #parent6. #parent7. #parent8. #parent9}. d@(Derivable traits) parentName: index [ d parentNames at: index ]. d@(Derivable traits) derive "Constructs and returns a new prototype based on the argument with a new Traits object that delegates to the old one." "Replaces the interpreter-provided derive method." [| newTraits object | object: d clone. newTraits: Traits clone. newTraits addImmutableDelegate: (d parentName: 0) valued: object traits. object atSlotNamed: #traits put: newTraits. object ]. d@(Derivable traits) deriveWith: others "Performs the same task as #derive, constructing a new prototype with Traits object, but in this case, the Traits object inherits from each extra object's Traits in right-to-left order. Also, the new prototype gains slots from the other objects involved." "Replaces the interpreter-provided deriveWith: method." [| newTraits object index | object: d clone. newTraits: Traits clone. index: others size. [index = 0] whileFalse: [| parent | index: index - 1. parent: (others at: index). object addSlotsFrom: parent. newTraits addImmutableDelegate: (d parentName: index + 1) valued: parent traits]. newTraits addImmutableDelegate: (d parentName: 0) valued: d traits. object atSlotNamed: #traits put: newTraits. object ]. d@(Derivable traits) deriveWith: others withoutSlotsNamed: rejects "Performs deriveWith: but prevents the slots with the specified names from appearing in the derived prototype." [| object | object: (d deriveWith: others). rejects do: [| :each | ({#traits} includes: each) ifFalse: [object removeSlot: each]]. object ]. x@(Root traits) addPrototype: protoName derivedFrom: parents "Creates a new prototype with the given name, handles derive/deriveWith: transparently, and sets the traits name slot to the name for convenience." [| newProto | newProto: (parents size = 1 ifTrue: [(parents at: 0) derive] ifFalse: [| others index | others: (parents newSize: parents size - 1). index: others size. [index = 0] whileFalse: [index: index - 1. others at: index put: (parents at: index + 1)]. (parents at: 0) deriveWith: others]). "ensureSlot:is: may return the old value if =, but always returns what is installed after the method is done." (x hasSlotNamed: protoName) ifTrue: [x ensureSlot: protoName is: newProto unlessSatisfies: [| :old | old traits delegateValues = newProto traits delegateValues]] ifFalse: [x addImmutableSlot: protoName valued: newProto]. (newProto traits hasSlotNamed: #name) ifTrue: [newProto traits atSlotNamed: #name put: protoName name] ifFalse: [newProto traits addImmutableSlot: #name valued: protoName name]. x atSlotNamed: protoName ]. x@(Root traits) addPrototype: protoName "Answer addPrototype:derivedFrom: with a default single parent of Cloneable." [x addPrototype: protoName derivedFrom: {Cloneable}].