[elephant-cvs] CVS elephant/src/elephant

[ieslick]

Update of /project/elephant/cvsroot/elephant/src/elephant
In directory clnet:/tmp/cvs-serv9012

Modified Files:
	classes.lisp classindex-utils.lisp classindex.lisp 
Log Message:
Fix reconnect to derived index bug under :class synchronization policy

--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/02/14 04:36:10	1.13
+++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/02/18 23:38:18	1.14
@@ -130,14 +130,14 @@
   (let* ((class (find-class (class-name (class-of instance))))
 	 (oid (oid instance))
 	 (persistent-slot-names (persistent-slot-names class)))
-    (flet ((persistent-slot-p (item) 
+    (flet ((persistent-slot-p (item)
 	     (member item persistent-slot-names :test #'eq)))
       (let ((transient-slot-inits 
 	     (if (eq slot-names t)	; t means all slots
 		 (transient-slot-names class)
 		 (remove-if #'persistent-slot-p slot-names)))
 	    (persistent-slot-inits
-	     (if (eq slot-names t) 
+	     (if (eq slot-names t)
 		 persistent-slot-names
 		 (remove-if-not #'persistent-slot-p slot-names))))
 	(inhibit-indexing oid)
--- /project/elephant/cvsroot/elephant/src/elephant/classindex-utils.lisp	2007/02/02 23:51:58	1.4
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex-utils.lisp	2007/02/18 23:38:18	1.5
@@ -12,6 +12,8 @@
 
 (in-package :elephant)
 
+(declaim #-elephant-without-optimize (optimize (speed 3) (safety 1)))
+
 ;;
 ;; Simple utilities for managing synchronization between class
 ;; definitions and database state
@@ -226,7 +228,6 @@
   (simple-match-set (synch-rule-lhs rule) features))
 
 (defun simple-match-set (a b)
-  (declare (optimize (speed 3) (safety 1)))
   (cond ((null a) t)
 	((and (not (null a)) (null b)) nil)
 	((member (first a) b :test #'equal)
@@ -252,7 +253,6 @@
 	 (warn (warn "Performing slot synchronization actions: ~A" (synch-rule-rhs rule))))))
 
 (defun apply-synch-rules (class records rule-set)
-  (declare (optimize (speed 3) (safety 1)))
   (labels ((slotname (rec) (car rec))
 	   (feature-set (rec) (cdr rec)))
     (loop for record in records do
@@ -267,8 +267,7 @@
   (let* ((*store-controller* store-controller)
 	 ;; db info
 	 (db-indices (find-inverted-index-names class))
-	 (db-derived (mapcar #'get-derived-name-root
-			     (remove-if-not #'derived-name? db-indices)))
+	 (db-derived (remove-if-not #'derived-name? db-indices))
 	 (db-slot (set-difference db-indices db-derived))
 	 ;; class info
 	 (marked-slots (indexing-record-slots (indexed-record class)))
--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/02/14 04:36:10	1.17
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/02/18 23:38:18	1.18
@@ -266,7 +266,8 @@
 (defmethod remove-class-slot-index ((class symbol) slot-name &key (sc *store-controller*))
   (remove-class-slot-index (find-class class) slot-name :sc sc))
 	     
-(defmethod remove-class-slot-index ((class persistent-metaclass) slot-name &key (sc *store-controller*) (update-class t))
+(defmethod remove-class-slot-index ((class persistent-metaclass) slot-name &key 
+				    (sc *store-controller*) (update-class t))
   ;; NOTE: Write routines to recover BDB storage when you've wiped an index...
   ;; NOTE: If the transaction aborts we should not update class slots?
   (if (find-inverted-index class slot-name :null-on-fail t)
@@ -282,7 +283,8 @@
 (defmethod add-class-derived-index ((class symbol) name derived-defun &key (sc *store-controller*) (populate t))
   (add-class-derived-index (find-class class) name derived-defun :sc sc :populate populate))
 
-(defmethod add-class-derived-index ((class persistent-metaclass) name derived-defun &key (populate t) (sc *store-controller*) (update-class t))
+(defmethod add-class-derived-index ((class persistent-metaclass) name derived-defun &key 
+				    (populate t) (sc *store-controller*) (update-class t))
   (let ((class-idx (find-class-index class :sc sc)))
     (if (find-inverted-index class (make-derived-name name) :null-on-fail t)
 	(error "Duplicate derived index requested named ~A on class ~A" name (class-name class))
@@ -297,7 +299,8 @@
 (defmethod remove-class-derived-index ((class symbol) name &key (sc *store-controller*))
   (remove-class-derived-index (find-class class) name :sc sc))
 	     
-(defmethod remove-class-derived-index ((class persistent-metaclass) name &key (sc *store-controller*) (update-class t))
+(defmethod remove-class-derived-index ((class persistent-metaclass) name &key 
+				       (sc *store-controller*) (update-class t))
   (if (find-inverted-index class name :null-on-fail t)
       (progn
 	(when update-class (unregister-derived-index class name))