Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv32631/elephant
Modified Files: classindex.lisp collections.lisp Log Message: Another fix for map-index / map-class-index and adding ranges for map-btree (but not map-class
--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/03/24 12:16:03 1.32 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/03/25 14:57:49 1.33 @@ -373,10 +373,12 @@ (declare (dynamic-extent map-fn)) (map-btree #'map-fn class-idx))))
-(defun map-class-index (fn class index start end) - "If you want to map over a subset of instances, pick an index - and specify bounds for the traversal. Otherwise use map-class - for all instances" +(defun map-class-index (fn class index &rest args &key start end value) + "To map over a subset of instances, pick an index by slot name + or derived index name and specify the bounds for the traversal. + Otherwise use map-class for all instances. " + (declare (dynamic-extent args) + (ignorable args)) (let* ((index (if (symbolp index) (find-inverted-index class index) index))) @@ -384,7 +386,7 @@ (declare (ignore key pkey)) (funcall fn value))) (declare (dynamic-extent wrapper)) - (map-index #'wrapper index :start start :end end)))) + (map-index #'wrapper index :start start :end end :value value))))
;; ================= @@ -426,8 +428,7 @@ (declare (ignore k pk)) (push v instances))) (declare (dynamic-extent collector)) - (map-index #'collector (find-inverted-index class slot-name) - :start value :end value)) + (map-index #'collector (find-inverted-index class slot-name) :value value)) (nreverse instances)))
(defmethod get-instance-by-value ((class symbol) slot-name value) --- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/03/23 16:18:59 1.18 +++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/03/25 14:57:49 1.19 @@ -318,11 +318,6 @@ different key.) Returns has-tuple / secondary key / value / primary key."))
- -;; ======================================= -;; Generic Mapping Functions -;; ======================================= - (defmacro with-btree-cursor ((var bt) &body body) "Macro which opens a named cursor on a BTree (primary or not), evaluates the forms, then closes the cursor." @@ -331,16 +326,9 @@ (progn ,@body) (cursor-close ,var))))
-(defmethod map-btree (fn (btree btree)) - "Like maphash. Default implementation - overridable - Function of two arguments key and value" - (ensure-transaction (:store-controller (get-con btree)) - (with-btree-cursor (curs btree) - (loop - (multiple-value-bind (more k v) (cursor-next curs) - (declare (dynamic-extent more k v)) - (unless more (return nil)) - (funcall fn k v)))))) +;; ======================================= +;; Generic Mapping Functions +;; =======================================
(defun lisp-compare<= (a b) (etypecase a @@ -348,15 +336,52 @@ (string (string<= a b)) (persistent (<= (oid a) (oid b)))))
-(defun lisp-compare-eq (a b) - (eq a b)) +(defun lisp-compare-equal (a b) + (equal a b))
-(defmethod map-index (fn (index btree-index) &rest args &key start end) - "Like map-btree, but takes a function of three arguments key, value and primary key - if you want to get at the primary key value, otherwise use map-btree" +;; NOTE: the use of nil for the last element in a btree only works because the C comparison +;; function orders by type tag and nil is the highest valued type tag so nils are the last +;; possible element in a btree ordered by value. +(defmethod map-btree (fn (btree btree) &rest args &key start end (value nil value-set-p)) + "Map btree maps over a btree from the value start to the value of end. + If values are not provided, then it maps over all values. BTrees + do not have duplicates, but map-btree can also be used with indices + in the case where you don't want access to the primary key so we + require a value argument as well for mapping duplicate value sets." + (let ((end (if value-set-p value end))) + (ensure-transaction (:store-controller (get-con btree)) + (with-btree-cursor (curs btree) + (multiple-value-bind (exists? key value) + (cond (value-set-p + (cursor-set curs value)) + ((null start) + (cursor-first curs)) + (t (cursor-set-range curs start))) + (if exists? + (funcall fn key value) + (return-from map-btree nil)) + (loop + (multiple-value-bind (exists? k v) + (cursor-next curs) + (declare (dynamic-extent exists? k v)) + (if (and exists? (or (null end) (lisp-compare<= k end))) + (funcall fn k v) + (return nil))))))))) + +(defmethod map-index (fn (index btree-index) &rest args &key start end (value nil value-set-p)) + "Map-index is like map-btree but for secondary indices, it + takes a function of three arguments: key, value and primary + key. As with map-btree the keyword arguments start and end + determine the starting element and ending element, inclusive. + Also, start = nil implies the first element, end = nil implies + the last element in the index. If you want to traverse only a + set of identical key values, for example all nil values, then + use the value keyword which will override any values of start + and end." (declare (dynamic-extent args) (ignorable args)) - (let ((sc (get-con index))) + (let ((sc (get-con index)) + (end (or value end))) (ensure-transaction (:store-controller sc) (with-btree-cursor (cur index) (labels ((next-range () @@ -379,8 +404,8 @@ (next-range)))))) (declare (dynamic-extent next-range next-in-range)) (multiple-value-bind (exists? skey val pkey) - (cond ((lisp-compare-eq start end) - (cursor-pset cur start)) + (cond (value-set-p + (cursor-pset cur value)) ((null start) (cursor-pfirst cur)) (t (cursor-pset-range cur start))) @@ -393,7 +418,6 @@ nil)))))))
- ;; =============================== ;; Some generic utility functions ;; ===============================