8

我正在寻找一种以浅层方式克隆 CLOS 对象的方法，因此创建的对象将是相同类型，每个插槽中的值相同，但是是一个新实例。我发现最接近的是标准函数复制结构，它对结构执行此操作。

4

4 回答 4

12

一般来说，没有标准的预定义方法来复制 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您将需要对和的一些 MOP 支持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>
于 2012-06-17T02:40:40.887 回答
8

这是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))))
于 2013-02-26T20:34:49.867 回答
0

此解决方案不需要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)
于 2020-03-28T14:46:21.960 回答
-1

我提到了一个产生 CLOS 实例克隆的肮脏技巧。

(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

暗示 CLOS 本身需要一个克隆的概念。

于 2020-06-04T14:47:56.587 回答