elephant-cvs
Threads by month
- ----- 2025 -----
- July
- June
- May
- April
- March
- February
- January
- ----- 2024 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2023 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2022 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2021 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2020 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2019 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2018 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2017 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2016 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2015 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2014 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2013 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2012 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2011 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2010 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2009 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2008 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2007 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2006 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2005 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2004 -----
- December
- November
- October
- September
- August
February 2006
- 2 participants
- 108 discussions
Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv1832/src
Modified Files:
indexing.lisp
Log Message:
Updated TODO list. Minor tweak in indexing.
--- /project/elephant/cvsroot/elephant/src/indexing.lisp 2006/02/14 15:25:10 1.4
+++ /project/elephant/cvsroot/elephant/src/indexing.lisp 2006/02/14 15:31:09 1.5
@@ -399,12 +399,13 @@
nil)))))
(defun drop-instances (instances &key (sc *store-controller*))
- (assert (consp instances))
- (with-transaction (:store-controller sc)
- (let ((class-idx (find-class-index (class-of (first instances)))))
- (mapc (lambda (instance)
- (remove-kv (oid instance) class-idx))
- instances))))
+ (when instances
+ (assert (consp instances))
+ (with-transaction (:store-controller sc)
+ (let ((class-idx (find-class-index (class-of (first instances)))))
+ (mapc (lambda (instance)
+ (remove-kv (oid instance) class-idx))
+ instances)))))
;; =============================
;; CLASS / DB SYNCHRONIZATION
1
0
Update of /project/elephant/cvsroot/elephant
In directory common-lisp:/tmp/cvs-serv487
Modified Files:
CREDITS
Log Message:
Adding some acknowledgements.
--- /project/elephant/cvsroot/elephant/CREDITS 2005/11/23 17:51:31 1.6
+++ /project/elephant/cvsroot/elephant/CREDITS 2006/02/14 15:28:32 1.7
@@ -46,3 +46,10 @@
Dan Knapp fixed the fact that nil's were indistinguishable from
unbound slots, and proved the system works with SQLite3.
+
+Tayssir John Gabbour has found two bugs on Feb. 14, 2006.
+
+Ian Eslick wrote src/indexing.lisp, which added major
+convenience features for automatically indexing the a slot
+in a class.
+
1
0
Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv373
Modified Files:
bdb-enable.lisp indexing.lisp serializer.lisp
Log Message:
Thanks to Tayssir John Gabour for these bug fixes.
--- /project/elephant/cvsroot/elephant/src/bdb-enable.lisp 2006/02/04 22:25:09 1.6
+++ /project/elephant/cvsroot/elephant/src/bdb-enable.lisp 2006/02/14 15:25:10 1.7
@@ -65,7 +65,7 @@
;; "/db/ben/lisp/db43/lib/libdb.so"
"/usr/local/BerkeleyDB.4.3/lib/libdb-4.3.so"
;; this works on FreeBSD
- #+(and (or bsd freebsd) (not darwin macosx))
+ #+(and (or bsd freebsd) (not darwin) (not macosx))
"/usr/local/lib/db43/libdb.so"
#+(or darwin macosx)
;; for Fink (OS X) -- but I will assume Linux more common...
--- /project/elephant/cvsroot/elephant/src/indexing.lisp 2006/02/08 03:23:12 1.3
+++ /project/elephant/cvsroot/elephant/src/indexing.lisp 2006/02/14 15:25:10 1.4
@@ -450,8 +450,8 @@
;;
;; DEFINE THE SYNCHRONIZATION RULES
+(eval-when (:compile-toplevel :load-toplevel)
-(eval-when (:compile-toplevel)
(defclass synch-rule ()
((lhs :accessor synch-rule-lhs :initarg :lhs :initform nil)
(rhs :accessor synch-rule-rhs :initarg :rhs :initform nil)))
--- /project/elephant/cvsroot/elephant/src/serializer.lisp 2006/02/04 22:25:09 1.13
+++ /project/elephant/cvsroot/elephant/src/serializer.lisp 2006/02/14 15:25:10 1.14
@@ -466,7 +466,7 @@
(eval-when (:compile-toplevel :load-toplevel)
(asdf:operate 'asdf:load-op :cl-base64)
)
-(defun ser-deser-equal (x1 &keys sc)
+(defun ser-deser-equal (x1 &key sc)
(let* (
(x1s (serialize-to-base64-string x1))
(x1prime (deserialize-from-base64-string x1s :sc sc)))
@@ -482,7 +482,7 @@
)
-(defun deserialize-from-base64-string (x &keys sc)
+(defun deserialize-from-base64-string (x &key sc)
(with-buffer-streams (other)
(deserialize
(sleepycat::buffer-write-byte-vector
1
0
Update of /project/elephant/cvsroot/elephant/tests
In directory common-lisp:/tmp/cvs-serv5850/tests
Modified Files:
elephant-tests.lisp testindexing.lisp
Log Message:
Added :index vs. :indexed slot option
Improved tests and added some more
Some minor cleanup
--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2006/02/07 23:23:51 1.10
+++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2006/02/10 01:39:13 1.11
@@ -122,16 +122,19 @@
(setq *old-store* *store-controller*)
(unwind-protect
(progn
- (open-store *testdb-path*)
- (print (do-test 'indexing-basic))
- (print (do-test 'indexing-inherit))
- (print (do-test 'indexing-range))
- (print (do-test 'indexing-reconnect-db))
- (print (do-test 'indexing-change-class))
- (print (do-test 'indexing-redef-class))
- (print (do-test 'indexing-explicit-changes))
- (print (do-test 'indexing-timing))
- (close-store))
+ (let ((*auto-commit* nil))
+ (declare (special *auto-commit*)
+ (dynamic-extent *auto-commit*))
+ (open-store *testdb-path*)
+ (print (do-test 'indexing-basic))
+ (print (do-test 'indexing-inherit))
+ (print (do-test 'indexing-range))
+ (print (do-test 'indexing-reconnect-db))
+ (print (do-test 'indexing-change-class))
+ (print (do-test 'indexing-redef-class))
+ (print (do-test 'indexing-explicit-changes))
+ (print (do-test 'indexing-timing))
+ (close-store)))
(setq *store-controller* *old-store*)))
(defun do-crazy-pg-tests()
@@ -161,6 +164,8 @@
(when spec
(with-open-store (spec)
(let ((*auto-commit* nil))
+ (declare (special *auto-commit*)
+ (dynamic-extent *auto-commit*))
(do-tests)))))
(defun find-slot-def (class-name slot-name)
--- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/02/08 03:23:12 1.3
+++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/02/10 01:39:13 1.4
@@ -30,11 +30,11 @@
(setf (find-class 'idx-one) nil)
(defclass idx-one ()
- ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :indexed t))
+ ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
(:metaclass persistent-metaclass))
(progn
- (with-transaction ()
+ (with-transaction (:store-controller *store-controller*)
(setq inst1 (make-instance 'idx-one :slot1 1 :sc *store-controller*))
(setq inst2 (make-instance 'idx-one :slot1 1 :sc *store-controller*))
(setq inst3 (make-instance 'idx-one :slot1 3 :sc *store-controller*)))
@@ -57,51 +57,64 @@
(setf (find-class 'idx-two) nil)
(defclass idx-one ()
- ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :indexed t)
- (slot2 :initarg :slot2 :initform 2 :accessor slot2 :indexed t)
+ ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
+ (slot2 :initarg :slot2 :initform 2 :accessor slot2 :index t)
(slot3 :initarg :slot3 :initform 3 :accessor slot3)
(slot4 :initarg :slot4 :initform 4 :accessor slot4 :transient t))
(:metaclass persistent-metaclass))
(defclass idx-two (idx-one)
((slot2 :initarg :slot2 :initform 20 :accessor slot2)
- (slot3 :initarg :slot3 :initform 30 :accessor slot3 :indexed t)
- (slot4 :initarg :slot4 :initform 40 :accessor slot4 :indexed t))
+ (slot3 :initarg :slot3 :initform 30 :accessor slot3 :index t)
+ (slot4 :initarg :slot4 :initform 40 :accessor slot4 :index t))
(:metaclass persistent-metaclass))
(progn
(with-transaction ()
- (setq inst1 (make-instance 'idx-two :sc *store-controller*)))
+ (setq inst1 (make-instance 'idx-one :sc *store-controller*))
+ (setq inst2 (make-instance 'idx-two :sc *store-controller*)))
(values (slot1 inst1)
(slot2 inst1)
(slot3 inst1)
(slot4 inst1)
+ (slot1 inst2)
+ (slot2 inst2)
+ (slot3 inst2)
+ (slot4 inst2)
+ (equal (elephant::indexing-record-slots (elephant::indexed-record (find-class 'idx-one)))
+ '(slot1 slot2))
(equal (elephant::indexing-record-slots (elephant::indexed-record (find-class 'idx-two)))
'(slot1 slot3 slot4)))))
- 1 20 30 40 t)
+ 1 2 3 4 1 20 30 40 t t)
(deftest indexing-range
(progn
;; (format t "range store: ~A ~A~%" *store-controller* (controller-path *store-controller*))
- (disable-class-indexing 'idx-one :sc *store-controller* :errorp nil)
+ (disable-class-indexing 'idx-two :errorp nil)
+ (disable-class-indexing 'idx-one :errorp nil)
+ (setf (find-class 'idx-two) nil)
(setf (find-class 'idx-one) nil)
(defclass idx-one ()
- ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :indexed t))
+ ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
(:metaclass persistent-metaclass))
(defun make-idx-one (val)
- (make-instance 'idx-one :slot1 val :sc *store-controller*))
+ (make-instance 'idx-one :slot1 val))
(with-transaction ()
(mapc #'make-idx-one '(1 1 1 2 2 4 5 5 5 6 10)))
;; Range should get multiple & single keys inclusive of
;; start and end
- (let ((list (mapcar #'slot1 (get-instances-by-range 'idx-one 'slot1 2 6))))
- (equal list '(2 2 4 5 5 5 6))))
- t)
+ (values (equal (mapcar #'slot1 (get-instances-by-range 'idx-one 'slot1 2 6))
+ '(2 2 4 5 5 5 6)) ;; interior range
+ (equal (mapcar #'slot1 (get-instances-by-range 'idx-one 'slot1 0 2))
+ '(1 1 1 2 2))
+ (equal (mapcar #'slot1 (get-instances-by-range 'idx-one 'slot1 6 15))
+ '(6 10))))
+ t t t)
(deftest indexing-reconnect-db
(progn
@@ -110,9 +123,9 @@
;; (format t "connect store: ~A ~A~%" *store-controller* (controller-path *store-controller*))
(defclass idx-two ()
- ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :indexed t)
+ ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
(slot2 :initarg :slot2 :initform 2 :accessor slot2)
- (slot3 :initarg :slot3 :initform 3 :accessor slot3 :indexed t))
+ (slot3 :initarg :slot3 :initform 3 :accessor slot3 :index t))
(:metaclass persistent-metaclass))
(let ((*old-default* *default-indexed-class-synch-policy*)
@@ -127,8 +140,8 @@
;; Assume our db is out of synch with our class def
(defclass idx-two ()
((slot1 :initarg :slot1 :initform 1 :accessor slot1)
- (slot2 :initarg :slot2 :initform 2 :accessor slot2 :indexed t)
- (slot3 :initarg :slot3 :initform 3 :accessor slot3 :indexed t))
+ (slot2 :initarg :slot2 :initform 2 :accessor slot2 :index t)
+ (slot3 :initarg :slot3 :initform 3 :accessor slot3 :index t))
(:metaclass persistent-metaclass))
;; Add an instance of the new class
@@ -142,8 +155,52 @@
2 2 t)
(deftest indexing-change-class
- nil
- nil)
+ (progn
+ (disable-class-indexing 'idx-one :errorp nil)
+ (disable-class-indexing 'idx-two :errorp nil)
+ (setf (find-class 'idx-one) nil)
+ (setf (find-class 'idx-two) nil)
+
+ (defclass idx-one ()
+ ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
+ (slot2 :initarg :slot2 :initform 2 :accessor slot2 :index t))
+ (:metaclass persistent-metaclass))
+
+ (defclass idx-two ()
+ ((slot1 :initarg :slot1 :initform 10 :accessor slot1 :index nil)
+ (slot3 :initarg :slot3 :initform 30 :accessor slot3 :index t)
+ (slot4 :initarg :slot4 :initform 40 :accessor slot4 :index t))
+ (:metaclass persistent-metaclass))
+
+ (defmethod update-instance-for-different-class :before ((old idx-one)
+ (new idx-two)
+ &key)
+ (setf (slot3 new) (slot2 old)))
+
+ (let ((*auto-commit* t)
+ (foo nil))
+ (declare (special *auto-commit*)
+ (dynamic-extent *auto-commit*))
+ (setf foo (make-instance 'idx-one))
+ (change-class foo 'idx-two)
+
+ (values
+ ;; shared data from original slot
+ (slot1 foo)
+ ;; verify old instance access fails
+ (signals-error (slot2 foo))
+ ;; verify new instance is there
+ (slot3 foo)
+ (slot4 foo)
+ ;; verify proper indexing changes (none should lookup a value)
+ (get-instances-by-class 'idx-one)
+ (get-instances-by-value 'idx-one 'slot1 1)
+ (get-instances-by-value 'idx-one 'slot2 2)
+ ;; new indexes
+ (length (get-instances-by-class 'idx-two))
+ (length (get-instances-by-value 'idx-two 'slot3 2))
+ )))
+ 1 t 2 40 nil nil nil 1 1)
(deftest indexing-redef-class
nil
@@ -156,14 +213,14 @@
;; create 10k objects, write each object's slots
(defclass stress-normal ()
- ((stress1 :accessor stress1 :initarg :stress1 :initform nil :indexed nil)
- (stress2 :accessor stress2 :initarg :stress2 :initform nil :indexed nil))
+ ((stress1 :accessor stress1 :initarg :stress1 :initform nil :index nil)
+ (stress2 :accessor stress2 :initarg :stress2 :initform nil :index nil))
(:metaclass persistent-metaclass))
(defclass stress-index ()
- ((stress1 :accessor stress1 :initarg :stress1 :initform nil :indexed t)
- (stress2 :accessor stress2 :initarg :stress2 :initform 2 :indexed t)
- (stress3 :accessor stress3 :initarg :stress3 :initform 3 :indexed nil))
+ ((stress1 :accessor stress1 :initarg :stress1 :initform nil :index t)
+ (stress2 :accessor stress2 :initarg :stress2 :initform 2 :index t)
+ (stress3 :accessor stress3 :initarg :stress3 :initform 3 :index nil))
(:metaclass persistent-metaclass))
(defvar normal-index nil)
@@ -207,32 +264,43 @@
(deftest indexing-timing
(progn
-
- (let ((insts (get-instances-by-class 'stress-index)))
+ (let ((insts (get-instances-by-class 'stress-index))
+ (start nil)
+ (end nil)
+ (normal-time 0)
+ (index-time 0))
(when insts
(drop-instances insts)))
- (format t "~%Stress test normal setup time (~A):~%" *stress-count*)
+;; (format t "~%Stress test normal setup time (~A):~%" *stress-count*)
(with-transaction ()
- (time (normal-stress-setup *stress-count* 'stress-normal :stress2 10)))
+ (normal-stress-setup *stress-count* 'stress-normal :stress2 10)
+ )
- (format t "~%Stress test indexed setup time (~A):~%" *stress-count*)
+;; (format t "~%Stress test indexed setup time (~A):~%" *stress-count*)
(with-transaction ()
- (time (indexed-stress-setup *stress-count* 'stress-index :stress2 10)))
+ (indexed-stress-setup *stress-count* 'stress-index :stress2 10)
+ )
- (format t "~%Stress test normal lookup time (~A):~%" *range-size*)
- (time
- (dotimes (i *range-size*)
- (declare (ignore i))
- (normal-range-lookup *stress-count* *range-size*)))
+;; (format t "~%Stress test normal lookup time (~A):~%" *range-size*)
+ (setf start (get-internal-run-time))
+ (dotimes (i *range-size*)
+ (declare (ignore i))
+ (normal-range-lookup *stress-count* *range-size*))
+ (setf end (get-internal-run-time))
+ (setf normal-time (/ (- end start 0.0) internal-time-units-per-second))
- (format t "~%Stress test indexed lookup time (~A):~%" *range-size*)
- (prof:with-profiling (:type :time)
- (time
+;; (format t "~%Stress test indexed lookup time (~A):~%" *range-size*)
+ (setf start (get-internal-run-time))
(dotimes (i *range-size*)
(declare (ignore i))
- (indexed-range-lookup 'stress-index *stress-count* *range-size*))))
- t)
+ (indexed-range-lookup 'stress-index *stress-count* *range-size*))
+ (setf end (get-internal-run-time))
+ (setf index-time (/ (- end start 0.0) internal-time-units-per-second))
+
+ (format t "~%Ranged get of ~A/~A objects = Linear: ~A sec Indexed: ~A sec~%"
+ *range-size* *stress-count* normal-time index-time)
+ (> normal-time index-time))
t)
1
0
Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv5850/src
Modified Files:
classes.lisp controller.lisp elephant.lisp index-tutorial.lisp
metaclasses.lisp
Log Message:
Added :index vs. :indexed slot option
Improved tests and added some more
Some minor cleanup
--- /project/elephant/cvsroot/elephant/src/classes.lisp 2006/02/07 23:23:50 1.19
+++ /project/elephant/cvsroot/elephant/src/classes.lisp 2006/02/10 01:39:13 1.20
@@ -98,9 +98,13 @@
#+allegro
(defun make-persistent-writer (name slot-definition class class-name)
- (eval `(defmethod (setf ,name) ((instance ,class-name) value)
- (setf (slot-value-using-class ,class instance ,slot-definition)
- value))))
+ (let ((name (if (and (consp name)
+ (eq (car name) 'setf))
+ name
+ `(setf ,name))))
+ (eval `(defmethod ,name ((instance ,class-name) value)
+ (setf (slot-value-using-class ,class instance ,slot-definition)
+ value)))))
#+allegro
(defmethod initialize-accessors ((slot-definition persistent-slot-definition) class)
--- /project/elephant/cvsroot/elephant/src/controller.lisp 2006/02/07 23:23:50 1.17
+++ /project/elephant/cvsroot/elephant/src/controller.lisp 2006/02/10 01:39:13 1.18
@@ -268,7 +268,7 @@
:auto-commit t :txn-nosync t))
;; Open/close
-(defmethod open-controller ((sc bdb-store-controller) &key (recover nil)
+(defmethod open-controller ((sc bdb-store-controller) &key (recover t)
(recover-fatal nil) (thread t))
(let ((env (db-env-create)))
;; thread stuff?
--- /project/elephant/cvsroot/elephant/src/elephant.lisp 2006/02/07 23:23:50 1.20
+++ /project/elephant/cvsroot/elephant/src/elephant.lisp 2006/02/10 01:39:13 1.21
@@ -55,6 +55,7 @@
#:persistent #:persistent-object #:persistent-metaclass
+ #:defpclass
#:persistent-collection #:btree
#:bdb-btree #:sql-btree
--- /project/elephant/cvsroot/elephant/src/index-tutorial.lisp 2006/02/07 23:23:50 1.2
+++ /project/elephant/cvsroot/elephant/src/index-tutorial.lisp 2006/02/10 01:39:13 1.3
@@ -5,10 +5,10 @@
(in-package :elephant-tutorial)
(defclass simple-plog ()
- ((timestamp :accessor plog-timestamp :initarg :timestamp :indexed t)
- (type :accessor plog-type :initarg :type :indexed t)
+ ((timestamp :accessor plog-timestamp :initarg :timestamp :index t)
+ (type :accessor plog-type :initarg :type :index t)
(data :accessor plog-data :initarg :data)
- (user :accessor plog-user :initarg :user :indexed t))
+ (user :accessor plog-user :initarg :user :index t))
(:metaclass persistent-metaclass)
(:documentation "Simple persistent log"))
--- /project/elephant/cvsroot/elephant/src/metaclasses.lisp 2006/02/07 23:23:51 1.13
+++ /project/elephant/cvsroot/elephant/src/metaclasses.lisp 2006/02/10 01:39:13 1.14
@@ -76,6 +76,20 @@
be indexed for by-value retrieval."))
;;
+;; Top level defclass form - hide metaclass option
+;;
+
+(defmacro defpclass (cname parents slot-defs &optional class-opts)
+ `(defclass ,cname ,parents
+ ,slot-defs
+ ,(add-persistent-metaclass class-opts)))
+
+(defun add-persistent-metaclass (class-opts)
+ (when (assoc :metaclass class-opts)
+ (error "User metaclass specification not allowed in defpclass"))
+ (append (list :metaclass 'persistent-metaclass) class-opts))
+
+;;
;; Persistent slot maintenance
;;
@@ -98,9 +112,8 @@
nil)
)))
-
(defclass persistent-slot-definition (standard-slot-definition)
- ((indexed :accessor indexed :initarg :indexed :initform nil :allocation :instance)))
+ ((indexed :accessor indexed :initarg :index :initform nil :allocation :instance)))
(defclass persistent-direct-slot-definition (standard-direct-slot-definition persistent-slot-definition)
())
@@ -246,7 +259,7 @@
and chooses persistent or transient slot definitions."
(let ((allocation-key (getf initargs :allocation))
(transient-p (getf initargs :transient))
- (indexed-p (getf initargs :indexed)))
+ (indexed-p (getf initargs :index)))
(when (consp transient-p) (setq transient-p (car transient-p)))
(when (consp indexed-p) (setq indexed-p (car indexed-p)))
(cond ((and (eq allocation-key :class) transient-p)
@@ -283,7 +296,7 @@
"Chooses the persistent or transient effective slot
definition class depending on the keyword."
(let ((transient-p (getf initargs :transient))
- (indexed-p (getf initargs :indexed)))
+ (indexed-p (getf initargs :index)))
(when (consp transient-p) (setq transient-p (car transient-p)))
(when (consp indexed-p) (setq indexed-p (car indexed-p)))
(cond ((and indexed-p transient-p)
@@ -343,7 +356,7 @@
;; Effective slots are indexed only if the most recent slot definition
;; is indexed. NOTE: Need to think more about inherited indexed slots
(if (indexed (first slot-definitions))
- (append initargs '(:indexed t))
+ (append initargs '(:index t))
initargs)))
(defmacro persistent-slot-reader (instance name)
1
0
Update of /project/elephant/cvsroot/elephant
In directory common-lisp:/tmp/cvs-serv5850
Modified Files:
TODO
Log Message:
Added :index vs. :indexed slot option
Improved tests and added some more
Some minor cleanup
--- /project/elephant/cvsroot/elephant/TODO 2006/02/08 03:23:12 1.10
+++ /project/elephant/cvsroot/elephant/TODO 2006/02/10 01:39:12 1.11
@@ -7,20 +7,22 @@
0.6.0 - Adding default class/slot indexing
- Finish indexing tests (Ian)
- Documentation update (Robert)
-- Tutorial example rethink: update the blog tutorial using indexed
- objects to create different views as well as integrating something
- like logging for admin or version control purposes. (Both?)
+- Add a class-indexing class option to the metaclass so we can maintain class instances
+ index without any secondary indices or indexed slots (Ian)
+- Add :inverse-reader to slot options to create a named method that indexes into objects
+ based on slot values. Is this a GF or defun? Do we dispatch on class name or bake it in?
0.6.1 - performance, safety and portability
Stability:
- Add clsql like support for building .so/.dylib from asdf loader on most systems
- Port elephant to closer-to-MOP to make it easier to support additional lisps (Both)
-- Cleanup multi-repository operation (a simple registry of open stores,
- clear object-repository associations) (Both)
+- Cleanup multi-repository operation (ensure that conflicts between an object's
+ registry and *store-controller* does not leed to lockup, especially with BDB (Both)
- Think through default vs. explicit store referencing all over the APIs (Both)
-- Cleaner failure modes if operations are performed without repository (Both)
-- Add asserts if *auto-index* is false and we're not in a transaction
+- Cleaner failure modes if operations are performed without repository or without
+ transaction or auto-commit (Both)
+ Add asserts if *auto-index* is false and we're not in a transaction
to help users avoid lockups in bdb? Should be able to turn off for
performance but it will help catch missing with-transaction statemetns
in user code. (Both)
@@ -34,36 +36,57 @@
- Metering and understanding locking issues. Large transactions seem
to use a lot of locks. In general understanding how to use Sleepycat
efficiently seems like a good thing. (Both)
-- Add dependency information into secondary index callback functions so that
- we can more easily compute which indices need to be updated to avoid the
- global remove/add in order to maintain consistency (Ian)
- Reclaim table storage on index drop (Ian)
- Higher performance fix for allegro unicode serialization workaround than
my current one (Ian)
Indexing features:
-- Add a class-indexing class option to the metaclass so we can maintain class instances
- index without any secondary indices or indexed slots (Ian)
-- on class change, new slots should have their initform values pushed
+- On class change, new slots should have their initform values pushed
into the slot value as if the slot was being created the first time
(currently this doesn't happen) (Ian)
Bugs:
- anything else reported against 0.5.0/0.6.0
-0.6.2 - New operating modes
+0.6.3 - Query & indexing expansion
- simple object query language (Ian - orthogonal, on main branch)
- - integrate support for your in-memory database (on a separate branch)
- - repository browser (Ian - orthogonal, on main branch)
+ - Add dependency information into secondary index callback functions so that
+ we can more easily compute which indices need to be updated to avoid the
+ global remove/add in order to maintain consistency (Ian)
+ - Add needed support (if any) for persistent graph structures & queries (Ian on a branch)
+
+0.6.4 - Compliance & Documentation
+ - Update to support BDB 4.4
+ - Tutorial example rethink: update the blog tutorial using indexed
+ objects to create different views as well as integrating something
+ like logging for admin or version control purposes.
+ - Finish serious update and review of users manual (building on 0.6.0 update)
+ - A guide to dealing with transactions
+ - A guide to dealing with multiple open stores
+ - A guide to performance
+ - An overview of licensing issues...
+ - Repository browser (Ian - orthogonal, on main branch)
(a simple REPL tool to see what classes are in a repository and
what state they're in...useful for long-lived repositories)
-0.6.3 - Query expansion
- - Add needed support (if any) for persistent graph structures &
-queries (Ian on a branch)
+0.6.4 - Additional datastructures?
+ - Support for cheap persistent sets (ala ACache)
+Some placeholders & dreams features below... :)
+0.7+: Major features
+ - A backend controller for AllegroCache (Ian)
+ - Prevalence-like in-memory database system (Robert?)
+ - Richer controller modes:
+ - Single-user mode (cache values in instance slots for fast reads, write-through)
+ - Prevalence mode (read/write to normal slots except on object creation or synch)
+ (in-memory slot indexing, on disk class)
+ (works for any backend)
+ - Concurrent mode (for backends that allow multiple processes to connect, current default)
+ - Controller 'switches'
+ - NoSynch - allow transactions to be lost on failure but maintains consistency instead of performance
+0.8 - Lisp Backend?
1
0
Update of /project/elephant/cvsroot/elephant/tests
In directory common-lisp:/tmp/cvs-serv713/tests
Modified Files:
testindexing.lisp
Log Message:
Minor cleanup of indexing tests, declarations and rule-based code.
100% of tests pass under allegro 7.0 and Mac OS X.
--- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/02/07 23:23:51 1.2
+++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/02/08 03:23:12 1.3
@@ -153,8 +153,7 @@
nil
nil)
-;; create 10k objects, write each object's
-;; slots
+;; create 10k objects, write each object's slots
(defclass stress-normal ()
((stress1 :accessor stress1 :initarg :stress1 :initform nil :indexed nil)
@@ -185,13 +184,18 @@
(start (/ count 2))
(end (1- (+ start size))))
(with-btree-cursor (cur normal-index)
- (multiple-value-bind (value? key val) (cursor-next cur)
- (declare (ignore key))
- (when (and value?
- (>= (stress1 val) start)
- (<= (stress1 val) end))
- (push val objects))))
- objects))
+ (loop
+ (multiple-value-bind (value? key val) (cursor-next cur)
+ (declare (ignore key))
+ (cond ((or (not value?)
+ (and value?
+ (>= (stress1 val) end)))
+ (return-from normal-range-lookup objects))
+ ((and value?
+ (>= (stress1 val) start)
+ (<= (stress1 val) end))
+ (push val objects)))))
+ objects)))
(defun indexed-range-lookup (class count size)
(let* ((start (/ count 2))
@@ -223,10 +227,11 @@
(normal-range-lookup *stress-count* *range-size*)))
(format t "~%Stress test indexed lookup time (~A):~%" *range-size*)
+ (prof:with-profiling (:type :time)
(time
(dotimes (i *range-size*)
(declare (ignore i))
- (indexed-range-lookup 'stress-index *stress-count* *range-size*)))
+ (indexed-range-lookup 'stress-index *stress-count* *range-size*))))
t)
t)
1
0
Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv713/src
Modified Files:
indexing.lisp
Log Message:
Minor cleanup of indexing tests, declarations and rule-based code.
100% of tests pass under allegro 7.0 and Mac OS X.
--- /project/elephant/cvsroot/elephant/src/indexing.lisp 2006/02/07 23:23:50 1.2
+++ /project/elephant/cvsroot/elephant/src/indexing.lisp 2006/02/08 03:23:12 1.3
@@ -1,7 +1,7 @@
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;
-;;; slot-index.lisp -- use btree collections to track objects by slot values
-;;; via metaclass options or accessor :after methods
+;;; indexing.lisp -- use btree collections to track objects by slot values
+;;; via metaclass options or accessor :after methods
;;;
;;; Initial version 1/24/2006 Ian Eslick
;;; eslick at alum mit edu
@@ -100,6 +100,7 @@
(defun no-indexing-needed? (class instance slot-def oid)
+ (declare (ignore instance))
(or (and (not (indexed slot-def)) ;; not indexed
(not (indexing-record-derived (indexed-record class)))) ;; no derived indexes
(member oid *inhibit-indexing-list*))) ;; currently inhibited
@@ -199,7 +200,7 @@
(when class
(disable-class-indexing class :sc sc))))
-(defmethod disable-class-indexing ((class persistent-metaclass) &key (sc *store-controller*) (errorp t))
+(defmethod disable-class-indexing ((class persistent-metaclass) &key (sc *store-controller*))
(let ((class-idx (find-class-index class :sc sc)))
(unless class-idx (return-from disable-class-indexing nil))
;; Remove all instance key/value data from the class index (& secondary indices)
@@ -354,6 +355,8 @@
(get-instances-by-value (find-class class) slot-name value))
(defmethod get-instances-by-value ((class persistent-metaclass) slot-name value)
+ (declare (optimize (speed 3) (safety 1) (space 1))
+ (type (or string symbol) slot-name))
(let ((instances nil))
(with-btree-cursor (cur (find-inverted-index class slot-name))
(multiple-value-bind (exists? skey val pkey) (cursor-pset cur value)
@@ -371,6 +374,9 @@
(get-instances-by-range (find-class class) slot-name start end))
(defmethod get-instances-by-range ((class persistent-metaclass) idx-name start end)
+ (declare (optimize speed (safety 1) (space 1))
+ (type fixnum start end)
+ (type string idx-name))
(with-inverted-cursor (cur class idx-name)
(labels ((next-range (instances)
(multiple-value-bind (exists? skey val pkey) (cursor-pnext-nodup cur)
@@ -406,16 +412,21 @@
;; TO READER: I got really tired of trying to figure out all
;; the messy conditionals and I figure default behaviors are something
-;; others might want to modify, so here's what determines the
-;; rule behavior.
-
-;; Rules match on the following state of the metaclass and
-;; the current class-index in the database for a given slotname:
+;; others might want to modify, so here's what determines the rule
+;; behavior.
+;;
+;; Rules match on the following states of the metaclass and current
+;; database class-index for each slotname currently in either of
+;; those sources. Actions are taken, typically when a slot exists
+;; in one but not the other or features like indexed/persistent
+;; differ between the slots
+;;
;; class state:
;; class-indexed - the slot is marked as indexed
;; class-persistent - the slot is marked as persistent (not indexed)
;; class-transient - the slot is marked transient
;; class-derived - the slot is in the derived list of the class
+;;
;; database
;; db-slot - the database has a slot index
;; db-derived - the database has a derived index
@@ -424,10 +435,12 @@
;; (not indexed-slot) for example, to cover more than one feature
;; combination
;;
-;; Each rule should apply uniquely to a given feature set
-;; Actions taken include:
-;; add-slot-index - add a new index to the db
-;; remove-slot-index - remove a slot from the db
+;; Each rule should apply uniquely to a given feature set.
+;;
+;; Actions taken when rules match can include:
+;;
+;; add-slot-index - add a new index with the slotname to the db
+;; remove-slot-index - remove a slot with the slotname from the db
;; add-derived-index - xxx this makes no sense! xxx
;; remove-derived-index - remove a derived index from the db
;; unregister-indexed-slot - remove an indexed slot from the class metaobject
@@ -436,6 +449,8 @@
;; register-derived-index - register a derived index with the class metaobject
;;
+;; DEFINE THE SYNCHRONIZATION RULES
+
(eval-when (:compile-toplevel)
(defclass synch-rule ()
((lhs :accessor synch-rule-lhs :initarg :lhs :initform nil)
@@ -461,10 +476,8 @@
(db-derived class-persistent => remove-derived-index warn))
;; NOTE: What about cases where we need to remove things as below?
(:db ;; db changes class
- ((not db-slot) class-indexed =>
- unregister-indexed-slot)
- ((not db-derived) class-derived =>
- unregister-derived-index)
+ ((not db-slot) class-indexed => unregister-indexed-slot)
+ ((not db-derived) class-derived => unregister-derived-index)
(db-slot class-persistent => register-indexed-slot)
(db-slot class-transient => remove-indexed-slot)
(db-derived class-transient => remove-derived-index warn)
@@ -474,22 +487,34 @@
(not class-persistent) (not class-transient) =>
register-derived-slot)))))
)
-
+
+;; TOP LEVEL METHOD
+
+(defun synchronize-class-to-store (class &key (sc *store-controller*)
+ (method *default-indexed-class-synch-policy*))
+ (let ((slot-records (compute-class-and-ele-status class sc))
+ (rule-set (cdr (assoc method *synchronize-rules*))))
+ (apply-synch-rules class slot-records rule-set)))
+
+;; COMPUTING RULE APPLICABILITY AND FIRING
(defun synch-rule-applicable? (rule features)
(simple-match-set (synch-rule-lhs rule) features))
(defun simple-match-set (a b)
+ (declare (optimize (speed 3) (safety 1)))
(cond ((null a) t)
((and (not (null a)) (null b)) nil)
((member (first a) b :test #'equal)
(simple-match-set (cdr a) (remove (first a) b :test #'equal)))
(t nil)))
+(defparameter *print-synch-messages* nil)
+
(defun apply-synch-rule (rule class name)
- (format t "Class/DB Synch: converting state ~A using ~A for ~A~%"
- (synch-rule-lhs rule) (synch-rule-rhs rule) name)
-;; (return-from apply-synch-rule nil)
+ (when *print-synch-messages*
+ (format t "Class/DB Synch: converting state ~A using ~A for ~A~%"
+ (synch-rule-lhs rule) (synch-rule-rhs rule) name))
(loop for action in (synch-rule-rhs rule) do
(case action
(add-slot-index (add-class-slot-index class name :update-class nil))
@@ -502,9 +527,20 @@
(register-derived-index (register-derived-index class name))
(warn (warn "Performing slot synchronization actions: ~A" (synch-rule-rhs rule))))))
-(defun synchronize-class-to-store (class &key (sc *store-controller*)
- (method *default-indexed-class-synch-policy*))
- (let* ((*store-controller* sc)
+(defun apply-synch-rules (class records rule-set)
+ (declare (optimize (speed 3) (safety 1)))
+ (labels ((slotname (rec) (car rec))
+ (feature-set (rec) (cdr rec)))
+ (loop for record in records do
+ (loop for rule in rule-set
+ when (synch-rule-applicable? rule (feature-set record))
+ do
+ (apply-synch-rule rule class (slotname record))))))
+
+;; COMPUTE CURRENT STATE OF CLASS OBJECT AND DATABASE AFTER CHANGES
+
+(defun compute-class-and-ele-status (class &optional (store-controller *store-controller*))
+ (let* ((*store-controller* store-controller)
;; db info
(db-indices (find-inverted-index-names class))
(db-derived (mapcar #'get-derived-name-root
@@ -525,24 +561,16 @@
(class-transient . ,other-slots)
(db-slot . ,db-slot)
(db-derived . ,db-derived))))
- (labels ((compute-feature (name set label)
- (if (member name set)
- label
- `(not ,label)))
- (compute-features (slotname)
+ (labels ((compute-features (slotname)
(let ((features nil))
(loop for set in all-sets do
(push (compute-feature slotname (cdr set) (car set))
features))
(cons slotname features)))
- (slotname (rec) (car rec))
- (feature-set (rec) (cdr rec)))
- (let ((rule-set (cdr (assoc method *synchronize-rules*)))
- (slot-records (mapcar #'compute-features all-names)))
- (loop for record in slot-records do
- (loop
- for rule in rule-set
- when (synch-rule-applicable? rule (feature-set record))
- do
- (apply-synch-rule rule class (slotname record))))))))
+ (compute-feature (name set label)
+ (if (member name set)
+ label
+ `(not ,label))))
+ (mapcar #'compute-features all-names))))
+
1
0
Update of /project/elephant/cvsroot/elephant
In directory common-lisp:/tmp/cvs-serv713
Modified Files:
TODO
Log Message:
Minor cleanup of indexing tests, declarations and rule-based code.
100% of tests pass under allegro 7.0 and Mac OS X.
--- /project/elephant/cvsroot/elephant/TODO 2006/02/04 22:25:09 1.9
+++ /project/elephant/cvsroot/elephant/TODO 2006/02/08 03:23:12 1.10
@@ -1,3 +1,73 @@
+Feb 6, 2006
+
+Release plan in-discussion with Robert and Ian
+
+Upcoming release ideas.
+
+0.6.0 - Adding default class/slot indexing
+- Finish indexing tests (Ian)
+- Documentation update (Robert)
+- Tutorial example rethink: update the blog tutorial using indexed
+ objects to create different views as well as integrating something
+ like logging for admin or version control purposes. (Both?)
+
+0.6.1 - performance, safety and portability
+
+Stability:
+- Add clsql like support for building .so/.dylib from asdf loader on most systems
+- Port elephant to closer-to-MOP to make it easier to support additional lisps (Both)
+- Cleanup multi-repository operation (a simple registry of open stores,
+ clear object-repository associations) (Both)
+- Think through default vs. explicit store referencing all over the APIs (Both)
+- Cleaner failure modes if operations are performed without repository (Both)
+- Add asserts if *auto-index* is false and we're not in a transaction
+ to help users avoid lockups in bdb? Should be able to turn off for
+ performance but it will help catch missing with-transaction statemetns
+ in user code. (Both)
+- BDB: determine how to detect deadlock conditions as an optional run-safe mode? (?)
+ Does BDB have timeouts enabled on select? (Ian)
+- (From Ben's e-mail) We are storing persistent objects incorrectly. They should be
+ stored only as OIDs, and we should have a separate OID->class table. This way
+ change-class can be handled correctly (Ian)
+
+Performance:
+- Metering and understanding locking issues. Large transactions seem
+ to use a lot of locks. In general understanding how to use Sleepycat
+ efficiently seems like a good thing. (Both)
+- Add dependency information into secondary index callback functions so that
+ we can more easily compute which indices need to be updated to avoid the
+ global remove/add in order to maintain consistency (Ian)
+- Reclaim table storage on index drop (Ian)
+- Higher performance fix for allegro unicode serialization workaround than
+ my current one (Ian)
+
+Indexing features:
+- Add a class-indexing class option to the metaclass so we can maintain class instances
+ index without any secondary indices or indexed slots (Ian)
+- on class change, new slots should have their initform values pushed
+ into the slot value as if the slot was being created the first time
+ (currently this doesn't happen) (Ian)
+
+Bugs:
+- anything else reported against 0.5.0/0.6.0
+
+0.6.2 - New operating modes
+ - simple object query language (Ian - orthogonal, on main branch)
+ - integrate support for your in-memory database (on a separate branch)
+ - repository browser (Ian - orthogonal, on main branch)
+ (a simple REPL tool to see what classes are in a repository and
+ what state they're in...useful for long-lived repositories)
+
+0.6.3 - Query expansion
+ - Add needed support (if any) for persistent graph structures &
+queries (Ian on a branch)
+
+
+
+
+
+
+
Feb. 4, 2006
As of 0.5.0, we have seem to have a stable suite on
1
0
Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv9614/src
Modified Files:
classes.lisp collections.lisp controller.lisp elephant.lisp
metaclasses.lisp sleepycat.lisp sql-collections.lisp
Added Files:
IAN-TODO index-tutorial.lisp index-utils.lisp indexing.lisp
Log Message:
Merger from Ian's branch into the main trunk.
--- /project/elephant/cvsroot/elephant/src/IAN-TODO 2006/01/26 04:03:44 1.1
+++ /project/elephant/cvsroot/elephant/src/IAN-TODO 2006/02/07 23:23:50 1.2
@@ -0,0 +1,102 @@
+TODO:
+- Finish adding tests!
+- Documentation (Robert)
+- Tutorial example (Ian)
+
+CLEANUP:
+- Verify locking behavior in transactions (should timeout with error!)
+- validate native string serialization for allegro in sleepycat.lisp (6.2 trial?)
+
+FUTURE:
+- Add compiled query language (0.5.2)
+- Changing slots should push default value into new persistent slots (ie name change)
+ for existing slots in DB when :class is the synch type
+- performance validation of allegro native string serialization (0.5.2)
+- Fix multi-repository handling (Ian/Richard) (0.5.2)
+- Closer to MOP conversion? (Check licensing) (0.5.3)
+- Time/Space performance tuning on indexed slots (0.5.4)
+ - Reclaim storage on secondary index drop?
+ - Compute dependencies on derived slots to improve performance
+ - Optimize consistency updating of inverted indices (currently remove/add)
+ - Custom DB table instead of using primary/secondary?
+ - Do not store duplicates in inverted index, store a list of
+ objects instead that can be operated on cheaply?
+- Help Robert integrate his in-memory alternative (non-concurrent mode)
+ (change use of bdb settings & class slot read/write behavior) (0.6.0)
+
+DOCUMENTATION:
+
+Defining Indexed Persistent Classes
+
+Elephant now contains the facility for default class instance indexing and inverted
+indicies defined against slots or functions that compute derived parameters.
+
+Class indexing is enabled whenever an inverted index is specified. Later releases
+may allow for class indexing without inverted indices. Indexing can be specified
+interactively at runtime or by :indexed t/nil slot initargs in the class definition.
+Only persistent slots can be indexed and derived index functions may only depend on
+persistent slots (although no error checking is currently performed on derived slots)
+
+When a slot is declared indexed, each write to an indexed persistent slot results in
+an update to a dedicated class indexed-btree. This btree is organized based on the
+instance oid->instance. All class instances can be found by walking the primary
+indexed btree. Inverted indices are managed through secondary indices which are
+automatically updated by writes to the primary index. Each slot index and derived
+index has a secondary (btree-index) btree dedicate to it. This functionality is
+similar to that defined for the Symbolics Statice database.
+
+Writes to classes with an inverted index on the written slot are more expensive than
+standard writes. They involves, at least, three additional reads to verify that the
+primary index key-value and secondary index key-value are the same. To validate
+the secondary key-value pair the persistent value is read again by the key-function
+defined on the secondary index. This is very appropriate for read heavy, interactive
+systems that will be using the indexes alot, but less so for write-dominated archives
+such as log files. Log files that are infrequently read are better off stored without
+indexing using a linked list with a market index that taps into the linked list at
+various points according to date, sequence number, etc. Systems that care little about
+throughput can be agnostic to the performance impact as read/writes are likely to be
+a very small part of the total runtime. (Can I justify this statement empirically?)
+
+Interactive manipulation of indexing is allowed through an API defined in indexing.lisp.
+Classes can have indexing enabled/disabled. Individual slots can be registered and
+unregistered as indexed slots and derived slots can be added only via the interactive
+functions.
+
+There are some touchy issues in reconnecting to an existing indexed slot database.
+Elephant does not yet support persistent classes and so interactive changes to indexing
+may clash with the initargs in the original defclass. If this is the case, the system
+will adapt the defined class to the persistent state and warn the user that the text
+is out of date with the persistent indexing state. It is a good idea to change slot
+indexing behavior using change-class or by re-evaluating a changed class definition.
+In the lisp tradition, we'll assume you know what you're doing when you interactively
+change things so we'll maintain derived indices. If they have slot dependencies that
+are lost under a change-class operation then there will be an error issued by the
+derived function at runtime and you'll have to drop and restart that index. We may
+add some more sophistication here at a later date (such as allowing specification of
+the slots a derived index depends on so we can automatically drop and compute updates.
+
+Database Queries for Indexed Instances
+
+All the above functionality leaves us with a set of indexed instances. The indexing
+functionality provides three APIs for leveraging this infrastructure in your programs.
+
+1) Simplified cursor interface. You can use the underlying btree cursors directly if
+you want to do sophisticated operations over the indices. Be sure to wrap side effects
+to the store in with-transaction statements and to close your indices when done.
+
+2) Instance set retrieval. You can retrieve sets of instances using simple interfaces
+that retrieve instances by slot value, a range of slot values (range is determined
+using the built-in elephant key order routine) or all class instances. This API also
+allows mapping over ranges, sets of values or all class instances.
+
+3) Query language. This is relatively primitive for now, it allows you to do joins
+over multiple slot or derived indices to pick a subset of classes that satisfy a given
+relation. Later we hope to allow for more complex class instance inter-dependencies,
+for example persistent graphs where subgraphs are deferentiated by class-type or slot
+values.
+
+See the API reference for
+
+
+
+
--- /project/elephant/cvsroot/elephant/src/classes.lisp 2006/02/05 23:13:07 1.18
+++ /project/elephant/cvsroot/elephant/src/classes.lisp 2006/02/07 23:23:50 1.19
@@ -54,6 +54,31 @@
metaclass.")
(:metaclass persistent-metaclass))
+;;(defmethod print-object ((obj persistent) stream)
+
+(defmethod initialize-instance ((instance persistent-object) &rest initargs &key from-oid &allow-other-keys)
+ (declare (ignore initargs))
+ (if (indexed (class-of instance))
+ (progn
+ (let ((oid (oid instance)))
+ (declare (type fixnum oid))
+ (inhibit-indexing oid)
+ (unwind-protect
+ (call-next-method)
+ (uninhibit-indexing oid))
+ ;; Inhibit indexing if the object already was defined (ie being created from an oid)
+ ;; as it should be indexed already. This hack avoids a deadlock situation where we
+ ;; write the class or index page that we are currently reading via a cursor without
+ ;; going through the cursor abstraction. There has to be a better way to do this.
+ (when (not from-oid)
+ (let ((class-index (find-class-index (class-of instance))))
+ (when class-index
+;; (format t "Indexing initial instance: ~A :: ~A~%" oid instance)
+ (with-transaction ()
+ (setf (get-value oid class-index) instance)))))))
+ ;; else
+ (call-next-method)))
+
(defmethod shared-initialize :around ((class persistent-metaclass) slot-names &rest args &key direct-superclasses)
"Ensures we inherit from persistent-object."
(let* ((persistent-metaclass (find-class 'persistent-metaclass))
@@ -89,10 +114,13 @@
#+allegro
(defmethod reinitialize-instance :around ((instance persistent-metaclass) &rest initargs &key &allow-other-keys)
+ (declare (ignore initargs))
(prog1
(call-next-method)
(when (class-finalized-p instance)
(update-persistent-slots instance (persistent-slot-names instance))
+ (update-indexed-record instance (indexed-slot-names-from-defs instance))
+ (set-db-synch instance :class)
(loop with persistent-slots = (persistent-slots instance)
for slot-def in (class-direct-slots instance)
when (member (slot-definition-name slot-def) persistent-slots)
@@ -101,19 +129,24 @@
#+(or cmu sbcl openmcl)
(defmethod reinitialize-instance :around ((instance persistent-metaclass) &rest initargs &key &allow-other-keys)
+ (declare (ignore initargs))
(prog1
(call-next-method)
(when (class-finalized-p instance)
(update-persistent-slots instance (persistent-slot-names instance))
+ (update-indexed-record instance (indexed-slot-names-from-defs instance))
+ (set-db-synch instance :class)
(make-instances-obsolete instance))))
;; #+allegro
(defmethod finalize-inheritance :around ((instance persistent-metaclass))
(prog1
(call-next-method)
- (if (not (slot-boundp instance '%persistent-slots))
+ (when (not (slot-boundp instance '%persistent-slots))
(setf (%persistent-slots instance)
- (cons (persistent-slot-names instance) nil)))))
+ (cons (persistent-slot-names instance) nil)))
+ (when (not (slot-boundp instance '%indexed-slots))
+ (update-indexed-record instance (indexed-slot-names-from-defs instance)))))
;; #+(or cmu sbcl)
;; (defmethod finalize-inheritance :around ((instance persistent-metaclass))
@@ -169,17 +202,16 @@
(apply #'call-next-method instance transient-slot-inits initargs))))))
(defmethod update-instance-for-redefined-class :around ((instance persistent-object) added-slots discarded-slots property-list &rest initargs &key &allow-other-keys)
- ;; probably should delete discarded slots, but we'll worry about that later
+ ;; NOTE: probably should delete discarded slots, but we'll worry about that later
+ (declare (ignore property-list discarded-slots added-slots))
(prog1
(call-next-method)
-;; (format t "persistent-slots ~A~%" (persistent-slots (class-of instance)))
-;; (format t "slot-boundp ~A~%" (slot-boundp instance '%persistent-slots))
(let* ((class (class-of instance))
(new-persistent-slots (set-difference (persistent-slots class)
(old-persistent-slots class))))
-
+ ;; Update new persistent slots, the others we get for free (same oid!)
+ ;; Isn't this done by the default call-next-method?
(apply #'shared-initialize instance new-persistent-slots initargs))
-;; (format t "slot-boundp ~A~%" (slot-boundp instance '%persistent-slots))
)
)
@@ -200,7 +232,9 @@
when (not (persistent-slot-boundp previous slot-name))
collect slot-name))
(retained-persistent-slots (set-difference raw-retained-persistent-slots retained-unbound-slots)))
+ ;; Apply default values for unbound & new slots (updates class index)
(apply #'shared-initialize current (append new-persistent-slots retained-unbound-slots) initargs)
+ ;; Copy values from old class (NOTE: should delete discarded slots?) (updates class index)
(loop for slot-def in (class-slots new-class)
when (member (slot-definition-name slot-def) retained-persistent-slots)
do (setf (slot-value-using-class new-class
@@ -209,6 +243,9 @@
(slot-value-using-class old-class
previous
(find-slot-def-by-name old-class (slot-definition-name slot-def)))))
+ ;; Delete this instance from its old class index, if exists
+ (when (indexed old-class)
+ (remove-kv (oid previous) (find-class-index old-class)))
(call-next-method)))
(defmethod slot-value-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
@@ -217,11 +254,21 @@
(let ((name (slot-definition-name slot-def)))
(persistent-slot-reader instance name)))
+;; ORIGINAL METHOD
+;; (defmethod (setf slot-value-using-class) :around (new-value (class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
+;; "Set the slot value in the database."
+;; (declare (optimize (speed 3)))
+;; (let ((name (slot-definition-name slot-def)))
+;; (persistent-slot-writer new-value instance name)))
+
+;; SUPPORT FOR INVERTED INDEXES
(defmethod (setf slot-value-using-class) :around (new-value (class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
"Set the slot value in the database."
(declare (optimize (speed 3)))
- (let ((name (slot-definition-name slot-def)))
- (persistent-slot-writer new-value instance name)))
+ (if (indexed class)
+ (indexed-slot-writer class instance slot-def new-value)
+ (let ((name (slot-definition-name slot-def)))
+ (persistent-slot-writer new-value instance name))))
(defmethod slot-boundp-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
"Checks if the slot exists in the database."
@@ -242,19 +289,21 @@
(defmethod slot-makunbound-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
"Deletes the slot from the database."
- (declare (optimize (speed 3))
- (ignore class))
- (if (sql-store-spec-p (:dbcn-spc-pst instance))
- (progn
+ (declare (optimize (speed 3)))
+ ;; NOTE: call remove-indexed-slot here instead?
+ (when (indexed slot-def)
+ (unregister-indexed-slot class (slot-definition-name slot-def)))
+ (if (sql-store-spec-p (:dbcn-spc-pst instance))
+ (progn
(let* ((sc (check-con (:dbcn-spc-pst instance)))
(con (controller-db sc)))
- (sql-remove-from-root
- (form-slot-key (oid instance) (slot-definition-name slot-def))
- sc
- con
- )
- ))
- (with-buffer-streams (key-buf)
+ (sql-remove-from-root
+ (form-slot-key (oid instance) (slot-definition-name slot-def))
+ sc
+ con
+ )
+ ))
+ (with-buffer-streams (key-buf)
(buffer-write-int (oid instance) key-buf)
(serialize (slot-definition-name slot-def) key-buf)
(db-delete-buffered
--- /project/elephant/cvsroot/elephant/src/collections.lisp 2006/02/04 22:25:09 1.14
+++ /project/elephant/cvsroot/elephant/src/collections.lisp 2006/02/07 23:23:50 1.15
@@ -121,11 +121,9 @@
(defclass bdb-indexed-btree (indexed-btree bdb-btree )
(
- (indices :accessor indices :initform (make-hash-table)
- )
+ (indices :accessor indices :initform (make-hash-table))
(indices-cache :accessor indices-cache :initform (make-hash-table)
- :transient t
-)
+ :transient t)
)
(:metaclass persistent-metaclass)
(:documentation "A BDB-based BTree supports secondary indices."))
@@ -276,6 +274,7 @@
(multiple-value-bind (index? secondary-key)
(funcall (key-fn index) index key value)
(when index?
+ ;; Manually write value into secondary index
(buffer-write-int (oid index) secondary-buf)
(serialize secondary-key secondary-buf)
;; should silently do nothing if the key/value already
@@ -355,7 +354,7 @@
"Puts are not allowed on secondary indices. Try adding to
the primary."
(declare (ignore value key)
- (ignorable bt))
+ (ignorable bt))
(error "Puts are forbidden on secondary indices. Try adding to the primary."))
(defgeneric get-primary-key (key bt)
--- /project/elephant/cvsroot/elephant/src/controller.lisp 2006/02/05 23:13:07 1.16
+++ /project/elephant/cvsroot/elephant/src/controller.lisp 2006/02/07 23:23:50 1.17
@@ -32,15 +32,17 @@
)
(defun get-controller (spec)
- (let ((store-controllers nil))
- (dolist (s *strategies*)
- (let ((sc (funcall s spec)))
- (if sc
- (push sc store-controllers))))
- (if (not (= (length store-controllers) 1))
- (error "Strategy resolution for this spec completely failed!")
- (car store-controllers))
- ))
+ (let ((cached-sc (gethash spec *dbconnection-spec*)))
+ (if cached-sc cached-sc
+ (let ((store-controllers nil))
+ (dolist (s *strategies*)
+ (let ((sc (funcall s spec)))
+ (if sc
+ (push sc store-controllers))))
+ (if (not (= (length store-controllers) 1))
+ (error "Strategy resolution for this spec completely failed!")
+ (car store-controllers))
+ ))))
(defclass store-controller ()
@@ -50,6 +52,7 @@
:accessor controller-path
:initarg :path)
(root :reader controller-root)
+ (class-root :reader controller-class-root)
(db :type (or null pointer-void) :accessor controller-db :initform '())
(environment :type (or null pointer-void)
:accessor controller-environment)
@@ -74,7 +77,7 @@
creation, counters, locks, the root (for garbage collection,)
et cetera."))
-;; Without somemore sophistication, these functions
+;; Without some more sophistication, these functions
;; need to be defined here, so that they will be available for testing
;; even if you do not use the strategy in question...
(defun bdb-store-spec-p (path)
@@ -105,6 +108,10 @@
"Close the db handles and environment. Tries to wipe out
references to the db handles."))
+(defgeneric reset-instance-cache (sc)
+ (:documentation
+ "Creates an empty object cache by replacing the existing cache."))
+
(defgeneric build-btree (sc)
(:documentation
"Construct a btree of the appropriate type corresponding to this store-controller."))
@@ -313,14 +320,23 @@
(let ((root (make-instance 'bdb-btree :from-oid -1 :sc sc)))
(setf (slot-value sc 'root) root))
+
+ (setf (slot-value sc 'class-root)
+ (make-instance 'bdb-btree :from-oid -2 :sc sc))
+
sc)))
+(defmethod reset-instance-cache ((sc store-controller))
+ (setf (instance-cache sc)
+ (make-cache-table :test 'eql)))
+
(defmethod close-controller ((sc bdb-store-controller))
(when (slot-value sc 'root)
;; no root
+ (setf (slot-value sc 'class-root) nil)
(setf (slot-value sc 'root) nil)
;; clean instance cache
- (setf (instance-cache sc) (make-cache-table :test 'eql))
+ (reset-instance-cache sc)
;; close handles / environment
(db-sequence-close (controller-oid-seq sc))
(setf (controller-oid-seq sc) nil)
@@ -336,7 +352,10 @@
(setf (controller-db sc) nil)
(db-env-close (controller-environment sc))
(setf (controller-environment sc) nil)
- nil))
+ nil)
+ ;; Delete connection spec so object ops on cached db info fail
+ (remhash (controller-path *store-controller*) *dbconnection-spec*))
+
;; Do these things need to take &rest arguments?
(defmethod build-btree ((sc bdb-store-controller))
@@ -387,15 +406,18 @@
the controller unconditionally on exit."
`(unwind-protect
(progn
- (let (*store-controller* (open-controller ,sc))
+ (let ((*store-controller* (open-controller ,sc)))
(declare (special *store-controller*))
,@body))
(close-controller ,sc)))
(defun close-store ()
"Conveniently close the store controller."
+ (declare (special *store-controller*))
(if *store-controller*
- (close-controller *store-controller*)))
+ (progn
+ (close-controller *store-controller*)
+ (setf *store-controller* nil))))
(defmacro with-open-store ((spec) &body body)
"Executes the body with an open controller,
--- /project/elephant/cvsroot/elephant/src/elephant.lisp 2006/02/04 22:25:09 1.19
+++ /project/elephant/cvsroot/elephant/src/elephant.lisp 2006/02/07 23:23:50 1.20
@@ -90,6 +90,24 @@
#:db-env-set-timeout #:db-env-get-timeout
#:db-env-set-flags #:db-env-get-flags
#:run-elephant-thread
+
+ ;; Class indexing management API
+ #:*default-indexed-class-synch-policy*
+ #:find-class-index #:find-inverted-index
+ #:enable-class-indexing #:disable-class-indexing
+ #:add-class-slot-index #:remove-class-slot-index
+ #:add-class-derived-index #:remove-class-derived-index
+ #:describe-db-class-index
+
+ ;; Low level cursor API
+ #:make-inverted-cursor #:make-class-cursor
+ #:with-inverted-cursor #:with-class-cursor
+
+ ;; Instance query API
+ #:get-instances-by-class
+ #:get-instances-by-value
+ #:get-instances-by-range
+ #:drop-instances
)
#+cmu
(:import-from :pcl
--- /project/elephant/cvsroot/elephant/src/index-tutorial.lisp 2006/02/03 04:19:44 1.1
+++ /project/elephant/cvsroot/elephant/src/index-tutorial.lisp 2006/02/07 23:23:50 1.2
@@ -0,0 +1,94 @@
+
+(defpackage elephant-tutorial
+ (:use :cl :elephant))
+
+(in-package :elephant-tutorial)
+
+(defclass simple-plog ()
+ ((timestamp :accessor plog-timestamp :initarg :timestamp :indexed t)
+ (type :accessor plog-type :initarg :type :indexed t)
+ (data :accessor plog-data :initarg :data)
+ (user :accessor plog-user :initarg :user :indexed t))
+ (:metaclass persistent-metaclass)
+ (:documentation "Simple persistent log"))
+
+(defclass url-record ()
+ ((url :accessor url-record-url :initarg :url :initform "")
+ (fetched :accessor url-record-fetched :initarg :fetched :initform nil)
+ (analyzed :accessor url-record-analyzed :initarg :analyzed :initform nil))
+ (:documentation "An application object, declared persistent but not indexed"))
+
+(defmethod print-object ((obj url-record) stream)
+ "Pretty print program objects so they're easy to inspect"
+ (format stream "<url: ~A ~A ~A>" (url-record-url obj) (url-record-fetched obj) (url-record-analyzed obj)))
+
+(defclass url-log (simple-plog) ()
+ (:metaclass persistent-metaclass)
+ (:documentation "This class tracks events that transform our program object state"))
+
+(defmethod print-object ((obj url-log) stream)
+ "Structured printing of log entries so they're easy to inspect at the repl"
+ (format stream "#plog[~A :: ~A]" (plog-type obj) (plog-data obj)))
+
+(defun log-event (user type data)
+ "A helper function to generically log various events by user"
+ (make-instance 'url-log
+ :timestamp (get-universal-time)
+ :type type
+ :data data
+ :user user))
+
+(defun report-events-by-time (user start end)
+ "A custom reporting function for our logs - pull out a time range. A real
+ implementation might do it by dates or by dates + times using one of the
+ lisp time libraries"
+ (let ((entries1 (get-instances-by-range 'url-log 'timestamp start end))
+ (entries2 (get-instances-by-value 'url-log 'user user)))
+ (format t "Event logs for ~A (~A range, ~A user):~%" user (length entries1) (length entries2))
+ (format t "~{~A~%~}" (nreverse (intersection entries1 entries2)))))
+
+;;
+;; This code is the skeleton of a program
+;;
+
+(defvar *start-timestamp* nil)
+(defvar *end-timestamp* nil)
+
+(defun generate-events (user count &optional delay)
+ (setf *start-timestamp* (get-universal-time))
+ (loop for i from 1 upto count do
+ (let ((url (get-a-url user i)))
+ (sleep delay)
+ (fetch-url url user)
+ (sleep delay)
+ (analyze-url url user)
+ (sleep delay)))
+ (setf *end-timestamp* (get-universal-time)))
+
+(defun get-a-url (user seq)
+ (let ((url (make-instance 'url-record :url (format nil "http://www.common-lisp.net/~A/" seq))))
+ (log-event user :received-url url)
+ url))
+
+(defun fetch-url (url user)
+ (setf (url-record-fetched url) t)
+ (log-event user :fetched-url url))
+
+(defun analyze-url (url user)
+ (setf (url-record-analyzed url) t)
+ (log-event user :analyzed-url url))
+
+;; Top Level Test Code
+
+(defun test-generate-and-report (name store-spec)
+ (open-store store-spec)
+ (generate-events name 10 0.2)
+ (report-events name)
+ (close-store))
+
+(defun report-events (name)
+ (let ((first-third-start *start-timestamp*)
+ (first-third-end (+ *start-timestamp*
+ (/ (- *end-timestamp* *start-timestamp*) 3))))
+ (report-events-by-time name first-third-start first-third-end)))
+
--- /project/elephant/cvsroot/elephant/src/index-utils.lisp 2006/01/30 05:09:12 1.1
+++ /project/elephant/cvsroot/elephant/src/index-utils.lisp 2006/02/07 23:23:50 1.2
@@ -0,0 +1,128 @@
+
+
+(in-package :elephant)
+
+;;
+;; Simple utilities for managing synchronization between class
+;; definitions and database state
+;;
+
+(defmethod class-index-cached? ((class persistent-metaclass))
+ (and (slot-boundp class '%index-cache)
+ (subtypep (type-of (%index-cache class)) 'btree)))
+
+(defmethod determine-synch-method ((class persistent-metaclass))
+ "This method should be called on the class if the %index-cache slot is
+ not a subtype of class btree to determine what synch method to call
+ on the current database btree. If DB doesn't exist, then you can ignore this"
+ (cond ((not (slot-boundp class '%index-cache))
+ *default-indexed-class-synch-policy*)
+ ((member (%index-cache class) '(:class :union :db))
+ (%index-cache class))
+ (t *default-indexed-class-synch-policy*)))
+
+(defmethod set-db-synch ((class persistent-metaclass) method)
+ "Tell the class the synch method to use to synchronize the class indices
+ and the current class definition"
+ (assert (member method '(:class :db :union)))
+ (setf (%index-cache class) method))
+
+;;
+;; Differentiate derived indices from slot-based ones
+;;
+
+(defparameter *derived-index-marker* "%%derived%%-")
+
+(defun make-derived-name (name)
+ (intern (format nil "~A~A" *derived-index-marker* name)))
+
+(defun derived-name? (name)
+ (when (symbolp name) (setf name (symbol-name name)))
+ (string= (subseq name 0 (min (length name)
+ (length *derived-index-marker*)))
+ *derived-index-marker*))
+
+(defun get-derived-name-root (dname)
+ (when (symbolp dname) (symbol-name dname))
+ (intern (subseq dname (length *derived-index-marker*))))
+
+;;
+;; Interface fn for slot key forms
+;;
+
+(defun make-slot-key-form (class name)
+ (assert (member name (car (%persistent-slots class))))
+ `(lambda (slot-index primary instance)
+ (declare (ignore slot-index primary))
+ (read-slot-for-index ',(class-name class) ',name instance)))
+
+(defun read-slot-for-index (class-name slot-name instance)
+ (let ((class (find-class class-name)))
+ (multiple-value-bind (found? slot-def) (find-effective-slot-def class slot-name)
+ (when (and found?
+ (slot-boundp-using-class class instance slot-def))
+ (values t (persistent-slot-reader instance slot-name))))))
+
+(defun find-effective-slot-def (class slot-name)
+ (loop for slot in (class-slots class) do
+ (when (eq (slot-definition-name slot) slot-name)
+ (return (values t slot)))))
+
+
+;;
+;; Simplify the computations for derived parameters
+;;
+
+(defun make-derived-key-form (dform)
+ "Change the index function interface for derived class slotsw
+ to better handle the various use cases. The provided function
+ accepts a single argument, the class instance to comput a
+ dervied parameter against. Dervied indices can
+ specify that the result should not be indexed by returning
+ two values (values nil t) the second of which is an ignore
+ specifier. Normal functions just return the value which is
+ an implicit index command. Accessors that compute against
+ unbound slots are silently ignored (ie initialization) and
+ errors of other types produce warnings and are ignored. This
+ handles both named functions and anonymous lambdas."
+ `(lambda (slot-index primary instance)
+ (declare (ignore slot-index primary))
+ (compute-derived-key-result instance #',dform)))
+
+(defun compute-derived-key-result (instance fn)
+ (handler-case
+ (multiple-value-bind (val ignore)
+ (funcall fn instance)
+ (if ignore
+ (values nil nil)
+ (values t val)))
+ (unbound-slot ()
+ (values nil nil))
+ (error (e)
+ (warn "Error ~A computing derived index for on instance ~A" e instance)
+ (values nil nil))))
+
+;;
+;; This has turned out to be useful for debugging
+;;
+
+
+(defun describe-db-class-index (class-name &key (sc *store-controller*))
+ (let ((class-idx (find-class-index class-name :sc sc)))
+ (if class-idx
+ (let ((names nil))
+ (maphash (lambda (k v)
+ (declare (ignore v))
+ (push k names))
+ (indices-cache class-idx))
+ (format t "Class Index: ~A~%" class-name)
+ (format t "~{~A~%~}" (nreverse names)))
+ (format t "No persistent index for class ~A.~%" class-name))))
+
+(defun wipe-indexed-class (name)
+ (ignore-errors
+ (disable-class-indexing name)
+ (reset-instance-cache *store-controller*)
+ (setf (find-class name) nil)))
+
+
--- /project/elephant/cvsroot/elephant/src/indexing.lisp 2006/01/26 04:03:44 1.1
+++ /project/elephant/cvsroot/elephant/src/indexing.lisp 2006/02/07 23:23:50 1.2
@@ -0,0 +1,548 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;
+;;; slot-index.lisp -- use btree collections to track objects by slot values
+;;; via metaclass options or accessor :after methods
+;;;
+;;; Initial version 1/24/2006 Ian Eslick
+;;; eslick at alum mit edu
+;;;
+;;; License: Lisp Limited General Public License
+;;; http://www.franz.com/preamble.html
+;;;
+
+(in-package "ELEPHANT")
+
+;;
+;; User level class indexing control protocol
+;;
+;; Operates against the current *store-controller*
+;; but many accept a :sc keyword to change the controller
+;; The specific indices created can be specialized on the
+;; controller type. See the internal implementor protocol
+;; below.
+
+(defparameter *default-indexed-class-synch-policy* :class
+ "[:union | :db | :class] determines which reference defines
+ the indexing structure after a reconnect to a persistent
+ store. If the class is redefined, the default is that the
+ class dominates. Changing this parameter alters the
+ default behavior to :union (merge indexed slots from database
+ and class definition) or :db which changes the indexing of
+ the class to match the db. This can fail in several ways:
+ a) the class does not have a persistent slot defined for
+ a slot index (will be treated as derived & fail on write)
+ b) A slot has been added with the name of a derived index
+ this will be confusing
+ c) The key-slot function definitions (if not an anoymous
+ lambda) may have changed leading to unexpected indexing")
+
+(defgeneric find-class-index (persistent-metaclass &rest rest)
+ (:documentation "This method is the way to access the class index via
+ the class object. We can always fetch it or we can cache it in
+ the class itself. It returns an indexed-btree."))
+
+(defgeneric find-inverted-index (persistent-metaclass index-name &key null-on-fail)
+ (:documentation "This method finds an inverted index defined on
+ the class described by persistent-metaclass."))
+
+(defgeneric enable-class-indexing (persistent-metaclass slot-names &rest rest)
+ (:documentation "Enable a class instance index for this object. It's
+ an expensive thing to support on writes so know that you need it
+ before you do it."))
+
+(defgeneric disable-class-indexing (persistent-metaclass &rest rest)
+ (:documentation "Delete and remove class instance indexing and any
+ secondary indices defined against it"))
+
+(defgeneric add-class-slot-index (persistent-metaclass slot-name &rest rest)
+ (:documentation "Add a per-slot class index option to the class
+ index based on the class accessor method"))
+
+(defgeneric remove-class-slot-index (persistent-metaclass slot-name &key sc)
+ (:documentation "Remove the per-slot index from the db"))
+
+(defgeneric add-class-derived-index (persistent-metaclass name derived-defun &rest rest)
+ (:documentation "Add a simple secondary index to this class based on
+ a function that computes a derived parameter. WARNING: derived
+ parameters are only valid on persistent slots. An arbitrary function
+ here will fail to provide consistency on transient slots or global
+ data that is not stored in the persistent store. Derived indexes are
+ deleted and rebuilt when a class is redefined"))
+
+(defgeneric remove-class-derived-index (persistent-metaclass name &rest rest)
+ (:documentation "Remove a derived index by providing the derived name
+ used to name the derived index"))
+
+
+;; ===========================
+;; INDEX UPDATE ROUTINE
+;; ===========================
+
+(defmethod indexed-slot-writer ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition) new-value)
+ "Anything that side effects a persistent-object slot should call this to keep
+ the dependant indices in synch. Only classes with derived indices need to
+ update on writes to non-indexed slots."
+ (let ((slot-name (slot-definition-name slot-def))
+ (oid (oid instance)))
+ (declare (type fixnum oid))
+ (if (no-indexing-needed? class instance slot-def oid)
+ (with-transaction ()
+ (persistent-slot-writer new-value instance slot-name))
+ (let ((class-idx (find-class-index class))
+ (*auto-commit* nil))
+;; (format t "Indexing object: ~A oid: ~A~%" instance oid)
+ (with-transaction ()
+ ;; NOTE: Quick and dirty hack to ensure consistency -- needs performance improvement
+ (when (get-value oid class-idx)
+ (remove-kv oid class-idx))
+ (persistent-slot-writer new-value instance slot-name)
+ (setf (get-value oid class-idx) instance))))))
+
+
+(defun no-indexing-needed? (class instance slot-def oid)
+ (or (and (not (indexed slot-def)) ;; not indexed
+ (not (indexing-record-derived (indexed-record class)))) ;; no derived indexes
+ (member oid *inhibit-indexing-list*))) ;; currently inhibited
+
+;; ===========================
+;; CLASS INDEX INTERFACE
+;; ===========================
+
+(defmethod find-class-index ((class-name symbol) &key (sc *store-controller*))
+ (find-class-index (find-class class-name) :sc sc))
+
+(defmethod find-class-index ((class persistent-metaclass) &key (sc *store-controller*))
+ (ensure-finalized class)
+ (if (class-index-cached? class)
+ ;; we've got a cached reference, just return it
+ (%index-cache class)
+ (multiple-value-bind (btree found)
+ (get-value (class-name class) (controller-class-root sc))
+ (if found
+ (cache-existing-class-index class btree sc)
+ (cache-new-class-index class sc)))))
+
+(defun ensure-finalized (class)
+ (when (not (class-finalized-p class))
+ (warn "Manually finalizing class ~A" (class-name class))
+ (finalize-inheritance class)))
+
+(defun cache-existing-class-index (class btree sc)
+ "If we have a persistent index already, assign, synchronize & return it"
+ (let ((method (determine-synch-method class)))
+ (setf (%index-cache class) btree)
+ (synchronize-class-to-store class :sc sc :method method)
+ btree))
+
+(define-condition persistent-class-not-indexed (error)
+ ((class-obj :initarg :class :initarg nil :reader :unindexed-class-obj)))
+
+(defun cache-new-class-index (class sc)
+ "If not cached or persistent then this is a new class, make the new index"
+ (if (indexed class)
+ (enable-class-indexing class (indexing-record-slots (indexed-record class)) :sc sc)
+ (signal 'persistent-class-not-indexed
+ :class class
+ :format-control "Class ~A is not enabled for indexing"
+ :format-arguments (list (class-name class)))))
+
+
+(defmethod find-inverted-index ((class symbol) slot &key (null-on-fail nil))
+ (find-inverted-index (find-class class) slot :null-on-fail null-on-fail))
+
+(defmethod find-inverted-index ((class persistent-metaclass) slot &key (null-on-fail nil))
+ (let* ((cidx (find-class-index class))
+ (dslot (make-derived-name slot))
+ (idx (or (get-index cidx slot)
+ (get-index cidx dslot))))
+ (if idx
+ idx
+ (if null-on-fail
+ nil
+ (error "Inverted index ~A not found for class ~A with
+ persistent slots: ~A" slot (class-name class) (car (%persistent-slots class)))))))
+
+(defmethod find-inverted-index-names ((class persistent-metaclass))
+ (let ((names nil))
+ (maphash (lambda (name idx)
+ (declare (ignore idx))
+ (push name names))
+ (indices (find-class-index class)))
+ names))
+
+;; =============================
+;; INDEXING INTERFACE
+;; =============================
+
+(defmethod enable-class-indexing ((class persistent-metaclass) indexed-slot-names &key (sc *store-controller*))
+ (let ((croot (controller-class-root sc)))
+ (multiple-value-bind (btree found)
+ (get-value (class-name class) croot)
+ (declare (ignore btree))
+ (when found (error "Class is already enabled for indexing! Run disable class indexing to clean up.")))
+ ;; Put class instance index into the class root & cache it in the class object
+ (with-transaction (:store-controller sc)
+ (let ((class-idx (build-indexed-btree sc)))
+ (setf (get-value (class-name class) croot) class-idx)
+ (setf (%index-cache class) class-idx)
+ ;; Add all the indexes
+ (loop for slot in indexed-slot-names do
+ (add-class-slot-index class slot :populate nil :sc sc))
+ ;; Sanity check
+ (let ((record (indexed-record class)))
+ (declare (ignorable record))
+ (assert (indexed class)))
+ class-idx))))
+
+(defmethod disable-class-indexing ((class-name symbol) &key (errorp t) (sc *store-controller*))
+ (let ((class (find-class class-name errorp)))
+ (when class
+ (disable-class-indexing class :sc sc))))
+
+(defmethod disable-class-indexing ((class persistent-metaclass) &key (sc *store-controller*) (errorp t))
+ (let ((class-idx (find-class-index class :sc sc)))
+ (unless class-idx (return-from disable-class-indexing nil))
+ ;; Remove all instance key/value data from the class index (& secondary indices)
+ (with-transaction (:store-controller sc)
+ (with-btree-cursor (cur class-idx)
+ (when (cursor-first cur)
+ (loop while (cursor-delete cur)))))
+ ;; Get the names of all indices & remove them
+ (let ((names nil))
+ (maphash (lambda (name secondary-index)
+ (declare (ignore secondary-index))
+ (push name names))
+ (indices-cache class-idx))
+ (dolist (name names)
+ (if (member name (class-slots class))
+ (remove-class-slot-index class name)
+ (with-transaction (:store-controller sc)
+ (remove-index class-idx name)))))
+ ;; Drop the class instance index from the class root
+ (with-transaction (:store-controller sc)
+ (remove-kv (class-name class) (controller-class-root sc)))
+ (setf (%index-cache class) nil)
+ ;; Clear out the current class
+ (update-indexed-record class nil)
+ ))
+
+(defmethod add-class-slot-index ((class symbol) slot-name &key (sc *store-controller*))
+ (add-class-slot-index (find-class class) slot-name :sc sc))
+
+(defmethod add-class-slot-index ((class persistent-metaclass) slot-name &key (sc *store-controller*) (populate t) (update-class t))
+ (if (find-inverted-index class slot-name :null-on-fail t)
+ (warn "Duplicate slot index named ~A requested for class ~A. Ignoring."
+ slot-name (class-name class))
+ (progn
+ (when update-class (register-indexed-slot class slot-name))
+ (with-transaction (:store-controller sc)
+ (add-index (find-class-index class :sc sc)
+ :index-name slot-name
+ :key-form (make-slot-key-form class slot-name)
+ :populate populate))
+ t)))
+
+(defmethod remove-class-slot-index ((class symbol) slot-name &key (sc *store-controller*))
+ (remove-class-slot-index (find-class class) slot-name :sc sc))
+
+(defmethod remove-class-slot-index ((class persistent-metaclass) slot-name &key (sc *store-controller*) (update-class t))
+ ;; NOTE: Write routines to recover BDB storage when you've wiped an index...
+ ;; NOTE: If the transaction aborts we should not update class slots?
+ (if (find-inverted-index class slot-name :null-on-fail t)
+ (progn
+ (when update-class (unregister-indexed-slot class slot-name))
+ (with-transaction (:store-controller sc)
+ (remove-index (find-class-index class :sc sc) slot-name))
+ t)
+ (progn
+ (warn "Slot index ~A not found for class ~A" slot-name (class-name class))
+ nil)))
+
+(defmethod add-class-derived-index ((class symbol) name derived-defun &key (sc *store-controller*) (populate t))
+ (add-class-derived-index (find-class class) name derived-defun :sc sc :populate populate))
+
+(defmethod add-class-derived-index ((class persistent-metaclass) name derived-defun &key (populate t) (sc *store-controller*) (update-class t))
+ (let ((class-idx (find-class-index class :sc sc)))
+ (if (find-inverted-index class (make-derived-name name) :null-on-fail t)
+ (error "Duplicate derived index requested named ~A on class ~A" name (class-name class))
+ (progn
+ (when update-class (register-derived-index class name))
+ (with-transaction (:store-controller sc)
+ (add-index class-idx
+ :index-name name
+ :key-form (make-derived-key-form derived-defun)
+ :populate populate))))))
+
+(defmethod remove-class-derived-index ((class symbol) name &key (sc *store-controller*))
+ (remove-class-derived-index (find-class class) name :sc sc))
+
+(defmethod remove-class-derived-index ((class persistent-metaclass) name &key (sc *store-controller*) (update-class t))
+ (if (find-inverted-index class name :null-on-fail t)
+ (progn
+ (when update-class (unregister-derived-index class name))
+ (with-transaction (:store-controller sc)
+ (remove-index (find-class-index class :sc sc) name))
+ t)
+ (progn
+ (warn "Derived index ~A does not exist in ~A" name (class-name class))
+ nil)))
+
+;; =========================
+;; Low level cursor API
+;; =========================
+
+(defgeneric make-inverted-cursor (persistent-metaclass name)
+ (:documentation "Define a cursor on the inverted (slot or derived) index"))
+
+(defgeneric make-class-cursor (persistent-metaclass)
+ (:documentation "Define a cursor over all class instances"))
+
+;; TODO!
+;;(defgeneric make-join-cursor ((class persistent-metaclass) &rest specification)
+;; (:documentation "Make a join cursor using the slot-value pairs in
+;; the specification assoc-list. Support for complex queries
+;; requiring new access to db-functions and a new cursor type"))
+
+;; implementation
+(defmethod make-inverted-cursor ((class persistent-metaclass) name)
+ (make-cursor (find-inverted-index class name)))
+
+(defmacro with-inverted-cursor ((var class name) &body body)
+ `(let ((,var (make-inverted-cursor ,class ,name)))
+ (unwind-protect (progn ,@body)
+ (cursor-close ,var))))
+
+(defmethod make-class-cursor ((class persistent-metaclass))
+ (make-cursor (find-class-index class)))
+
+(defmacro with-class-cursor ((var class) &body body)
+ `(let ((,var (make-class-cursor ,class)))
+ (unwind-protect (progn ,@body)
+ (cursor-close ,var))))
+
+
+;; =========================
+;; User-level lisp API
+;; =========================
+
+(defgeneric get-instances-by-class (persistent-metaclass))
+(defgeneric get-instances-by-value (persistent-metaclass slot-name value))
+(defgeneric get-instances-by-range (persistent-metaclass slot-name start end))
+
+;; map instances
+;; iterate over instances
+
+(defmethod get-instances-by-class ((class symbol))
+ (get-instances-by-class (find-class class)))
+
+(defmethod get-instances-by-class ((class persistent-metaclass))
+ (let ((instances nil)
+ (cidx (find-class-index class)))
+ (with-btree-cursor (cur cidx)
+ (multiple-value-bind (exists? key val) (cursor-first cur)
+ (declare (ignore key))
+ (when exists?
+ (push val instances)
+ (loop
+ (multiple-value-bind (exists? key val) (cursor-next cur)
+ (declare (ignore key))
+ (if exists?
+ (push val instances)
+ (return-from get-instances-by-class instances)))))))))
+
+(defmethod get-instances-by-value ((class symbol) slot-name value)
+ (get-instances-by-value (find-class class) slot-name value))
+
+(defmethod get-instances-by-value ((class persistent-metaclass) slot-name value)
+ (let ((instances nil))
+ (with-btree-cursor (cur (find-inverted-index class slot-name))
+ (multiple-value-bind (exists? skey val pkey) (cursor-pset cur value)
+ (declare (ignore skey pkey))
+ (when exists?
+ (push val instances)
+ (loop
+ (multiple-value-bind (exists? skey val pkey) (cursor-pnext-dup cur)
+ (declare (ignorable skey pkey))
+ (if exists?
+ (push val instances)
+ (return-from get-instances-by-value instances)))))))))
+
+(defmethod get-instances-by-range ((class symbol) slot-name start end)
+ (get-instances-by-range (find-class class) slot-name start end))
+
+(defmethod get-instances-by-range ((class persistent-metaclass) idx-name start end)
+ (with-inverted-cursor (cur class idx-name)
+ (labels ((next-range (instances)
+ (multiple-value-bind (exists? skey val pkey) (cursor-pnext-nodup cur)
+ (declare (ignore pkey))
+ (if (and exists? (<= skey end))
+ (next-in-range skey (cons val instances))
+ (nreverse instances))))
+ (next-in-range (key instances)
+ (multiple-value-bind (exists? skey val pkey) (cursor-pnext-dup cur)
+ (declare (ignore pkey skey))
+ (if exists?
+ (next-in-range key (cons val instances))
+ (progn
+ (cursor-pset-range cur key)
+ (next-range instances))))))
+ (multiple-value-bind (exists? skey val pkey) (cursor-pset-range cur start)
+ (declare (ignore pkey))
+ (if (and exists? (<= skey end))
+ (next-in-range skey (cons val nil))
+ nil)))))
+
+(defun drop-instances (instances &key (sc *store-controller*))
+ (assert (consp instances))
+ (with-transaction (:store-controller sc)
[151 lines skipped]
--- /project/elephant/cvsroot/elephant/src/metaclasses.lisp 2006/02/05 23:13:07 1.12
+++ /project/elephant/cvsroot/elephant/src/metaclasses.lisp 2006/02/07 23:23:51 1.13
@@ -24,6 +24,7 @@
(make-hash-table :test 'equal))
(defun connection-is-indeed-open (con)
+ (declare (ignore con))
t ;; I don't yet know how to implement this
)
@@ -65,17 +66,23 @@
to user-defined classes and collections.)"))
(defclass persistent-metaclass (standard-class)
- ((%persistent-slots :accessor %persistent-slots))
+ ((%persistent-slots :accessor %persistent-slots)
+ (%indexed-slots :accessor %indexed-slots)
+ (%index-cache :accessor %index-cache))
(:documentation
"Metaclass for persistent classes. Use this metaclass to
define persistent classes. All slots are persistent by
-default; use the :transient flag otherwise."))
+default; use the :transient flag otherwise. Slots can also
+be indexed for by-value retrieval."))
+
+;;
+;; Persistent slot maintenance
+;;
(defmethod persistent-slots ((class persistent-metaclass))
(if (slot-boundp class '%persistent-slots)
(car (%persistent-slots class))
- nil)
- (car (%persistent-slots class)))
+ nil))
(defmethod persistent-slots ((class standard-class))
nil)
@@ -91,8 +98,9 @@
nil)
)))
+
(defclass persistent-slot-definition (standard-slot-definition)
- ())
+ ((indexed :accessor indexed :initarg :indexed :initform nil :allocation :instance)))
(defclass persistent-direct-slot-definition (standard-direct-slot-definition persistent-slot-definition)
())
@@ -117,6 +125,115 @@
(defmethod transient ((slot persistent-direct-slot-definition))
nil)
+;;
+;; Indexed slots maintenance
+;;
+
+;; This just encapsulates record keeping a bit
+(defclass indexing-record ()
+ ((slots :accessor indexing-record-slots :initarg :slots :initform nil)
+ (derived-count :accessor indexing-record-derived :initarg :derived :initform 0)))
+
+(defmethod print-object ((obj indexing-record) stream)
+ (format stream "#INDEXING-RECORD<islt: ~A dslt: ~A>"
+ (length (indexing-record-slots obj))
+ (length (indexing-record-derived obj))))
+
+(defmethod indexed-record ((class standard-class))
+ nil)
+(defmethod indexed-record ((class persistent-metaclass))
+ (car (%indexed-slots class)))
+
+(defmethod old-indexed-record ((class persistent-metaclass))
+ (cdr (%indexed-slots class)))
+
+(defmethod update-indexed-record ((class persistent-metaclass) new-slot-list)
+ (let ((oldrec (if (slot-boundp class '%indexed-slots)
+ (indexed-record class)
+ nil)))
+ (setf (%indexed-slots class)
+ (cons (make-instance 'indexing-record
+ :slots new-slot-list
+ :derived (when oldrec (indexing-record-derived oldrec)))
+ (if oldrec oldrec nil)))))
+
+(defun indexed-slot-names-from-defs (class)
+ (let ((slot-definitions (class-slots class)))
+ (loop for slot-definition in slot-definitions
+ when (and (subtypep (type-of slot-definition) 'persistent-slot-definition)
+ (indexed slot-definition))
+ collect (slot-definition-name slot-definition))))
+
+(defmethod register-indexed-slot ((class persistent-metaclass) slot)
+ "This method allows for post-definition update of indexed status of
+ class slots. It changes the effective method so we can rely on
+ generic function dispatch for differentated behavior"
+ ;; update record
+ (let ((record (indexed-record class)))
+ (unless (member slot (car (%persistent-slots class)))
+ (error "Tried to register slot ~A as index which isn't a persistent slot" slot))
+ (unless (member slot (indexing-record-slots record))
+;; This is a normal startup case, but during other cases we'd like
+;; the duplicate warning
+;; (warn "Tried to index slot ~A which is already indexed" slot))
+ (push slot (indexing-record-slots record))))
+ ;; change effective slot def
+ (let ((slot-def (find-slot-def-by-name class slot)))
+ (unless slot-def
+ (error "Slot definition for slot ~A not found, inconsistent state in
+ class ~A" slot (class-name class)))
+ (setf (slot-value slot-def 'indexed) t)))
+
+(defmethod unregister-indexed-slot (class slot)
+ "Revert an indexed slot to it's original state"
+ ;; update record
+ (let ((record (indexed-record class)))
+ (unless (member slot (indexing-record-slots record))
+ (error "Tried to unregister slot ~A which is not indexed" slot))
+ (setf (indexing-record-slots record) (remove slot (indexing-record-slots record))))
+ ;; change effective slot def status
+ (let ((slot-def (find-slot-def-by-name class slot)))
+ (unless slot-def
+ (error "Slot definition for slot ~A not found, inconsistent state in
+ class ~A" slot (class-name class)))
+ (setf (slot-value slot-def 'indexed) nil)))
+
+(defmethod register-derived-index (class name)
+ "Tell the class that it has derived indices defined against it
+ and keep a reference count"
+ (let ((record (indexed-record class)))
+ (push name (indexing-record-derived record))))
+
+(defmethod unregister-derived-index (class name)
+ (let ((record (indexed-record class)))
+ (setf (indexing-record-derived record) (remove name (indexing-record-derived record)))))
+
+(defmethod indexed ((class persistent-metaclass))
+ (and (slot-boundp class '%indexed-slots )
+ (or (indexing-record-slots (indexed-record class))
+ (indexing-record-derived (indexed-record class)))))
+
+(defmethod indexed ((slot standard-slot-definition)) nil)
+(defmethod indexed ((class standard-class)) nil)
+
+(defvar *inhibit-indexing-list* nil
+ "Use this to avoid updating an index inside
+ low-level functions that update groups of
+ slots at once. We may need to rethink this
+ if we go to a cheaper form of update that
+ doesn't batch update all indices")
+
+(defun inhibit-indexing (uid)
+ (pushnew uid *inhibit-indexing-list*))
+
+(defun uninhibit-indexing (uid)
+ (setf *inhibit-indexing-list*
+ (delete uid *inhibit-indexing-list*)))
+
+;;
+;; Original support for persistent slot protocol
+;;
+
#+allegro
(defmethod excl::valid-slot-allocation-list ((class persistent-metaclass))
'(:instance :class :database))
@@ -128,12 +245,16 @@
"Checks for the transient tag (and the allocation type)
and chooses persistent or transient slot definitions."
(let ((allocation-key (getf initargs :allocation))
- (transient-p (getf initargs :transient)))
+ (transient-p (getf initargs :transient))
+ (indexed-p (getf initargs :indexed)))
(when (consp transient-p) (setq transient-p (car transient-p)))
+ (when (consp indexed-p) (setq indexed-p (car indexed-p)))
(cond ((and (eq allocation-key :class) transient-p)
(find-class 'transient-direct-slot-definition))
((and (eq allocation-key :class) (not transient-p))
(error "Persistent class slots are not supported, try :transient t."))
+ ((and indexed-p transient-p)
+ (error "Cannot declare slots to be both transient and indexed"))
(transient-p
(find-class 'transient-direct-slot-definition))
(t
@@ -161,9 +282,13 @@
(defmethod effective-slot-definition-class ((class persistent-metaclass) &rest initargs)
"Chooses the persistent or transient effective slot
definition class depending on the keyword."
- (let ((transient-p (getf initargs :transient)))
+ (let ((transient-p (getf initargs :transient))
+ (indexed-p (getf initargs :indexed)))
(when (consp transient-p) (setq transient-p (car transient-p)))
- (cond (transient-p
+ (when (consp indexed-p) (setq indexed-p (car indexed-p)))
+ (cond ((and indexed-p transient-p)
+ (error "Cannot declare a slot to be both indexed and transient"))
+ (transient-p
(find-class 'transient-effective-slot-definition))
(t
(find-class 'persistent-effective-slot-definition)))))
@@ -213,11 +338,13 @@
(defmethod compute-effective-slot-definition-initargs ((class persistent-metaclass) slot-definitions)
(let ((initargs (call-next-method)))
(if (ensure-transient-chain slot-definitions initargs)
- (append initargs '(:transient t))
- (progn
- (setf (getf initargs :allocation) :database)
- initargs))))
-
+ (setf initargs (append initargs '(:transient t)))
+ (setf (getf initargs :allocation) :database))
+ ;; Effective slots are indexed only if the most recent slot definition
+ ;; is indexed. NOTE: Need to think more about inherited indexed slots
+ (if (indexed (first slot-definitions))
+ (append initargs '(:indexed t))
+ initargs)))
(defmacro persistent-slot-reader (instance name)
`(if (not (bdb-store-spec-p (:dbcn-spc-pst ,instance)))
@@ -229,7 +356,7 @@
(let ((buf (db-get-key-buffered
(controller-db (check-con (:dbcn-spc-pst ,instance)))
key-buf value-buf)))
- (if buf (deserialize buf :sc (check-con (:dbcn-spc-pst instance)))
+ (if buf (deserialize buf :sc (check-con (:dbcn-spc-pst ,instance)))
#+cmu
(error 'unbound-slot :instance ,instance :slot ,name)
#-cmu
@@ -301,7 +428,7 @@
(defun persistent-slot-names (class)
(let ((slot-definitions (class-slots class)))
(loop for slot-definition in slot-definitions
- when (equalp (class-of slot-definition) (find-class 'persistent-effective-slot-definition))
+ when (subtypep (type-of slot-definition) 'persistent-effective-slot-definition)
collect (slot-definition-name slot-definition))))
(defun transient-slot-names (class)
--- /project/elephant/cvsroot/elephant/src/sleepycat.lisp 2006/02/04 22:25:09 1.18
+++ /project/elephant/cvsroot/elephant/src/sleepycat.lisp 2006/02/07 23:23:51 1.19
@@ -102,8 +102,8 @@
(eval-when (:compile-toplevel :load-toplevel)
(defparameter *c-library-extension*
- #+macosx "dylib"
- #-macosx "so" ))
+ #+(or darwin macosx) "dylib"
+ #-(or darwin macosx) "so" ))
(eval-when (:compile-toplevel :load-toplevel)
--- /project/elephant/cvsroot/elephant/src/sql-collections.lisp 2006/02/04 22:25:09 1.3
+++ /project/elephant/cvsroot/elephant/src/sql-collections.lisp 2006/02/07 23:23:51 1.4
@@ -25,7 +25,6 @@
(:metaclass persistent-metaclass)
(:documentation "A SQL-based BTree supports secondary indices."))
-
(defmethod get-value (key (bt sql-btree-index))
"Get the value in the primary DB from a secondary key."
(declare (optimize (speed 3)))
1
0