[elephant-cvs] CVS elephant/src/elephant
ieslick
ieslick at common-lisp.net
Tue Apr 24 03:02:28 UTC 2007
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
;; ===============================
More information about the Elephant-cvs
mailing list