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