[elephant-cvs] CVS elephant/src

[ieslick]

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)