Вопрос по common-lisp, clone, object, clos – Существует ли универсальный метод для клонирования объектов CLOS?

7

Я ищу способ клонировать объекты CLOS поверхностным способом, чтобы созданный объект был того же типа с теми же значениями в каждом слоте, но новым экземпляром. Самое близкое, что я нашел, - это стандартная функция copy-structure, которая делает это для структур.

Ваш Ответ

2   ответа
11

Нет стандартного предопределенного способа копирования объектов 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.

(Я, вероятно, принял это отстарая нить, но я не могу вспомнить. Мне никогда не нужно было что-то подобное, так что это совершенно не проверено.)

Вы можете использовать его следующим образом (протестировано с 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>
Может быть полезно добавить тест, если слот связан или нет. Затем получите доступ только к значению слота, если слот привязан.
Вы правы & # x2013; Я добавил тест. Спасибо!
Работает как рекламируется. Вот оператор импорта, который должен заставить его работать более или менее переносимым способом:(:shadowing-import-from #+openmcl-native-threads #:ccl #+cmu #:pcl #+sbcl #:sb-pcl #+lispworks #:hcl #+allegro #:mop #+clisp #:clos #:class-slots #:slot-definition-name).
6

Вот немного другая версия функции, представленная danlei. Я написал это некоторое время назад и просто наткнулся на этот пост. По причинам, которые я полностью не помню, это вызывает REINITIALIZE-INSTANCE после копирования. яthink это так, чтобы вы могли внести некоторые изменения в новый объект, передав дополнительные 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))))
Именно то, что я искал; Я был удивлен, что это не существует по умолчанию в Common Lisp.

Похожие вопросы