'From Squeak3.6alpha of ''17 March 2003'' [latest update: #5240] on 1 June 2003 at 11:55:30 pm'! "Change Set: Sibling-dup-tk Date: 11 March 2003 Author: Ted Kaehler Whenever you ask for a sibling instance of a Player in an EToy, the Players of the new object is an instance of the original Player class, instead of having a new class. When you duplicate a morph the holds a set of siblings, there was bug that made the new objects not be siblings. This fixes the bug. Alan wants this fixed for the cells of a Tic-Tac-Toe game. To test, make a playfield with a blob in it. Make a sibling of the blob. Tell the playfield to 'make sibling instance'. All four blobs will remain siblings. In addition, the production of a sibling instance is now cleaner. (Updated to fix a conflict with the 5240 MCP update. -dew)"! Object subclass: #DeepCopier instanceVariableNames: 'references uniClasses newUniClasses ' classVariableNames: 'NextVariableCheckTime ' poolDictionaries: '' category: 'System-Object Storage'! !DeepCopier commentStamp: 'tk 3/4/2003 19:39' prior: 0! DeepCopier does a veryDeepCopy. It is a complete tree copy using a dictionary. Any object that is in the tree twice is only copied once. All references to the object in the copy of the tree will point to the new copy. See Object|veryDeepCopy which calls (self veryDeepCopyWith: aDeepCopier). The dictionary of objects that have been seen, holds the correspondance (uniClass -> new uniClass). When a tree of morphs points at a morph outside of itself, that morph should not be copied. Use our own kind of weak pointers for the 'potentially outside' morphs. Default is that any new class will have all of its fields deeply copied. If a field needs to be weakly copied, define veryDeepInner: and veryDeepFixupWith:. veryDeepInner: has the loop that actually copies the fields. If a class defines its own copy of veryDeepInner: (to leave some fields out), then veryDeepFixupWith: will be called on that object at the end. veryDeepInner: can compute an alternate object to put in a field. (Object veryDeepCopyWith: discovers which superclasses did not define veryDeepInner:, and very deeply copies the variables defined in those classes). To decide if a class needs veryDeepInner: and veryDeepFixupWith:, ask this about an instance: If I duplicate this object, does that mean that I also want to make duplicates of the things it holds onto? If yes, (i.e. a Paragraph does want a new copy of its Text) then do nothing. If no, (i.e. an undo command does not want to copy the objects it acts upon), then define veryDeepInner: and veryDeepFixupWith:. Here is an analysis for the specific case of a morph being held by another morph. Does field X contain a morph (or a Player whose costume is a morph)? If not, no action needed. Is the morph in field X already a submorph of the object? Is it down lower in the submorph tree? If so, no action needed. Could the morph in field X every appear on the screen (be a submorph of some other morph)? If not, no action needed. If it could, you must write the methods veryDeepFixupWith: and veryDeepInner:, and in them, refrain from sending veryDeepCopyWith: to the contents of field X. newUniClasses = true in the normal case. Every duplicated Player gets a new class. When false, all duplicates will be siblings (sister instances) of existing players. ----- Things Ted is still considering ----- Rule: If a morph stores a uniClass class (Player 57) as an object in a field, the new uniClass will not be stored there. Each uniClass instance does have a new class created for it. (fix this by putting the old class in references and allow lookup? Wrong if encounter it before seeing an instance?) Rule: If object A has object C in a field, and A says (^ C) for the copy, but object B has A in a normal field and it gets deepCopied, and A in encountered first, then there will be two copies of C. (just be aware of it) Dependents are now fixed up. Suppose a model has a dependent view. In the DependentFields dictionary, model -> (view ...). If only the model is copied, no dependents are created (no one knows about the new model). If only the view is copied, it is inserted into DependentFields on the right side. model -> (view copiedView ...). If both are copied, the new model has the new view as its dependent. If additional things depend on a model that is copied, the caller must add them to its dependents. ! !Object methodsFor: 'copying' stamp: 'tk 3/11/2003 13:58'! veryDeepCopy "Do a complete tree copy using a dictionary. An object in the tree twice is only copied once. All references to the object in the copy of the tree will point to the new copy." | copier new | copier _ DeepCopier new initialize: self initialDeepCopierSize. new _ self veryDeepCopyWith: copier. copier mapUniClasses. copier references associationsDo: [:assoc | assoc value veryDeepFixupWith: copier]. copier fixDependents. ^ new! ! !Object methodsFor: 'copying' stamp: 'tk 3/11/2003 13:58'! veryDeepCopySibling "Do a complete tree copy using a dictionary. Substitute a clone of oldPlayer for the root. Normally, a Player or non systemDefined object would have a new class. We do not want one this time. An object in the tree twice, is only copied once. All references to the object in the copy of the tree will point to the new copy." | copier new | copier _ DeepCopier new initialize: self initialDeepCopierSize. copier newUniClasses: false. new _ self veryDeepCopyWith: copier. copier mapUniClasses. copier references associationsDo: [:assoc | assoc value veryDeepFixupWith: copier]. copier fixDependents. ^ new! ! !Object methodsFor: 'copying' stamp: 'tk 3/11/2003 14:12'! veryDeepCopyWith: deepCopier "Copy me and the entire tree of objects I point to. An object in the tree twice is copied once, and both references point to him. deepCopier holds a dictionary of objects we have seen. Some classes refuse to be copied. Some classes are picky about which fields get deep copied." | class index sub subAss new uc sup has mine | deepCopier references at: self ifPresent: [:newer | ^ newer]. "already did him" class _ self class. class isMeta ifTrue: [^ self]. "a class" new _ self clone. (class isSystemDefined not and: [deepCopier newUniClasses "allowed"]) ifTrue: [ uc _ deepCopier uniClasses at: class ifAbsent: [nil]. uc ifNil: [ deepCopier uniClasses at: class put: (uc _ self copyUniClassWith: deepCopier). deepCopier references at: class put: uc]. "remember" new _ uc new. new copyFrom: self]. "copy inst vars in case any are weak" deepCopier references at: self put: new. "remember" (class isVariable and: [class isPointers]) ifTrue: [index _ self basicSize. [index > 0] whileTrue: [sub _ self basicAt: index. (subAss _ deepCopier references associationAt: sub ifAbsent: [nil]) ifNil: [new basicAt: index put: (sub veryDeepCopyWith: deepCopier)] ifNotNil: [new basicAt: index put: subAss value]. index _ index - 1]]. "Ask each superclass if it wants to share (weak copy) any inst vars" new veryDeepInner: deepCopier. "does super a lot" "other superclasses want all inst vars deep copied" sup _ class. index _ class instSize. [has _ sup compiledMethodAt: #veryDeepInner: ifAbsent: [nil]. has _ has ifNil: [class isSystemDefined not "is a uniClass"] ifNotNil: [true]. mine _ sup instVarNames. has ifTrue: [index _ index - mine size] "skip inst vars" ifFalse: [1 to: mine size do: [:xx | sub _ self instVarAt: index. (subAss _ deepCopier references associationAt: sub ifAbsent: [nil]) "use association, not value, so nil is an exceptional value" ifNil: [new instVarAt: index put: (sub veryDeepCopyWith: deepCopier)] ifNotNil: [new instVarAt: index put: subAss value]. index _ index - 1]]. (sup _ sup superclass) == nil] whileFalse. new rehash. "force Sets and Dictionaries to rehash" ^ new ! ! !DeepCopier methodsFor: 'like fullCopy' stamp: 'tk 3/11/2003 13:56'! fixDependents "They are not used much, but need to be right" | newDep newModel | DependentsFields associationsDo: [:pair | pair value do: [:dep | newDep _ references at: dep ifAbsent: [nil]. newDep ifNotNil: [ newModel _ references at: pair key ifAbsent: [pair key]. newModel addDependent: newDep]]]. ! ! !DeepCopier methodsFor: 'like fullCopy' stamp: 'tk 3/4/2003 19:40'! initialize: size references _ IdentityDictionary new: size. uniClasses _ IdentityDictionary new. "UniClass -> new UniClass" "self isItTimeToCheckVariables ifTrue: [self checkVariables]." "no more checking at runtime" newUniClasses _ true.! ! !DeepCopier methodsFor: 'like fullCopy' stamp: 'tk 3/11/2003 14:14'! mapUniClasses "For new Uniclasses, map their class vars to the new objects. And their additional class instance vars. (scripts slotInfo) and cross references like (player321)." "Players also refer to each other using associations in the References dictionary. Search the methods of our Players for those. Make new entries in References and point to them." | pp oldPlayer newKey newAssoc oldSelList newSelList | newUniClasses ifFalse: [^ self]. "All will be siblings. uniClasses is empty" "Uniclasses use class vars to hold onto siblings who are referred to in code" pp _ Player class superclass instSize. uniClasses do: [:playersClass | "values = new ones" playersClass classPool associationsDo: [:assoc | assoc value: (assoc value veryDeepCopyWith: self)]. playersClass scripts: (playersClass privateScripts veryDeepCopyWith: self). "pp+1" "(pp+2) slotInfo was deepCopied in copyUniClass and that's all it needs" pp+3 to: playersClass class instSize do: [:ii | playersClass instVarAt: ii put: ((playersClass instVarAt: ii) veryDeepCopyWith: self)]. ]. "Make new entries in References and point to them." References keys "copy" do: [:playerName | oldPlayer _ References at: playerName. (references includesKey: oldPlayer) ifTrue: [ newKey _ (references at: oldPlayer) "new player" uniqueNameForReference. "now installed in References" (references at: oldPlayer) renameTo: newKey]]. uniClasses "values" do: [:newClass | oldSelList _ OrderedCollection new. newSelList _ OrderedCollection new. newClass selectorsDo: [:sel | (newClass compiledMethodAt: sel) literals do: [:assoc | assoc isVariableBinding ifTrue: [ (References associationAt: assoc key ifAbsent: [nil]) == assoc ifTrue: [ newKey _ (references at: assoc value ifAbsent: [assoc value]) externalName asSymbol. (assoc key ~= newKey) & (References includesKey: newKey) ifTrue: [ newAssoc _ References associationAt: newKey. newClass methodDictionary at: sel put: (newClass compiledMethodAt: sel) clone. "were sharing it" (newClass compiledMethodAt: sel) literalAt: ((newClass compiledMethodAt: sel) literals indexOf: assoc) put: newAssoc. (oldSelList includes: assoc key) ifFalse: [ oldSelList add: assoc key. newSelList add: newKey]]]]]]. oldSelList with: newSelList do: [:old :new | newClass replaceSilently: old to: new]]. "This is text replacement and can be wrong"! ! !DeepCopier methodsFor: 'like fullCopy' stamp: 'tk 3/11/2003 14:13'! newUniClasses "If false, all new Players are merely siblings of the old players" ^ newUniClasses! ! !DeepCopier methodsFor: 'like fullCopy' stamp: 'tk 3/4/2003 19:44'! newUniClasses: newVal "If false, all new players are merely siblings of the old players" newUniClasses _ newVal! ! !Morph methodsFor: 'copying' stamp: 'dew 6/1/2003 23:54'! usableSiblingInstance "Return another similar morph whose Player is of the same class as mine" | aName usedNames newPlayer newMorph topRenderer | (topRenderer := self topRendererOrSelf) == self ifFalse: [^topRenderer usableSiblingInstance]. self assuredPlayer assureUniClass. newMorph := self veryDeepCopySibling. newPlayer := newMorph player. newPlayer resetCostumeList. (aName := self knownName) isNil ifTrue: [self player notNil ifTrue: [aName := newMorph innocuousName]]. "Force a difference here" aName notNil ifTrue: [usedNames := (self world ifNil: [OrderedCollection new] ifNotNil: [self world allKnownNames]) copyWith: aName. newMorph setNameTo: (Utilities keyLike: aName satisfying: [:f | (usedNames includes: f) not])]. newMorph privateOwner: nil. newMorph renderedMorph eventHandler notNil ifTrue: [newPlayer assureEventHandlerRepresentsStatus]. self currentWorld addMorphBack: newMorph. self presenter flushPlayerListCache. ^newMorph! ! Object removeSelector: #veryDeepCopyWithSiblingOf:! Object removeSelector: #veryDeepPvtSibling:!