[elephant-cvs] CVS elephant/src/elephant
ieslick
ieslick at common-lisp.net
Mon Apr 23 02:26:54 UTC 2007
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)
More information about the Elephant-cvs
mailing list