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

Modified Files: classes.lisp classindex.lisp collections.lisp Log Message: More documentation edits; performance and feature enhancements for map-index (from-end, collect); fix bug in slot initialization under from-oid

--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/04/22 03:35:09 1.29 +++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/04/24 03:02:27 1.30 @@ -129,7 +129,7 @@ (unwind-protect (progn ;; initialize the persistent slots ourselves - (initialize-persistent-slots class instance persistent-slot-inits initargs) + (initialize-persistent-slots class instance persistent-slot-inits initargs from-oid) ;; let the implementation initialize the transient slots (apply #'call-next-method instance transient-slot-inits initargs)) (uninhibit-indexing oid)) @@ -144,7 +144,7 @@ (setf (get-value oid class-index) instance)))) ))))

-(defun initialize-persistent-slots (class instance persistent-slot-inits initargs) +(defun initialize-persistent-slots (class instance persistent-slot-inits initargs object-exists) (flet ((initialize-from-initarg (slot-def) (loop for initarg in initargs with slot-initargs = (slot-definition-initargs slot-def) @@ -157,7 +157,7 @@ (loop for slot-def in (class-slots class) unless (initialize-from-initarg slot-def) when (member (slot-definition-name slot-def) persistent-slot-inits :test #'eq) - unless (slot-boundp-using-class class instance slot-def) + unless (or object-exists (slot-boundp-using-class class instance slot-def)) do (let ((initfun (slot-definition-initfunction slot-def))) (when initfun --- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/04/23 02:26:53 1.37 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/04/24 03:02:27 1.38 @@ -394,8 +394,8 @@ (declare (dynamic-extent map-fn)) (map-btree #'map-fn class-idx))))

-(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 +(defun map-inverted-index (fn class index &rest args &key start end value from-end) + "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 name. The index may be a slot index or a derived index. --- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/04/23 02:41:11 1.24 +++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/04/24 03:02:27 1.25 @@ -22,6 +22,10 @@

(in-package "ELEPHANT")

+#-elephant-without-optimize +(eval-when (:compile-toplevel) + (declaim (optimize (speed 3) (safety 1) (space 1)))) + ;;; collection types ;;; we're slot-less (defclass persistent-collection (persistent) () @@ -382,7 +386,7 @@ (funcall fn k v) (return nil)))))))))

-(defgeneric map-index (fn index &rest args &key start end value from-end) +(defgeneric map-index (fn index &rest args &key start end value from-end collect) (: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,6 +397,72 @@ 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) from-end collect) + (declare (dynamic-extent args)) + (unless (or (null start) (null end) (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)) + (results nil)) + (flet ((collector (k v pk) + (push (funcall fn k v pk) results))) + (let ((fn (if collect #'collector fn))) + (declare (dynamic-extent (function collector))) + (ensure-transaction (:store-controller sc) + (with-btree-cursor (cur index) + (labels ((continue-p (key) + ;; Do we go 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) + (map-duplicates skey)) + (return-from map-index + (nreverse results))))) + (map-duplicates (key) + ;; Map all duplicates for key value + (multiple-value-bind (exists? skey val pkey) + (cursor-pnext-dup cur) + (if exists? + (progn + (funcall fn skey val pkey) + (map-duplicates key)) + (progn + (cursor-pset-range cur key) + (next-value)))))) + (declare (dynamic-extent (function next-value) (function next-value-increment) + (function continue-p) (function map-duplicates))) + (multiple-value-bind (exists? skey val pkey) + (cond (value-set-p + (cursor-pset cur value)) + ((and (not from-end) (null start)) + (cursor-pfirst cur)) + ((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) + (map-duplicates skey)) + nil))))))))) + (defun pprev-hack (cur) "Get the first duplicate instance of the prior value off the current cursor" (let ((e? (cursor-pprev-nodup cur))) @@ -411,57 +481,6 @@ (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 (or (null start) (null end) (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 ((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) - (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)) - ((and (not from-end) (null start)) - (cursor-pfirst cur)) - ((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) - (map-duplicates skey)) - nil))))))) - ;; =============================== ;; Some generic utility functions ;; ===============================