Is there a generic method for cloning CLOS objects?

Question

I'm looking for a way to clone CLOS objects in a shallow manner, so the created object would be of the same type with the same values in each slot, but a new instance. The closest thing I found is a standard function copy-structure which does this for structures.

Answer 1

There is no standard predefined way to copy CLOS objects in general. It is not trivial, if possible at all, to provide a reasonable default copy operation that does the right thing (at least) most of the time for arbitrary objects, since the correct semantics change from class to class and from application to application. The extended possibilities the MOP provides make it even harder to provide such a default. Also, in CL, being a garbage collected language, copying of objects is not really needed very often, e.g. when passed as parameters or being returned. So, implementing your copy operations as needed would probably be the cleanest solution.

That being said, here is what I found in one of my snippet files, which might do what you want:

(defun shallow-copy-object (original)
  (let* ((class (class-of original))
         (copy (allocate-instance class)))
    (dolist (slot (mapcar #'slot-definition-name (class-slots class)))
      (when (slot-boundp original slot)
        (setf (slot-value copy slot)
              (slot-value original slot))))
    copy))

You will need some MOP support for class-slots and slot-definition-name.

(I probably adopted this from an old c.l.l thread, but I can't remember. I never really needed something like this, so it's utterly untested.)

You can use it like this (tested with CCL):

CL-USER> (defclass foo ()
           ((x :accessor x :initarg :x)
            (y :accessor y :initarg :y)))
#<STANDARD-CLASS FOO>
CL-USER> (defmethod print-object ((obj foo) stream)
           (print-unreadable-object (obj stream :identity t :type t)
             (format stream ":x ~a :y ~a" (x obj) (y obj))))
#<STANDARD-METHOD PRINT-OBJECT (FOO T)>
CL-USER> (defparameter *f* (make-instance 'foo :x 1 :y 2))
*F*
CL-USER> *f*
#<FOO :x 1 :y 2 #xC7E5156>
CL-USER> (shallow-copy-object *f*)
#<FOO :x 1 :y 2 #xC850306>

Answer 2

Here's a slightly different version of the function submitted by danlei. I wrote this a while ago and just stumbled across this post. For reasons that I don't entirely recall, this calls REINITIALIZE-INSTANCE after copying. I think it's so you could make some changes to the new object by passing additional initargs to this function

e.g.

(copy-instance *my-account* :balance 100.23)

This is also defined as generic function over objects that are 'standard-object's. Which might or might not be the right thing to do.

(defgeneric copy-instance (object &rest initargs &key &allow-other-keys)
  (:documentation "Makes and returns a shallow copy of OBJECT.

  An uninitialized object of the same class as OBJECT is allocated by
  calling ALLOCATE-INSTANCE.  For all slots returned by
  CLASS-SLOTS, the returned object has the
  same slot values and slot-unbound status as OBJECT.

  REINITIALIZE-INSTANCE is called to update the copy with INITARGS.")
  (:method ((object standard-object) &rest initargs &key &allow-other-keys)
    (let* ((class (class-of object))
           (copy (allocate-instance class)))
      (dolist (slot-name (mapcar #'sb-mop:slot-definition-name (sb-mop:class-slots class)))
        (when (slot-boundp object slot-name)
          (setf (slot-value copy slot-name)
            (slot-value object slot-name))))
      (apply #'reinitialize-instance copy initargs))))

Answer 3

This solution does not require sl-mob:

(defun copy-slot (s d slot)
  `(setf (,slot ,d) (,slot ,s)))

(defun copy-by-slots (s d slots)
  (assert (eql (class-of s) (class-of d)))
  (let ((f (lambda (s$) (eval (copy-slot s d s$)))))
    (mapcar f slots)))

(copy-by-slots src dest quoted-list-of-slots)

Answer 4

I mention a dirty trick producing a clone of a CLOS instance.

(defclass cl () ((sl1 :initarg :sl1) (sl2 :initarg :sl2)))

(defmethod update-instance-for-different-class ((copy cl) (original cl) &key)
  (setf clone copy))

(setf a (make-instance 'cl :sl1 111 :sl2 222))

(change-class a 'cl)

(eq clone a) -> NIL
(eql (slot-value a 'sl1) (slot-value clone 'sl1)) -> T

Implies CLOS itself needs a notion of clone.