anchor.diff:  If these sorts of operations are inappropriate for your class, you
   must not inherit from `data'."))
   
  -(defmethod clone ((object data))
  -  (clone-slots (mapcar 'closer-mop:slot-definition-name (closer-mop:class-slots (class-of object)))
  -               object
  -               (allocate-instance (class-of object))))
  +(defun clone-object (object &rest initargs &key &allow-other-keys)
  +  "Create a clone of `object' and initialize it with the provided
  +initargs.
  +
  +This function first allocates a new instance of `object''s class.  It
  +then copies the values of `object''s slots into the new instances.
  +Finally, it calls `shared-initialize' passing in the provided
  +initargs.
  +
  +Note that this function passes in nil as the list of slot names to
  +`shared-initialize'.  So, the cloned instance will not have any slots
  +initialized according to the class's initforms."
  +  (let* ((class (class-of object))
  +         (new-instance (allocate-instance class)))
  +    (dolist (slot (closer-mop:class-slots class))
  +      (let ((name (closer-mop:slot-definition-name slot)))
  +        ;; The standard allows allocate-instance to return objects
  +        ;; with slots already bound.  So, we're going to make sure
  +        ;; that new-instance's slots have the exact same values as
  +        ;; object's slots.
  +        (if (slot-boundp object name)
  +            (setf (slot-value new-instance name) (slot-value object name))
  +            (slot-makunbound new-instance name))))
  +    (apply 'shared-initialize new-instance nil initargs)
  +    new-instance))
  +
  +(defmethod clone ((object data) &rest initargs &key &allow-other-keys)
  +  (apply 'clone-object object initargs))
   
   (defmethod fset:compare ((first data) (second data))
     (labels
  
positive.code:                ,,set-var)
              `(,',getter-name ,,inner-clone)))))))
  
  (defun clone-slots (slots old new)
    "For each given slot name, store `old''s value in `new'."
    (dolist (slot slots)
      (when (slot-boundp old slot)
        (setf (slot-value new slot) (slot-value old slot))))
    new)
  
  (defgeneric clone (object)
    (:documentation
     "Create a shallow clone of the given object which contains the same data.
  
  If you wish to use `define-cloning-setf-expander' to access parts of a
  type, you must define a method for that type which returns an object
  which is not `eq' to the input object."))
  (defmethod clone (object)
    object)
  
  (defclass data-class (standard-class)
    ()
  
negative.code:   (:import-from :closer-mop)
    (:import-from :fset)
    (:export
     #:define-data #:define-cloning-setf-expander #:clone #:data-class #:data
     #:define-clone-method #:clone-object))
  (in-package :shcl/core/data)
  
  (optimization-settings)
  