克隆CLOS对象是否有一种通用方法？

Question

我正在寻找一种以浅的方式克隆CLOS对象的方法，因此创建的对象将具有相同类型，并且每个插槽中的值相同，但是是一个新实例。我发现最接近的是一个标准的功能复制结构，它可以为结构做到这一点。

Answer 1

通常没有标准的预定义方式来复制CLOS对象。如果可能的话，提供合理的默认复制操作（至少）大部分时间为任意对象执行正确的操作并不是微不足道的，因为正确的语义从类到类以及从应用程序到应用程序都会发生变化。 MOP提供的扩展可能性使得提供这种默认更加困难。而且，在CL中，作为垃圾收集语言，对象的拷贝并不是经常需要的，例如，当作为参数传递或返回时。因此，根据需要实施复制操作可能是最干净的解决方案。

话虽这么说，这里是我在我的代码片段文件一经发现，这可能会做你想要什么：

(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)) 

您将需要class-slots和slot-definition-name一些MOP支持。

（我大概是从an old c.l.l thread采用了这一点，但我不记得我从来没有真的需要这样的事情，所以这是完全未经测试。）

你可以使用它像这样（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

下面是danlei提交的函数的一个稍微不同的版本。我前一段时间写了这个，只是偶然发现了这篇文章。由于我不完全记得的原因，复制后这称为REINITIALIZE-INSTANCE。我认为它是这样的，你可以通过传递额外的initargs到这个函数来对新对象进行一些改变

例如，

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

这也被定义为'标准对象'的对象上的泛型函数。这可能或可能不是正确的做法。

(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))))