[elephant-cvs] CVS elephant/src

[ieslick]

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv16040/src

Modified Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	IAN-TODO bdb-enable.lisp classes.lisp indexing.lisp 
	metaclasses.lisp 
Log Message:


--- /project/elephant/cvsroot/elephant/src/bdb-enable.lisp	2006/01/26 04:03:44	1.4.2.1
+++ /project/elephant/cvsroot/elephant/src/bdb-enable.lisp	2006/01/27 00:03:49	1.4.2.2
@@ -41,11 +41,12 @@
 ;;; to the Free Software Foundation, Inc., 59 Temple Place,
 ;;; Suite 330, Boston, MA 02111-1307 USA
 ;;;
-;; (defpackage ele-bdb
-;;   (:documentation 
-;;    "ELE-BDB: This is just a marker-pacakge to show whether or not
-;; the Berkeley-DB code is enabled.")
-;;   (:nicknames ele-bdb :ele-bdb))
+
+(defpackage ele-bdb
+  (:documentation 
+   "ELE-BDB: This is just a marker-pacakge to show whether or not
+the Berkeley-DB code is enabled.")
+   (:nicknames ele-bdb :ele-bdb))
 
 #+cmu
 (eval-when (:compile-toplevel)
--- /project/elephant/cvsroot/elephant/src/classes.lisp	2006/01/26 04:03:44	1.16.2.1
+++ /project/elephant/cvsroot/elephant/src/classes.lisp	2006/01/27 00:03:49	1.16.2.2
@@ -133,15 +133,18 @@
       (make-instances-obsolete instance))))
 
 ;; #+allegro
-(defmethod finalize-inheritance :around ((instance persistent-metaclass))
+(defmethod finalize-inheritance :around ((class persistent-metaclass))
   (prog1
       (call-next-method)
-    (if (not (slot-boundp instance '%persistent-slots))
-	(setf (%persistent-slots instance) 
-	      (cons (persistent-slot-names instance) nil)))
-    (if (not (slot-boundp instance '%indexed-slots))
-	(setf (%indexed-slots instance) 
-	      (cons (indexed-slot-names instance) nil)))))
+    (when (not (slot-boundp class '%persistent-slots))
+	(setf (%persistent-slots class) 
+	      (cons (persistent-slot-names class) nil)))
+    (when (not (slot-boundp class '%indexed-slots))
+	(setf (%indexed-slots class) 
+	      (cons (indexed-slot-names class) nil)))
+    (when (not (slot-boundp class '%derived-index-count))
+	(setf (%derived-index-count class) 0))))
+	     
 
 ;; #+(or cmu sbcl)
 ;; (defmethod finalize-inheritance :around ((instance persistent-metaclass))
@@ -200,7 +203,7 @@
   ;; probably should delete discarded slots, but we'll worry about that later
   (prog1
       (call-next-method)
-    (format t "persisent-slots ~A~%" (persistent-slots (class-of instance)))
+;;    (format t "persisent-slots ~A~%" (persistent-slots (class-of instance)))
 ;;    (format t "slot-boundp ~A~%" (slot-boundp instance '%persistent-slots))
     (let* ((class (class-of instance))
 	   (new-persistent-slots (set-difference (persistent-slots class)
@@ -249,9 +252,9 @@
   "Set the slot value in the database."
   (declare (optimize (speed 3)))
   (let ((name (slot-definition-name slot-def)))
-    (persistent-slot-writer new-value instance name)))
-;;    (when (%indexed-p class)
-;;      (update-class-index class instance))))
+    (persistent-slot-writer new-value instance name)
+    (when (%indexed-p class)
+      (update-class-index class instance))))
 
 (defmethod slot-boundp-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Checks if the slot exists in the database."
--- /project/elephant/cvsroot/elephant/src/metaclasses.lisp	2006/01/26 04:03:44	1.10.2.1
+++ /project/elephant/cvsroot/elephant/src/metaclasses.lisp	2006/01/27 00:03:49	1.10.2.2
@@ -89,6 +89,7 @@
 (defclass persistent-metaclass (standard-class)
   ((%persistent-slots :accessor %persistent-slots)
    (%indexed-slots :accessor %indexed-slots)
+   (%derived-index-count :accessor %derived-index-count)
    (%instance-index :accessor %instance-index))
   (:documentation 
    "Metaclass for persistent classes.  Use this metaclass to
@@ -117,8 +118,10 @@
  					    )))
 
 (defmethod %indexed-p ((class persistent-metaclass))
-  (and (slot-boundp class '%indexed-slots)
-       (car (%indexed-slots class))))
+  (or (and (slot-boundp class '%indexed-slots)
+	   (car (%indexed-slots class)))
+      (and (slot-boundp class '%derived-index-count)
+	   (> (%derived-index-count class) 0))))
 
 (defmethod indexed-slots ((class persistent-metaclass))
   (car (%indexed-slots class)))
@@ -304,7 +307,7 @@
 	   (let ((buf (db-get-key-buffered 
 		       (controller-db (check-con (:dbcn-spc-pst ,instance))) 
 						 key-buf value-buf)))
-		   (if buf (deserialize buf  :sc (check-con (:dbcn-spc-pst instance)))
+		   (if buf (deserialize buf  :sc (check-con (:dbcn-spc-pst ,instance)))
 		       #+cmu
 		       (error 'unbound-slot :instance ,instance :slot ,name)
 		       #-cmu