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)