2012-06-16 10 views
6

Estoy buscando una manera de clonar objetos CLOS de una manera superficial, por lo que el objeto creado sería del mismo tipo con los mismos valores en cada ranura, pero una nueva instancia. Lo más parecido que encontré es una estructura de copia de función estándar que hace esto para las estructuras.¿Existe un método genérico para clonar objetos CLOS?

Respuesta

10

No existe una forma estándar predefinida para copiar objetos CLOS en general. No es trivial, si es posible en absoluto, proporcionar una operación de copia predeterminada razonable que haga lo correcto (al menos) la mayor parte del tiempo para objetos arbitrarios, ya que la semántica correcta cambia de clase a clase y de aplicación a aplicación. Las posibilidades extendidas que proporciona el MOP hacen que sea aún más difícil proporcionar dicho valor predeterminado. Además, en CL, al ser un lenguaje recogido de basura, la copia de objetos no se necesita con mucha frecuencia, p. cuando se pasa como parámetros o se devuelve. Por lo tanto, la implementación de sus operaciones de copia según sea necesario probablemente sea la solución más limpia.

Dicho esto, aquí es lo que encontré en uno de mis archivos de fragmento, lo que puede hacer lo que quiera:

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

Se necesita algo de ayuda para el MOP class-slots y slot-definition-name.

(probablemente adoptó esto desde an old c.l.l thread, pero no recuerdo que nunca realmente se necesita algo como esto, así que es completamente sin probar..)

Usted puede utilizar de esta manera (probado con 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> 
+5

Puede ser útil agregar una prueba si una ranura está vinculada o no. Luego acceda al valor de la ranura solamente, si la ranura está vinculada. –

+1

Tienes razón, agregué la prueba. ¡Gracias! – danlei

+1

Funciona según lo anunciado. Aquí está una declaración de importación que debe hacer que funcione de una manera más o menos portátiles: '(: remedo de importación y de \t # + openmcl nativo-hilos #: CCL \t # + CMU #: PCL \t # + sbcl #: SB-pcl \t # + # LispWorks: HCl + \t # Allegro #: mopa \t # + # clisp: clos \t #: # clase ranuras: ranura para definición de nombres) '. – Inaimathi

4

Aquí hay una versión ligeramente diferente de la función presentada por danlei. Escribí esto hace un tiempo y me encontré con esta publicación. Por razones que no recuerdo del todo, esto llama REINITIALIZE-INSTANCE después de copiar. I piensa es para que pueda hacer algunos cambios en el nuevo objeto pasando initargs adicionales a esta función

p.

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

Esto también se define como función genérica sobre los objetos que son 'estándar-objeto de. Lo que podría o no ser lo correcto.

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

Exactamente lo que estaba buscando; Me sorprendió que esto no exista por defecto en Common Lisp. – MicroVirus

Cuestiones relacionadas