[elephant-cvs] CVS update: elephant/src/classes.lisp

[blee at common-lisp.net]

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp.net:/tmp/cvs-serv2234/src

Modified Files:
	classes.lisp 
Log Message:
added preliminary support for change-class (though redef
class is broken.)

Date: Tue Sep 21 21:35:29 2004
Author: blee

Index: elephant/src/classes.lisp
diff -u elephant/src/classes.lisp:1.11 elephant/src/classes.lisp:1.12
--- elephant/src/classes.lisp:1.11	Sun Sep 19 19:47:44 2004
+++ elephant/src/classes.lisp	Tue Sep 21 21:35:29 2004
@@ -111,6 +111,20 @@
 	;; let the implementation initialize the transient slots
 	(apply #'call-next-method instance transient-slot-inits initargs)))))
 
+(defmethod update-instance-for-different-class :around ((previous persistent) (current persistent) &rest initargs &key)
+  "Need to also update the persistent-slots, which have
+:class allocation."
+  (let ((new-persistent-slots 
+	 (loop for slotd in (class-slots (class-of current))
+	       for slot-name = (slot-definition-name slotd)
+	       with old-slot-names = (mapcar #'slot-definition-name
+					     (class-slots (class-of previous)))
+	       when (and (not (member slot-name old-slot-names :test #'eq))
+			 (persistent-p slotd))
+	       collect slot-name)))
+    (apply #'shared-initialize current new-persistent-slots initargs)
+    (call-next-method)))
+
 (defmethod slot-value-using-class :around (class (instance persistent-object) (slot-def persistent-slot-definition))
   "Get the slot value from the database."
   (declare (optimize (speed 3))