[elephant-cvs] CVS elephant/src/elephant

[ieslick]

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

Modified Files:
	classindex.lisp controller.lisp 
Log Message:
Fixed test bug; cleaned up get-instances-by-xxx fns to use new map operators

--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/04/28 02:31:15	1.40
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/04/28 03:07:38	1.41
@@ -389,7 +389,7 @@
 ;;    USER MAPPING API 
 ;; ======================
 
-(defun map-class (fn class)
+(defun map-class (fn class &key collect)
   "Perform a map operation over all instances of class.  Takes a
    function of one argument, a class instance"
   (let* ((class (if (symbolp class)
@@ -400,9 +400,9 @@
 	     (declare (ignore k))
 	     (funcall fn v)))
       (declare (dynamic-extent map-fn))
-      (map-btree #'map-fn class-idx))))
+      (map-btree #'map-fn class-idx :collect collect))))
 
-(defun map-inverted-index (fn class index &rest args &key start end value from-end)
+(defun map-inverted-index (fn class index &rest args &key start end (value nil value-p) from-end collect)
   "map-inverted-index maps a function of two variables, taking key
    and instance, over a subset of class instances in the order
    defined by the index.  Specify the class and index by quoted
@@ -431,7 +431,10 @@
 	     (declare (ignore pkey))
 	     (funcall fn key value)))
       (declare (dynamic-extent wrapper))
-      (map-index #'wrapper index :start start :end end :value value :from-end from-end))))
+      (if value-p
+	  (map-index #'wrapper index :value value :collect collect)
+	  (map-index #'wrapper index :start start :end end :from-end from-end :collect collect)))))
+		    
 
 
 ;; =================
@@ -454,30 +457,27 @@
                    nil to start or end indicates, respectively,
                    the lowest or highest value in the index"))
 
+
+(defun identity2 (k v)
+  (declare (ignore k))
+  v)
+
+(defun identity3 (k v pk)
+  (declare (ignore k pk))
+  v)
+
 (defmethod get-instances-by-class ((class symbol))
   (get-instances-by-class (find-class class)))
 
 (defmethod get-instances-by-class ((class persistent-metaclass))
-  (let ((instances nil))
-    (flet ((accum (c)
-	     (declare (dynamic-extent c))
-	     (push c instances)))
-      (map-class #'accum class)
-      (nreverse instances))))
+  (map-class #'identity class :collect t))
 
 (defmethod get-instances-by-value ((class symbol) slot-name value)
   (get-instances-by-value (find-class class) slot-name value))
 
 (defmethod get-instances-by-value ((class persistent-metaclass) slot-name value)
   (declare (type (or string symbol) slot-name))
-  (let ((instances nil))
-    (declare (type list instances))
-    (flet ((collector (k v pk)
-	     (declare (ignore k pk))
-	     (push v instances)))
-      (declare (dynamic-extent collector))
-      (map-index #'collector (find-inverted-index class slot-name) :value value))
-    (nreverse instances)))
+  (map-inverted-index #'identity2 class slot-name :value value :collect t))
 
 (defmethod get-instance-by-value ((class symbol) slot-name value)
   (let ((list (get-instances-by-value (find-class class) slot-name value)))
@@ -495,15 +495,7 @@
 (defmethod get-instances-by-range ((class persistent-metaclass) idx-name start end)
   (declare (type (or fixnum null) start end)
 	   (type symbol idx-name))
-  (let ((instances nil))
-    (declare (type list instances))
-    (flet ((collector (k v pk)
-	     (declare (ignore k pk))
-	     (push v instances)))
-      (declare (dynamic-extent collector))
-      (map-index #'collector (find-inverted-index class idx-name)
-		 :start start :end end))
-    (nreverse instances)))
+  (map-inverted-index #'identity2 class idx-name :start start :end end :collect t))
 
 (defun drop-instances (instances &key (sc *store-controller*))
   "Removes a list of persistent objects from all class indices
--- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp	2007/04/28 02:31:15	1.51
+++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp	2007/04/28 03:07:38	1.52
@@ -220,7 +220,7 @@
   "Reset the instance cache (flush object lookups).  Useful 
    for testing.  Does not reclaim existing objects so there
    will be duplicate instances with identical functionality"
-  (ele-with-lock ((instance-cache-lock sc))
+  (ele-with-fast-lock ((instance-cache-lock sc))
     (setf (instance-cache sc)
 	  (make-cache-table :test 'eql))))