是否有克隆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))

你需要一些MOP支持class-slots和slot-definition-name.

(我可能从旧的cll线程中采用了这个,但我记不起来了.我从来没有真正需要这样的东西,所以它完全没有经过测试.)

您可以像这样使用它(使用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))))