[elephant-cvs] CVS elephant/src/elephant
ieslick
ieslick at common-lisp.net
Sun Mar 25 14:57:49 UTC 2007
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 , at 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
;; ===============================
More information about the Elephant-cvs
mailing list