克隆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))))