Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv18051/src/elephant
Modified Files: classindex.lisp collections.lisp controller.lisp metaclasses.lisp Log Message: :from-end option for map-index and simple test; better error handling and argument checking
--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/04/12 02:47:32 1.36 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/04/23 02:26:53 1.37 @@ -394,11 +394,11 @@ (declare (dynamic-extent map-fn)) (map-btree #'map-fn class-idx))))
-(defun map-class-index (fn class index &rest args &key start end value) - "This function maps over a subset of class instances in the - order defined by the index. Specify the class and index by - quoted name. The index may be a slot index or a derived - index. +(defun map-class-index (fn class index &rest args &key start end value from-end) + "map-class-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 + name. The index may be a slot index or a derived index.
To map only a subset of key-value pairs, specify the range using the :start and :end keywords; all elements greater than @@ -410,17 +410,20 @@ element or last element, respectively.
To map a single value, iff it exists, use the :value keyword. - This is the only way to travers all nil values." + This is the only way to travers all nil values. + + To map from :end to :start in descending order, set :from-end + to true. If :value is used, :from-end is ignored" (declare (dynamic-extent args) (ignorable args)) (let* ((index (if (symbolp index) (find-inverted-index class index) index))) (flet ((wrapper (key value pkey) - (declare (ignore key pkey)) - (funcall fn value))) + (declare (ignore pkey)) + (funcall fn key value))) (declare (dynamic-extent wrapper)) - (map-index #'wrapper index :start start :end end :value value)))) + (map-index #'wrapper index :start start :end end :value value :from-end from-end))))
;; ================= --- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/04/19 05:24:37 1.22 +++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/04/23 02:26:53 1.23 @@ -382,7 +382,7 @@ (funcall fn k v) (return nil)))))))))
-(defgeneric map-index (fn index &rest args &key start end value) +(defgeneric map-index (fn index &rest args &key start end value from-end) (:documentation "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 @@ -393,47 +393,75 @@ use the value keyword which will override any values of start and end."))
-(defmethod map-index (fn (index btree-index) &rest args &key start end (value nil value-set-p)) +(defun pprev-hack (cur) + "Get the first duplicate instance of the prior value off the current cursor" + (let ((e? (cursor-pprev-nodup cur))) + (when e? + (let ((e? (cursor-pprev-nodup cur))) + (if e? + (cursor-pnext cur) + (cursor-pfirst cur)))))) + +(defun cursor-last-range-hack (cur) + "Get the first duplicate instance of the last value of the cursor's index" + (let ((e? (cursor-plast cur))) + (when e? + (let ((e? (cursor-pprev-nodup cur))) + (if e? + (cursor-pnext cur) + (cursor-pfirst cur)))))) + + +(defmethod map-index (fn (index btree-index) &rest args &key start end (value nil value-set-p) from-end) (declare (dynamic-extent args) (ignorable args)) + (unless (lisp-compare<= start end) + (error "map-index called with start = ~A and end = ~A. Start must be less than or equal to end according to elephant::lisp-compare<=." + start end)) (let ((sc (get-con index)) (end (or value end))) (ensure-transaction (:store-controller sc) (with-btree-cursor (cur index) - (labels ((next-range () - (multiple-value-bind (exists? skey val pkey) (cursor-pnext-nodup cur) - (if (and exists? - (or (null end) - (lisp-compare<= skey end))) - (progn - (funcall fn skey val pkey) - (next-in-range skey)) - (return-from map-index nil)))) - (next-in-range (key) - (multiple-value-bind (exists? skey val pkey) (cursor-pnext-dup cur) - (if exists? + (labels ((continue-p (key) ;; Do we got to the next value? + (or (if from-end (null start) (null end)) + (if from-end + (or (not (lisp-compare<= key start)) + (lisp-compare-equal key start)) + (lisp-compare<= key end)))) + (value-increment () ;; Step to the next key value + (if from-end + (pprev-hack cur) + (cursor-pnext-nodup cur))) + (next-value () ;; Handle the next key value + (multiple-value-bind (exists? skey val pkey) + (value-increment) + (if (and exists? (continue-p skey)) (progn (funcall fn skey val pkey) - (next-in-range key)) - (progn - (cursor-pset-range cur key) - (next-range)))))) - (declare (dynamic-extent next-range next-in-range)) + (map-duplicates skey)) + (return-from map-index nil)))) + (map-duplicates (key) ;; Map all duplicates for key value + (loop as (exists? skey val pkey) = (multiple-value-list (cursor-pnext-dup cur)) + while exists? do (funcall fn skey val pkey)) + (cursor-pset-range cur key) + (next-value))) + (declare (dynamic-extent next-value next-value-increment continue-p map-duplicates)) (multiple-value-bind (exists? skey val pkey) (cond (value-set-p (cursor-pset cur value)) - ((null start) + ((and (not from-end) (null start)) (cursor-pfirst cur)) - (t (cursor-pset-range cur start))) - (if (and exists? - (or (null end) - (lisp-compare<= skey end))) + ((and from-end (null end)) + (cursor-last-range-hack cur)) + (t (if from-end + (cursor-pset-range cur end) + (cursor-pset-range cur start)))) + (if (and exists? (continue-p skey)) (progn (funcall fn skey val pkey) - (next-in-range skey)) + (map-duplicates skey)) nil)))))))
- ;; =============================== ;; Some generic utility functions ;; =============================== --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/04/22 03:35:09 1.48 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/04/23 02:26:53 1.49 @@ -64,7 +64,7 @@ (defun signal-controller-lost-error (object) (cerror "Open a new instance and continue?" 'controller-lost-error - :format-string "Store controller for specification ~A for object ~A cannot be found." + :format-control "Store controller for specification ~A for object ~A cannot be found." :format-arguments (list object (dbcn-spc-pst object)) :object object :spec (dbcn-spc-pst object))) --- /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp 2007/04/12 02:47:32 1.16 +++ /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp 2007/04/23 02:26:53 1.17 @@ -32,6 +32,10 @@ (:documentation "Abstract superclass for all persistent classes (common to both user-defined classes and Elephant-defined objects such as collections.)"))
+(defmethod print-object ((obj persistent) stream) + "This is useful for debugging and being clear about what is persistent and what is not" + (format stream "#<~A oid:~A>" (type-of obj) (oid obj))) + (defclass persistent-metaclass (standard-class) ((%persistent-slots :accessor %persistent-slots) (%indexed-slots :accessor %indexed-slots)