From ieslick at common-lisp.net  Thu Mar  1 02:45:45 2007
From: ieslick at common-lisp.net (ieslick)
Date: Wed, 28 Feb 2007 21:45:45 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070301024545.DC7F92B0E2@common-lisp.net>

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

Added Files:
	query-example.lisp query.lisp 
Log Message:
Quick hack for object filtering queries; example of first pass at constraint syntax


--- /project/elephant/cvsroot/elephant/src/elephant/query-example.lisp	2007/03/01 02:45:45	NONE
+++ /project/elephant/cvsroot/elephant/src/elephant/query-example.lisp	2007/03/01 02:45:45	1.1

(in-package :elephant)

;; TEST DATA

(defparameter *constraint-spec*
  '(:BDB "/Users/eslick/Work/db/constraint/"))

(defun print-name (inst)
  (format t "Name: ~A~%" (slot-value inst 'name)))

(defpclass person ()
  ((name :initarg :name :index t)
   (salary :initarg :salary :index t)
   (department :initarg :dept)))

(defpclass department ()
  ((name :initarg :name)
   (manager :initarg :manager)))

(defparameter *names* 
    '("Jacob"
      "Emily"
"Michael"
"Emma"
"Joshua"
"Madison"
"Matthew"
"Abigail"
"Ethan"
"Olivia"
"Andrew"
"Isabella"
"Daniel"
"Hannah"
"Anthony"
"Samantha"
"Christopher"
"Ava"
"Joseph"
"Ashley"
))

(defun test-dataset ()
  (let* ((greg (make-instance 'person :name "Greg" :salary 100000))
	 (sally (make-instance 'person :name "Sally" :salary 110000))
	 (mkt (make-instance 'department :name "Marketing" :manager greg))
	 (engr (make-instance 'department :name "Engineering" :manager sally)))
    (setf (slot-value greg 'department) mkt)
    (setf (slot-value sally 'department) engr)
    (with-transaction ()
      (loop for i from 0 upto 500 do
	   (make-instance 'person 
			  :name (format nil "~A~A" (utils:random-element *names*) i)
			  :salary (floor (+ (* (random 1000) 150) 30000))
			  :department (if (= 1 (random 2)) mkt engr))))))

(defun print-person (person &optional (stream t))
  (format stream "name: ~A salary: ~A dept: ~A~%" 
	  (slot-value person 'name) (slot-value person 'salary) 
	  (slot-value (slot-value person 'department) 'name)))

(defun example-query1 ()
  "Performs a query against a single class.  Trivial string & integer matchingA"
  (map-class-query #'print-person
		   '((person name = "Greg")
		     (person salary >= 100000))))

(defun example-query2 (low-salary high-salary)
  "Parameterized query"
  (map-class-query #'print-person
		   `((person salary >= ,low-salary)
		     (person salary <= ,high-salary))))

		   
--- /project/elephant/cvsroot/elephant/src/elephant/query.lisp	2007/03/01 02:45:45	NONE
+++ /project/elephant/cvsroot/elephant/src/elephant/query.lisp	2007/03/01 02:45:45	1.1
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;
;;; query.lisp -- Implement syntax for the elephant query engine
;;; 
;;; Copyright (c) 2007 by  Ian S. Eslick
;;; <ieslick at common-lisp.net>
;;;
;;; Elephant users are granted the rights to distribute and use this software
;;; as governed by the terms of the Lisp Limited General Public License
;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;

(in-package :elephant)

(defparameter *string-relation-functions*
  `((< . ,#'string<)
    (< . ,#'string<=)
    (> . ,#'string>)
    (> . ,#'string>=)
    (= . ,#'equal)
    (!= . ,(lambda (x y) (not (equal x y))))))

(defparameter *number-relation-functions*
  `((< . ,#'<)
    (> . ,#'>)
    (= . ,#'=)
    (!= . ,#'(lambda (x y) (not (= x y))))))

(defun relation-string-function (rel)
  (cdr (assoc rel *string-relation-functions*)))

(defun relation-number-function (rel)
  (cdr (assoc rel *number-relation-functions*)))

(defun test-relation (rel ival tvals)
  (assert (or (and (numberp ival) (numberp (first tvals)))
	      (and (stringp ival) (stringp (first tvals)))))
  (typecase ival
    (string (funcall (relation-string-function rel) ival (first tvals)))
    (number (funcall (relation-number-function rel) ival (first tvals)))))
      
(defun get-query-instances (constraints)
  (let ((list nil))
    (flet ((collect (inst)
	     (push inst list)))
      (declare (dynamic-extent collect))
      (map-class-query #'collect constraints))))

(defun map-class-query (fn constraints)
  "Map instances using the query constaints to filter objects, exploiting
   slot indices (for last query) and stack allocated test closures"
  (assert (not (null constraints)))
  (destructuring-bind (class slot relation &rest values) (first constraints)
    (flet ((filter-by-relation (inst)
	     (when (test-relation relation (slot-value inst slot) values)
	       (funcall fn inst))))
      (declare (dynamic-extent filter-by-relation))
      (if (null (cdr constraints))
	  (if (find-inverted-index class slot)
	      (if (= (length values) 1)
		  (progn
		    (map-class-index fn class slot (first values) (first values))
		    (map-class-index fn class slot (first values) (second values))))
	      (map-class #'filter-by-relation class))
	  (map-class-query #'filter-by-relation (cdr constraints))))))
       
;;
;; Conjunctions of indices
;;

;;(defun map-classes (fn classes)
;;  (map-index-list fn (mapcar #'find-class-index classes)))

;;(defun map-index-list (fn indices)
;;  (dolist (index indices)
;;    (map-index fn index)))


From ieslick at common-lisp.net  Thu Mar  1 02:46:42 2007
From: ieslick at common-lisp.net (ieslick)
Date: Wed, 28 Feb 2007 21:46:42 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070301024642.C82212B0E2@common-lisp.net>

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

Modified Files:
	elephant.asd 
Log Message:
Windows build support

--- /project/elephant/cvsroot/elephant/elephant.asd	2007/02/26 19:12:18	1.35
+++ /project/elephant/cvsroot/elephant/elephant.asd	2007/03/01 02:46:42	1.36
@@ -96,6 +96,62 @@
    can be overridden or augmented by subclass methods"
   #+(or mswindows windows)
   (progn
+    (let* ((pathname (component-pathname c))
+           (directory (directory-namestring pathname))
+           (stdout-lines) (stderr-lines) (exit-status))
+      (let ((command (format nil "~A ~{~A ~}"
+                       (c-compiler-path c)
+                       (compiler-options (c-compiler c) c
+                                         :input-file (format nil "\"~A\"" (namestring pathname))
+                                         :output-file nil
+                                         :library nil))))
+        #+allegro (multiple-value-setq (stdout-lines stderr-lines exit-status) 
+		    (excl.osi:command-output command :directory directory))
+        #+lispworks (setf exit-status (system:call-system command :current-directory directory))
+        (unless (zerop exit-status)
+          (error 'operation-error :component c :operation o)))
+
+      (let ((command (format nil "dlltool -z ~A --export-all-symbols -e exports.o -l ~A ~A"
+                       (format nil "\"~A\"" (namestring (make-pathname :type "def" :defaults pathname)))
+                       (format nil "\"~A\"" (namestring (make-pathname :type "lib" :defaults pathname)))
+                       (format nil "\"~A\"" (namestring (make-pathname :type "o" :defaults pathname))))))
+        #+allegro (multiple-value-setq (stdout-lines stderr-lines exit-status) 
+                      (excl.osi:command-output command :directory directory))
+        #+lispworks (setf exit-status (system:call-system command :current-directory directory))
+        (unless (zerop exit-status)
+          (error 'operation-error :component c :operation o)))
+
+      (let ((command (format nil "~A ~{~A ~}"  ;; -I~A -L~A -l~A
+                             (c-compiler-path c)
+                             (compiler-options (c-compiler c) c
+                                               :input-file
+                                               (list (format nil "\"~A\"" (namestring 
+                                                                           (make-pathname :type "o" :defaults pathname)))
+                                                     "exports.o")
+                                               :output-file (format nil "\"~A\"" (first (output-files o c)))
+                                               :library t))))
+        #+allegro (multiple-value-setq (stdout-lines stderr-lines exit-status)
+                      (excl.osi:command-output command :directory directory))
+        #+lispworks (setf exit-status (system:call-system command :current-directory directory))
+        (unless (zerop exit-status)
+          (error 'operation-error :component c :operation o)))))
+
+  #-(or mswindows windows)
+  (unless (zerop (run-shell-command
+		  "~A ~{~A ~}"
+		  (c-compiler-path c)
+		  (compiler-options (c-compiler c) c
+				    :input-file (namestring (component-pathname c))
+				    :output-file (namestring (first (output-files o c))))))
+    (error 'operation-error :component c :operation o)))
+
+#|
+(defmethod perform ((o compile-op) (c elephant-c-source))
+  "Run the appropriate compiler for this platform on the source, getting
+   the specific options from 'compiler-options method.  Default options 
+   can be overridden or augmented by subclass methods"
+  #+(or mswindows windows)
+  (progn
     (let ((pathname (component-pathname c)))
       (unless (zerop (run-shell-command
 		      (format nil "~A ~{~A ~}"
@@ -130,6 +186,12 @@
 				    :input-file (namestring (component-pathname c))
 				    :output-file (namestring (first (output-files o c))))))
     (error 'operation-error :component c :operation o)))
+|#
+
+;;Cygwin compile script:
+;;gcc -mno-cygwin -mwindows -std=c99 -c libmemutil.c
+;;dlltool -z libmeutil.def --export-all-symbols -e exports.o -l libmemutil.lib libmemutil.o
+;;gcc -shared -mno-cygwin -mwindows libmemutil.o exports.o -o libmemutil.dll
 
 (defmethod operation-done-p ((o compile-op) (c elephant-c-source))
   "Is the first generated library more recent than the source file?"
@@ -167,12 +229,6 @@
     (if (listp input-file) input-file (list input-file))
     (when output-file (list "-o" output-file))))
 
-;;Cygwin script:
-;;gcc -mno-cygwin -mwindows -std=c99 -c libmemutil.c
-;;dlltool -z libmeutil.def --export-all-symbols -e exports.o -l libmemutil.lib libmemutil.o
-;;gcc -shared -mno-cygwin -mwindows libmemutil.o exports.o -o libmemutil.dll
-
-
 (defmethod compiler-options ((compiler (eql :msvc)) (c elephant-c-source) &key input-file output-file)
   (declare (ignore input-file output-file))
   (error "MSVC compiler option not supported yet"))



From ieslick at common-lisp.net  Thu Mar  1 03:03:07 2007
From: ieslick at common-lisp.net (ieslick)
Date: Wed, 28 Feb 2007 22:03:07 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070301030307.8DEA46A004@common-lisp.net>

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

Modified Files:
	TODO 
Log Message:
Cleanup

--- /project/elephant/cvsroot/elephant/TODO	2007/02/26 19:12:18	1.64
+++ /project/elephant/cvsroot/elephant/TODO	2007/03/01 03:03:07	1.65
@@ -37,7 +37,7 @@
 - Multi-threading stress tests?  Ensure that there are conflicts and lots of serialization
   happening concurrently to make sure that multi-threading is in good shape (Henrik's code)
 - Unicode tests
-  - Ensure that variable length UTF-8 is automatically stored as UTF-16
+  - Ensure that variable length UTF-8 reps are automatically stored as UTF-16
 - Class / DB sychronization tests
 
 TASKS TO GET TO FINAL RELEASE:



From ieslick at common-lisp.net  Sat Mar  3 17:24:59 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat,  3 Mar 2007 12:24:59 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/db-bdb
Message-ID: <20070303172459.4F9A5D002@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src/db-bdb
In directory clnet:/tmp/cvs-serv18095/src/db-bdb

Modified Files:
	berkeley-db.lisp 
Log Message:
Fixes for Win32 allegro build; lispwork builds but fails to run; new test of :index class keyword which fails

--- /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp	2007/02/17 12:13:19	1.9
+++ /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp	2007/03/03 17:24:58	1.10
@@ -21,6 +21,7 @@
 
 (declaim 
  #-elephant-without-optimize (optimize (speed 3) (safety 0))
+ #-lispworks
  (inline %db-get-key-buffered db-get-key-buffered 
 		 %db-get-buffered db-get-buffered db-get 
 		 %db-put-buffered db-put-buffered 



From ieslick at common-lisp.net  Sat Mar  3 17:24:58 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat,  3 Mar 2007 12:24:58 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070303172458.DBD06D001@common-lisp.net>

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

Modified Files:
	TODO ele-bdb.asd 
Log Message:
Fixes for Win32 allegro build; lispwork builds but fails to run; new test of :index class keyword which fails

--- /project/elephant/cvsroot/elephant/TODO	2007/03/01 03:03:07	1.65
+++ /project/elephant/cvsroot/elephant/TODO	2007/03/03 17:24:55	1.66
@@ -20,10 +20,9 @@
 - Migration: Improve scaling properties of migration so all objects do not need to be resident in memory?
 - Migration: Validate that graph structures with loop are copied properly
 - Migration: Improve printing and informative messages
+- Fix class index slot option (and validate test)
 
 Lisp Support:
-- Win32 builds
-  - Windows support for asdf-based library builds?  Include 32-bit dll in release?
 - Validate Lispworks on PC
 - Validate OpenMCL pre-1.1 on Mac OS X
 - Validate OpenMCL 1.1 and/or 64-bit on Mac OS X?
@@ -67,6 +66,7 @@
 x Fix a bug where slot-makunbound on a persistent object failed to remove secondary index references
   for class and slot indices.  Made a test to validate this. (Ian)
 x Fixed a bug in string serialization for char-code > #x7F (Henrik, Ties)
+x 
 
 Minor Bugs:
 x Enable with-transactions to properly process forms returning multiple values (Ian)
@@ -83,6 +83,7 @@
 x Orthogonal feature addition: map-index, map-class and map-instances to avoid consing (Ian)
 x Tests to validate new map interfaces on top of existing tests (Ian)
 x Added support and tests for serializing structure objects on all supported platforms (Ian)
+x Fixed cygwin-ming32 -mno-cygwin build for Windows for Lispworks and Allegro (Frank, Ian)
 
 DEVELOPMENT CHECKINS:
 
--- /project/elephant/cvsroot/elephant/ele-bdb.asd	2007/02/22 20:24:11	1.18
+++ /project/elephant/cvsroot/elephant/ele-bdb.asd	2007/03/03 17:24:58	1.19
@@ -32,24 +32,21 @@
 (defmethod compiler-options ((compiler (eql :gcc)) (c bdb-c-source) &key &allow-other-keys)
   (append (library-directories c)
 	  (call-next-method)
-	  (list "-ldb")))
+	  (list "-ldb45")))
 
 (defmethod compiler-options ((compiler (eql :cygwin)) (c bdb-c-source) &key &allow-other-keys)
   (append (library-directories c)
 	  (call-next-method)
-	  (list "-ldb")))
+	  (list "-ldb45")))
 
 (defun library-directories (c)
   (let ((include (make-pathname :directory (get-config-option :berkeley-db-include-dir c)))
 	(lib (make-pathname :directory (get-config-option :berkeley-db-lib-dir c))))
+    #+(or windows mswindows)
+    (list (format nil "-L\"~A\"" lib) (format nil "-I\"~A\"" include))
+    #-(or windows mswindows)
     (list (format nil "-L~A" lib) (format nil "-I~A" include))))
 
-
-;;Cygwin script:
-;;gcc -mno-cygwin -mwindows -c -Wall -std=c99 -L/c/DB/Berkeley\ DB\ 4.4.20/lib/ -I/c/DB/Berkeley\ DB\ 4.4.20/include/ libsleepycat.c
-;;dlltool -z libsleepycat.def --export-all-symbols -e exports.o -l libsleepycat.lib libsleepycat.o
-;;gcc -shared -mno-cygwin -mwindows -L/c/DB/Berkeley\ DB\ 4.4.20/bin/ -llibdb44 libsleepycat.o exports.o -o libsleepycat.dll
-
 (defmethod foreign-libraries-to-load-first ((c bdb-c-source))
   (remove-if #'(lambda (x) (null (car x)))
 	     (list



From ieslick at common-lisp.net  Sat Mar  3 17:24:59 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat,  3 Mar 2007 12:24:59 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070303172459.D5262706A@common-lisp.net>

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

Modified Files:
	classes.lisp serializer.lisp 
Log Message:
Fixes for Win32 allegro build; lispwork builds but fails to run; new test of :index class keyword which fails

--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/02/26 19:55:12	1.18
+++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/03 17:24:59	1.19
@@ -49,26 +49,18 @@
 
 (defmethod ensure-class-using-class :around ((class (eql nil)) name &rest args &key index)
   "Support the :index class option"
-  (let ((result (apply #'call-next-method class name (remove-index-keyword args))))
+  (let ((result (apply #'call-next-method class name (remove-keywords '(:index) args))))
     (when (and index (subtypep (type-of result) 'persistent-metaclass))
       (update-indexed-record result nil :class-indexed t))
     result))
 
 (defmethod ensure-class-using-class :around ((class persistent-metaclass) name &rest args &key index)
   "Support the :index class option on redefinition"
-  (let ((result (apply #'call-next-method class name (remove-index-keyword args))))
+  (let ((result (apply #'call-next-method class name (remove-keywords '(:index) args))))
     (when index
       (update-indexed-record result nil :class-indexed t))
     result))
 				     
-(defun remove-index-keyword (list)
-  (cond ((null list) 
-	 nil)
-	((eq (car list) :index)
-	 (cddr list))
-	(t 
-	 (cons (car list) (remove-index-keyword (cdr list))))))
-
 (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))
--- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp	2007/02/26 19:12:18	1.24
+++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp	2007/03/03 17:24:59	1.25
@@ -259,10 +259,5 @@
   "Shared byte-spec peformance hack; not thread safe so removed
    from use for serializer2"
   (declare (type (unsigned-byte 24) position))
-;;  #+(or cmu sbcl allegro)
-;;  (progn (setf (cdr *resourced-byte-spec*) (* 32 position))
-;;	 *resourced-byte-spec*)
-;;  #-(or cmu sbcl allegro)
-  (byte 32 (* 32 position))
-  )
+  (byte 32 (* 32 position)))
 



From ieslick at common-lisp.net  Sat Mar  3 17:25:00 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat,  3 Mar 2007 12:25:00 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/memutil
Message-ID: <20070303172500.6EFE5A145@common-lisp.net>

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

Modified Files:
	memutil.lisp 
Log Message:
Fixes for Win32 allegro build; lispwork builds but fails to run; new test of :index class keyword which fails

--- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp	2007/02/26 19:12:19	1.24
+++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp	2007/03/03 17:24:59	1.25
@@ -828,12 +828,13 @@
 ;; This code is an attempt to allow compilation under bothe SBCL 8 and SBCL 9.
 ;; Thanks to Juho Snellman for this idiom.
 (eval-when (:compile-toplevel)
-  #+(and sbcl sb-unicode)
   (defun new-style-copy-p ()
+    #+(and sbcl sb-unicode)
     (if (find-symbol "COPY-UB8-FROM-SYSTEM-AREA" "SB-KERNEL")
 	'(:and) 
-	'(:or)))
-  )
+	'(:or))
+    #-(and sbcl sb-unicode)
+    t))
 
 (defun buffer-read-ucs1-string (bs byte-length)
   "Read a UCS1 string."



From ieslick at common-lisp.net  Sat Mar  3 17:25:00 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat,  3 Mar 2007 12:25:00 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/utils
Message-ID: <20070303172500.0539C140B7@common-lisp.net>

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

Modified Files:
	convenience.lisp 
Log Message:
Fixes for Win32 allegro build; lispwork builds but fails to run; new test of :index class keyword which fails

--- /project/elephant/cvsroot/elephant/src/utils/convenience.lisp	2007/02/24 14:52:00	1.3
+++ /project/elephant/cvsroot/elephant/src/utils/convenience.lisp	2007/03/03 17:25:00	1.4
@@ -31,10 +31,10 @@
     (setf (car subsets) (nreverse (car subsets)))
     (nreverse subsets)))
 
-(defun remove-keywords (key-names args)
-  (loop for ( name val ) on args by #'cddr
-	unless (member name key-names)
-	append (list name val)))
+(defun remove-keywords (keywords list)
+  (cond ((null list) nil)
+	((member (car list) keywords) (cddr list))
+	(t (cons (car list) (remove-keywords keywords (cdr list))))))
 
 (defun concat-separated-strings (separator &rest lists)
   (format nil (concatenate 'string "~{~A~^" (string separator) "~}")



From ieslick at common-lisp.net  Sat Mar  3 17:25:05 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat,  3 Mar 2007 12:25:05 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20070303172505.F04C73C00E@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv18095/tests

Modified Files:
	testindexing.lisp 
Log Message:
Fixes for Win32 allegro build; lispwork builds but fails to run; new test of :index class keyword which fails

--- /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2007/02/26 19:55:13	1.31
+++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2007/03/03 17:25:01	1.32
@@ -102,6 +102,20 @@
 	))
   3 2 1 t 3)
 
+(deftest indexing-class-opt
+    (progn
+      (when (class-indexedp-by-name 'idx-cslot)
+	(disable-class-indexing 'idx-cslot :errorp nil)
+	(setf (find-class 'idx-cslot) nil))
+      
+      (defclass idx-cslot ()
+	((slot1 :initarg :slot1 :initform 0 :accessor slot1))
+	(:metaclass persistent-metaclass :index t))
+
+      (values (class-indexedp-by-name 'idx-cslot)))
+  t)
+      
+
 ;; test inherited slots
 (deftest indexing-inherit
     (progn 



From ieslick at common-lisp.net  Sun Mar  4 20:22:48 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sun,  4 Mar 2007 15:22:48 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/db-bdb
Message-ID: <20070304202248.4D09E7E008@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src/db-bdb
In directory clnet:/tmp/cvs-serv26542

Modified Files:
	bdb-transactions.lisp 
Log Message:
Fixed bdb execute transations to properly return multiple values

--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-transactions.lisp	2007/02/20 19:12:58	1.10
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-transactions.lisp	2007/03/04 20:22:47	1.11
@@ -40,21 +40,22 @@
 					:txn-sync txn-sync))))
 	 (declare (type pointer-void txn))
 	 (let ((result
-		(let ((*current-transaction* (make-transaction-record sc txn))
-		      (*store-controller* sc))
-		  (declare (special *current-transaction* *store-controller*))
-		  (catch 'transaction
-		    (unwind-protect
-			 (multiple-value-prog1 
-			     (funcall txn-fn)
-			   (db-transaction-commit txn 
-						  :txn-nosync txn-nosync
-						  :txn-sync txn-sync)
-			   (setq success t))
-		      (unless success 
-			(db-transaction-abort txn)))))))
+		(multiple-value-list
+		 (let ((*current-transaction* (make-transaction-record sc txn))
+		       (*store-controller* sc))
+		   (declare (special *current-transaction* *store-controller*))
+		   (catch 'transaction
+		     (unwind-protect
+			  (multiple-value-prog1 
+			      (funcall txn-fn)
+			    (db-transaction-commit txn 
+						   :txn-nosync txn-nosync
+						   :txn-sync txn-sync)
+			    (setq success t))
+		       (unless success 
+			 (db-transaction-abort txn))))))))
 	   (unless (and (eq result txn) (not success))
-	     (return result))))
+	     (return (values-list result)))))
        finally (error "Too many retries in transaction"))))
     
 (defmethod controller-start-transaction ((sc bdb-store-controller)



From ieslick at common-lisp.net  Tue Mar  6 04:15:01 2007
From: ieslick at common-lisp.net (ieslick)
Date: Mon,  5 Mar 2007 23:15:01 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/query
Message-ID: <20070306041501.D444163062@common-lisp.net>

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

Log Message:
Directory /project/elephant/cvsroot/elephant/src/query added to the repository





From ieslick at common-lisp.net  Tue Mar  6 04:15:27 2007
From: ieslick at common-lisp.net (ieslick)
Date: Mon,  5 Mar 2007 23:15:27 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070306041527.388A911D2@common-lisp.net>

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

Modified Files:
	collections.lisp package.lisp 
Log Message:
Placeholders and notes for query engine

--- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/02/20 20:03:45	1.11
+++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/06 04:15:27	1.12
@@ -164,6 +164,11 @@
 (defgeneric make-cursor (bt)
   (:documentation "Construct a cursor for traversing BTrees."))
 
+(defgeneric make-simple-cursor (bt)
+  (:documentation "Allow users to walk secondary indices and only 
+                   get back primary keys rather than associated 
+                   primary values"))
+
 (defgeneric cursor-close (cursor)
   (:documentation 
    "Close the cursor.  Make sure to close cursors before the
--- /project/elephant/cvsroot/elephant/src/elephant/package.lisp	2007/02/26 19:12:18	1.21
+++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp	2007/03/06 04:15:27	1.22
@@ -73,7 +73,7 @@
 	   #:lookup-persistent-symbol-id
 	   #:int-byte-spec
 
-	   #:cursor #:secondary-cursor #:make-cursor 
+	   #:cursor #:secondary-cursor #:make-cursor #:make-simple-cursor
 	   #:cursor-close #:cursor-init
 	   #:cursor-duplicate #:cursor-current #:cursor-first
 	   #:cursor-last #:cursor-next #:cursor-next-dup



From ieslick at common-lisp.net  Tue Mar  6 04:15:27 2007
From: ieslick at common-lisp.net (ieslick)
Date: Mon,  5 Mar 2007 23:15:27 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/query
Message-ID: <20070306041527.77CEC11D1@common-lisp.net>

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

Added Files:
	algebra.lisp compile.lisp execute.lisp merge.lisp 
	planning.lisp query.lisp syntax.lisp 
Log Message:
Placeholders and notes for query engine


--- /project/elephant/cvsroot/elephant/src/query/algebra.lisp	2007/03/06 04:15:27	NONE
+++ /project/elephant/cvsroot/elephant/src/query/algebra.lisp	2007/03/06 04:15:27	1.1
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;
;;; query.lisp -- Implement syntax for the elephant query engine
;;; 
;;; Copyright (c) 2007 by  Ian S. Eslick
;;; <ieslick at common-lisp.net>
;;;
;;; Elephant users are granted the rights to distribute and use this software
;;; as governed by the terms of the Lisp Limited General Public License
;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;

(in-package :elephant)

;;
;; Relational algebra
;;

(defparameter *relation-algebra-grammar*
  '((select <op> <attr> <attr or value> <nset>)
    (project <op> <attr-list> <nset>)
    (rename <attr> <attr> <nset>)
    (union <nset> <nset>)
    (intersection <nset> <nset>)
    (difference <nset> <nset>)
    (divide <nset> <nset>)
    (natural-join <attr> <nset> <attr> <nset>)
    (theta-join op <attr> <nset> <attr> <nset>)
    (semi-join <attr> <nset> <attr> <nset>)
    (anti-join <attr> <nset> <attr> <nset>)))

;;
;; Theorems
;;

;; (select op <attr> <nset>) = (select op <attr> (select op <attr> <nset>)) ;; idempotence
;; (select (and op1 op2) <attr> <nset>) = (select op1 <attr> (select op2 <attr> <nset>)) ;; commutivity
;; (select (or op1 op2) <attr> <nset>) = (union (select op1 <attr> <nset>) (select op1 <attr> <nset>)) ;; commutivity
;; (select op <attr1> <value> (union <nset1> <nset2>)) = (union (select op <attr1> <value> <nset1>) (select ...)) ;; distributivity
;; (select opA (intersection <nset1> <nset2>)) = (intersection <nset1> (select opA <nset2>))) ;; distributivity
;; (select opA (intersection <nset1> <nset2>)) = (intersection (select opA <nset1>) <nset2>) 
;; (select opA (intersection <nset1> <nset2>)) = (intersection (select opA <nset1>) (select opA <nset1>)) 

;;
;; Optimize/Rewrite - reduce estimated set sizes
;;
;; Exercise theorems to perform certain heuristic optimizations (push selects through joins)


--- /project/elephant/cvsroot/elephant/src/query/compile.lisp	2007/03/06 04:15:27	NONE
+++ /project/elephant/cvsroot/elephant/src/query/compile.lisp	2007/03/06 04:15:27	1.1
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;
;;; query.lisp -- Implement syntax for the elephant query engine
;;; 
;;; Copyright (c) 2007 by  Ian S. Eslick
;;; <ieslick at common-lisp.net>
;;;
;;; Elephant users are granted the rights to distribute and use this software
;;; as governed by the terms of the Lisp Limited General Public License
;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;

(in-package :elephant)

;;
;; Compilation
;;
;; Inline execution operators using interpetive plan as template
;; as part of a macro operation


--- /project/elephant/cvsroot/elephant/src/query/execute.lisp	2007/03/06 04:15:27	NONE
+++ /project/elephant/cvsroot/elephant/src/query/execute.lisp	2007/03/06 04:15:27	1.1
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;
;;; query.lisp -- Implement syntax for the elephant query engine
;;; 
;;; Copyright (c) 2007 by  Ian S. Eslick
;;; <ieslick at common-lisp.net>
;;;
;;; Elephant users are granted the rights to distribute and use this software
;;; as governed by the terms of the Lisp Limited General Public License
;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;

(in-package :elephant)

;;
;; Execution
;;
;; Generate interpretive template for execution of plan; execute so
;; internal map does not require more than one in-memory tuple at a time


--- /project/elephant/cvsroot/elephant/src/query/merge.lisp	2007/03/06 04:15:27	NONE
+++ /project/elephant/cvsroot/elephant/src/query/merge.lisp	2007/03/06 04:15:27	1.1
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;
;;; merge.lisp -- Implement efficient OID lists for merge-sort
;;; 
;;; Copyright (c) 2007 by  Ian S. Eslick
;;; <ieslick at common-lisp.net>
;;;
;;; Elephant users are granted the rights to distribute and use this software
;;; as governed by the terms of the Lisp Limited General Public License
;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;

(in-package :elephant)

;;
;; Quick and dirty oid-set abstraction
;;

;; Notes:
;; Add pool abstraction later to reuse tenured arrays
;; Use foreign memory?
;; Paged-to-disk approaches for when we blow out main memory?

(defparameter *initial-set-size* 1000)
(defparameter *set-growth-factor* 1.5)

;;
;; Create sets
;; 

(defun default-oid-set-elements ()
  (make-array 1000 
	      :element-type 'fixnum
	      :initial-element 0
	      :fill-pointer 0
	      :adjustable t))

(defclass oid-set ()
  ((elements :accessor set-elements :initarg :elements 
	     :initform (default-oid-set-elements))
   (oid-order :accessor set-ordered-p :initarg :ordered-p :initform nil)))

(defmethod push-oid (oid (set oid-set))
  "If values are ascending, set is built in sorted order"
  (vector-push-extend oid (set-elements set) (floor (* *set-growth-factor* (length (set-elements set)))))
  (setf (set-ordered-p set) nil)
  oid)

(defmethod pop-oid ((set oid-set))
  (vector-pop (set-elements set)))

;; do we need remove/insert?

;;
;; Operations on sets
;; 

(defmethod sorted-elements ((set oid-set))
  (if (set-ordered-p set)
      (set-elements set)
      (sort-set set)))

(defmethod sort-set ((set oid-set))
  "Sort the set elements and return the elements"
  (sort (set-elements set) #'<)
  (setf (set-ordered-p set) t)
  (set-elements set))

(defmethod sort-merge-sets ((set1 oid-set) (set2 oid-set) &optional (remove-duplicates t))
  (let ((new-elements
	 (merge '(array fixnum (*) :adjustable t :fill-pointer t) (sorted-elements set1) (sorted-elements set2) #'<)))
    (make-instance 'oid-set 
		   :elements (if remove-duplicates
				 (delete-duplicates new-elements)
				 new-elements)
		   :ordered-p t)))

(defmethod merge-sets ((set1 oid-set) (set2 oid-set) &optional (remove-duplicates t))
  (let ((target (make-instance 'oid-set :ordered-p t)))
    (let ((elts1 (sorted-elements set1))
	  (elts2 (sorted-elements set2))
	  (offset1 0)
	  (offset2 0)
	  (last nil))
      (loop until (or (= offset1 (fill-pointer elts1))
		      (= offset2 (fill-pointer elts2)))
	   do
	   (let ((elt1 (aref elts1 offset1))
		 (elt2 (aref elts2 offset2)))
	     (cond ((= elt1 elt2) 
		    (incf offset1) 
		    (incf offset2)
		    (unless (and remove-duplicates (eq last elt1))
		      (push-oid elt1 target) 
		      (setf last elt1)))
		   ((< elt1 elt2)
		    (push-oid elt1 target)
		    (incf offset1))
		   ((< elt2 elt1)
		    (push-oid elt2 target)
		    (incf offset2))))))
    target))

(defmethod intersect-sets ((set1 oid-set) (set2 oid-set))
  (let ((target (make-instance 'oid-set :ordered-p t)))
    (let ((elts1 (sorted-elements set1))
	  (elts2 (sorted-elements set2))
	  (offset1 0)
	  (offset2 0))
      (loop until (or (= offset1 (fill-pointer elts1))
		      (= offset2 (fill-pointer elts2)))
	   do
	   (let ((elt1 (aref elts1 offset1))
		 (elt2 (aref elts2 offset2)))
	     (cond ((= elt1 elt2)
		    (incf offset1)
		    (incf offset2)
		    (push-oid elt1 target))
		   ((< elt1 elt2)
		    (incf offset1))
		   ((< elt2 elt1)
		    (incf offset2))))))
    target))


;;
;; Test code
;;

(defun push-random-oids (set amount &optional (max 1000))
  (loop for i from 0 upto amount do
    (push-oid (random max) set))
  set)



--- /project/elephant/cvsroot/elephant/src/query/planning.lisp	2007/03/06 04:15:27	NONE
+++ /project/elephant/cvsroot/elephant/src/query/planning.lisp	2007/03/06 04:15:27	1.1
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;
;;; query.lisp -- Implement syntax for the elephant query engine
;;; 
;;; Copyright (c) 2007 by  Ian S. Eslick
;;; <ieslick at common-lisp.net>
;;;
;;; Elephant users are granted the rights to distribute and use this software
;;; as governed by the terms of the Lisp Limited General Public License
;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;

(in-package :elephant)

;;
;; Planner
;;
;; Generate all possible access plans to O-relations
;; Generate all possible joins of O-relations
;; Organize into equiv. classes
;; Evaluate the cost of options in equiv classes
;; Select best in each class
;; Roll cost upto whole join tree
;; Iterate each join tree to repeat with other joins
;; Do best-first through equiv classes?

--- /project/elephant/cvsroot/elephant/src/query/query.lisp	2007/03/06 04:15:27	NONE
+++ /project/elephant/cvsroot/elephant/src/query/query.lisp	2007/03/06 04:15:27	1.1
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;
;;; query.lisp -- Implement syntax for the elephant query engine
;;; 
;;; Copyright (c) 2007 by  Ian S. Eslick
;;; <ieslick at common-lisp.net>
;;;
;;; Elephant users are granted the rights to distribute and use this software
;;; as governed by the terms of the Lisp Limited General Public License
;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;

(in-package :elephant)

;;
;; User query API
;;

(defmacro map-query (fn constraints)
  (let ((classes (constraint-expr-classes constraints))
	(plan (compile-query-plan (parse-constraints constraints))))
    `(map-query-plan ,fn ,plan)))

;;(defun map-constraints (fn classes plan)
;;  (declare (dynamic-extent sc))

;;
;; Wrappers and standard operations for map-constraints
;;

(defmacro with-collector ((collector-var &key function init expr) &body body)
  "Instantiates a list collector to pass to a mapping function and
   the whole expression returns the result of the collector.  For
   something other than list construction, expr can be used.  If function
   is used, it is assumed to be the name of a function of two variables
   of two arguments where the first argument is the collector variable
   and the second is the current value being mapped.  It should return
   the new value of the collector variable.  Otherwise it is an expression
   containing a followed by a function body
   has the form of an flet entry with one parameter (name (arg) body).
   Init is the initial value of the result variable"
  (with-gensyms (result-var elt)
    `(let ((,result-var ,init))
       (flet ((,collector-var
		  ,@(cond ((and (null expr) (null function))
			   `((,elt)
			     (push ,elt ,result-var)))
			  (function
			   `((,elt)
			     (setf ,result-var (funcall ,function ,result-var ,elt))))
			  (expr
			   (multiple-value-bind (arg &body body) expr
			     `((,arg) , at body))))))
	 (declare (dynamic-extent ,collector-var))
	 , at body))))
--- /project/elephant/cvsroot/elephant/src/query/syntax.lisp	2007/03/06 04:15:27	NONE
+++ /project/elephant/cvsroot/elephant/src/query/syntax.lisp	2007/03/06 04:15:27	1.1
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;
;;; syntax.lisp -- Implement syntax for the elephant query engine
;;; 
;;; Copyright (c) 2007 by  Ian S. Eslick
;;; <ieslick at common-lisp.net>
;;;
;;; Elephant users are granted the rights to distribute and use this software
;;; as governed by the terms of the Lisp Limited General Public License
;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;

(in-package :elephant)

;;
;; Operations and aggregators
;;

(defvar *legal-operators*
  '(= /= < > <= >= 
    string= string/= string< string> string>= string<=
    string-equalp string-not-equal string-lessp string-not-lessp string-greaterp string-not-greaterp
    map member
    type-p subtype-p))

(defun legal-operator-p (op)
  (member op *legal-operators*))

(defparameter *legal-aggregation-operators*
  '(and or xor))

(defun aggregation-operator-p (atom)
  (member op *legal-aggregation-operators*))

;;
;; Parser
;;
;; Transform surface expressions to RA expressions with set object-relation closure property

;; (map-query fn (a b)
;;   (:with ((mgr person) (job job)))
;;   (:declare (type person emp)
;; 	    (type project proj)
;; 	    (type department (department person)))
;;   (:constraints or :where
;;    (between (start-date proj) (convert-date "July 5th 1996") (convert-date "November 1st 1996"))
;;    (eq (project emp) proj)
;;    (member (name (department emp)) '("Marketing" "Administration"))
;;    (eq (supervisor emp) mgr)
;;    (>= (slot salary mgr) 100000)))

;; Parser entry

(defun get-clause (namelist clauses &optional error)
  (assert namelist)
  (setf namelist (mklist namelist))
  (aif (assoc (car namelist) clauses)
       (cdr it)
       (if (null (cdr namelist))
	   (when error (error error))
	   (get-clause (cdr namelist) clauses error))))

(defun parse-query-syntax (query)
  (construct-ra-graph
   (parse-constraints 
      (get-clause '(:constraints constraints :where where) query)
    (parse-declarations 
       (get-clause '(:declare declare) query)
     (parse-targets (get-clause '(:with with) query)
		    (make-relation-dictionary))))))

;; Dictionary

(defun make-relation-dictionary ()
  (cons nil nil))

(defun add-set (name class stmt dictionary &optional annotations)
  (push (list name class stmt annotations) (car dictionary)))

(defun lookup-set (name dict)
  (awhen (assoc name (car dict))
    it))

(defun set-name (setrec)
  (first setrec))

(defun set-type (setrec)
  (second setrec))

(defun set-statement (setrec)
  (third setrec))


[145 lines skipped]


From ieslick at common-lisp.net  Tue Mar  6 04:15:27 2007
From: ieslick at common-lisp.net (ieslick)
Date: Mon,  5 Mar 2007 23:15:27 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/utils
Message-ID: <20070306041527.B4ABF11D2@common-lisp.net>

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

Modified Files:
	convenience.lisp package.lisp 
Log Message:
Placeholders and notes for query engine

--- /project/elephant/cvsroot/elephant/src/utils/convenience.lisp	2007/03/03 17:25:00	1.4
+++ /project/elephant/cvsroot/elephant/src/utils/convenience.lisp	2007/03/06 04:15:27	1.5
@@ -45,3 +45,27 @@
   (let ((results (car list)))
     (dolist (elem (cdr list) results)
       (setq results (append results elem)))))
+
+(defmacro ifret (pred alt)
+  "If pred is non-null, return the value, otherwise return the alternate value"
+  (with-gensyms (res)
+  `(let ((,res ,pred))
+     (if ,res ,res ,alt))))
+
+(defmacro aif (pred default alt)
+  "Anaphoric if"
+  `(let ((it ,pred))
+     (if it ,default ,alt)))
+
+(defmacro awhen (pred &rest body)
+  "Anaphoric when"
+  `(let ((it ,pred))
+     (declare (ignorable it))
+     (when it
+       , at body)))
+
+(defun mklist (elts)
+  "Make sure the argument is a list or 
+   make it a list if it's an atom"
+  (if (listp elts) elts (list elts)))
+
--- /project/elephant/cvsroot/elephant/src/utils/package.lisp	2007/02/24 14:52:00	1.4
+++ /project/elephant/cvsroot/elephant/src/utils/package.lisp	2007/03/06 04:15:27	1.5
@@ -32,4 +32,9 @@
    #:do-subsets
    #:subsets
    #:remove-keywords
-   #:with-gensyms))
+   #:with-gensyms
+   #:ifret
+   #:aif
+   #:awhen
+   #:mklist
+   #:it))



From ieslick at common-lisp.net  Tue Mar  6 04:16:46 2007
From: ieslick at common-lisp.net (ieslick)
Date: Mon,  5 Mar 2007 23:16:46 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/contrib/eslick/query-sketch
Message-ID: <20070306041646.2596933084@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch
In directory clnet:/tmp/cvs-serv27401/query-sketch

Log Message:
Directory /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch added to the repository





From ieslick at common-lisp.net  Tue Mar  6 04:17:14 2007
From: ieslick at common-lisp.net (ieslick)
Date: Mon,  5 Mar 2007 23:17:14 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/contrib/eslick/query-sketch
Message-ID: <20070306041714.95D0B4E03B@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch
In directory clnet:/tmp/cvs-serv27507/eslick/query-sketch

Added Files:
	constraint-parser.lisp query-algebra.lisp query-planner.lisp 
	query-syntax.lisp scratch.lisp 
Log Message:
Archive of various attacks on query system


--- /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/constraint-parser.lisp	2007/03/06 04:17:14	NONE
+++ /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/constraint-parser.lisp	2007/03/06 04:17:14	1.1
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;
;;; query-syntax.lisp -- Implement syntax for the elephant query engine
;;; 
;;; Copyright (c) 2007 by  Ian S. Eslick
;;; <ieslick at common-lisp.net>
;;;
;;; Elephant users are granted the rights to distribute and use this software
;;; as governed by the terms of the Lisp Limited General Public License
;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;

(in-package :elephant)

;;
;; Constraint graph
;;

(defclass constraint-graph ()
  ((variables :accessor constraint-variables :initarg :vars :initform nil)
   (edges :accessor constraint-edges :initarg :edges :initform nil)))

(defmethod find-constraint-variable ((graph constraint-graph) var-name)
  (find var-name (constraint-variables graph) :test #'variable-name))

(defmethod find-constraint-edge ((graph constraint-graph) var1 var2)
  (when (symbolp var1)
    (setf var1 (find-constraint-variable graph var1)))
  (when (symbolp var2)
    (setf var2 (find-constraint-variable graph var2)))
  (flet ((match-p (edge)
	   (and (or (eq (edge-src edge) var1)
		    (eq (edge-dst edge) var1))
		(or (eq (edge-dst edge) var2)
		    (eq (edge-src edge) var2)))))
    (find nil (constraint-edges graph) :test #'match-p)))

(defmethod add-constraint ((graph constraint-graph) var constraint bindings)
  (unless (find-constraint-variable graph var)
    (make-instance 'constraint-variable 
		   :class (get-var-class bindings var)
		   (push constraint (constraint-variables (find-constraint-variable graph var))))))

(defclass constraint-variable ()
  ((name :accessor variable-name :initarg :name)
   (class :accessor variable-class :initarg :class)
   (constraints :accessor variable-constraints :initarg :constraints :initform nil)))

(defclass edge ()
  ((src :accessor edge-src :initarg :src)
   (dst :accessor edge-dst :initarg :dst)
   (constraint :accessor destination-constraint :initarg :constraint)))

(defclass constraint ()
  ((class :accessor constraint-class :initarg :class)
   (fn :accessor constraint-fn :initarg :test-fn
       :documentation "Predicate accepting an instance and returns 
                       whether it was accepted (t) or rejected (nil)")
   (expr :accessor constraint-expr :initarg :test-expr
	 :documentation "Predicate expression for inline expansion")))

(defclass value-constraint (constraint)
  ((slot :accessor constraint-slot :initarg :slot :initform nil)
   (indexed-p :accessor indexed-p :initarg :indexed-p :initform nil)
   (index-type :accessor index-type :initarg :type :initform t)
   (range-p :accessor range-p :initarg :range-p :initform nil)
   (value :accessor constraint-value :initarg :value)))

(defmethod initialize-index-info ((c value-constraint))
  (when (constraint-slot c)
    (let ((idx (find-inverted-index (constraint-class c) (constraint-slot c) :null-on-fail t)))
      (when idx (setf (indexed-p c) t)))))

(defclass range-constraint (constraint)
  ((range :accessor constraint-range :initarg :range)))

(defclass and-constraint (constraint)
  ((constraints :accessor constraints :initarg :constraints)))
(defclass or-constraint (constraint) ())
(defclass xor-constraint (constraint) ())

;;
;; Constraint patterns for parsing
;;

(defvar *constraint-dictionary*
  '((= parse-numeric)
    (< parse-numeric range)
    (> parse-numeric range)
    (>= parse-numeric range)
    (<= parse-numeric range)
    (string= parse-string)
    (string< parse-string range)
    (string> parse-string range)
    (string>= parse-string range)
    (string<= parse-string range)
    (member parse-member)
    (fn parse-function)
    (between parse-range)
    (or parse-or)
    (and parse-and)
    (eq parse-equiv)))

(defun parse-constraint (expr bindings graph)
  (let ((op (first expr)))
    (multiple-value-bind (var constraint) 
	(funcall (symbol-function (second (assoc op *constraint-dictionary*)))
		 expr binding)
      (add-constraint graph var constraint bindings))))
	     

(defun parse-numeric (expr bindings)
  (destructuring-bind (rel (slot var) value) expr
    (assert (numberp value))
    (values var
	    (make-instance 'value-constraint 
			   :slot slot
			   :range-p nil
			   :class (binding-class var)
			   :value value
			   :expr `((inst) (,rel (slot-value inst ,slot) ,value))))))

;;
;; Bindings
;;

(defun make-constraint-bindings ()
  (make-hash-table :test #'equal))

(defun add-binding (name rec bindings)
  (setf (gethash name bindings) rec))

(defun get-binding (name bindings)
  (gethash name bindings))

(defun make-binding (type name)
  (list type name))

(defun binding-type (rec)
  (first rec))

(defun binding-target (rec)
  (second rec))


--- /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/query-algebra.lisp	2007/03/06 04:17:14	NONE
+++ /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/query-algebra.lisp	2007/03/06 04:17:14	1.1
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;
;;; merge.lisp -- Implement efficient OID lists for merge-sort
;;; 
;;; Copyright (c) 2007 by  Ian S. Eslick
;;; <ieslick at common-lisp.net>
;;;
;;; Elephant users are granted the rights to distribute and use this software
;;; as governed by the terms of the Lisp Limited General Public License
;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;

(in-package :elephant)

--- /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/query-planner.lisp	2007/03/06 04:17:14	NONE
+++ /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/query-planner.lisp	2007/03/06 04:17:14	1.1
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;
;;; query-planner.lisp -- Implement syntax for the elephant query engine
;;; 
;;; Copyright (c) 2007 by  Ian S. Eslick
;;; <ieslick at common-lisp.net>
;;;
;;; Elephant users are granted the rights to distribute and use this software
;;; as governed by the terms of the Lisp Limited General Public License
;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;

(in-package :elephant)

;; ================================================================================
;; Simple graph abstraction for keeping track of plan constraints
;; ================================================================================

(defclass edge ()
  ((type :accessor edge-type :initarg :type :initform nil)
   (source :accessor edge-source :initarg :source :initform nil)
   (target :accessor edge-target :initarg :target :initform nil)))

(defclass graph ()
  ((edges :accessor edge-list :initarg :edges :initform nil)
   (nodes :accessor node-list :initarg :nodes :initform nil)))

;; =============================
;; Query Plans
;; =============================

;; These operations are the basis for estimating the cost
;; of different orderings of query operations.  For simple
;; queries this is unnecessary, but for queries with constraints
;; between classes, this is very useful.

(defclass query-op ()
  ((set-size :accessor set-size :initarg :set-size :initform 0)
   (page-queries :accessor page-queries :initarg :page-queries :initform 0)
   (slot-queries :accessor slot-queries :initarg :slot-queries :initform 0)))

(defclass instance-op ()
  ((class :accessor op-class :initarg :cost)
   (constraints :accessor op-constraints :initarg :constraints)))

(defclass index-op (instance-op)
  ((index :accessor query-index :initarg :cons)))

(defclass scan-op (instance-op) 
  ()
  (:documentation "Scan the class applying the per-instance operator"))

;; intersection, unions
(defclass merge-op (query-op)
  ((merge-type :accessor merge-type :initarg :type :initform :intersection)))



(defun compute-constraint-graph (constraint-expr)
  ""

(defun compute-query-plan (constraints)
  "Given a constraint graph, compute a query plan"
--- /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/query-syntax.lisp	2007/03/06 04:17:14	NONE
+++ /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/query-syntax.lisp	2007/03/06 04:17:14	1.1
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;
;;; query-syntax.lisp -- Implement syntax for the elephant query engine
;;; 
;;; Copyright (c) 2007 by  Ian S. Eslick
;;; <ieslick at common-lisp.net>
;;;
;;; Elephant users are granted the rights to distribute and use this software
;;; as governed by the terms of the Lisp Limited General Public License
;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;

(in-package :elephant)

;; Want syntax such that we can recursively walk the definition and
;; produce a query graph that can be subject to algebraic optimization
;; How to handle nested queries?

(string= (name (department inst)) "Marketing")

;; Name unique, no idx on dept
inst := (class people)
v1 := (lookup-select string= (name department) "marketing")
s1 := (class-select ref= department people v1)
s2 := (class-select < salary people 100k)
s3 := (join s1 s2)
s4 := (objects s3)

;; graph of instance sets and selections against them


;;
;; Constraint graph
;;

(defclass constraint-graph ()
  ((variables :accessor constraint-variables :initarg :vars :initform nil)
   (edges :accessor constraint-edges :initarg :edges :initform nil)))

(defmethod find-constraint-variable ((graph constraint-graph) var-name)
  (find var-name (constraint-variables graph) :test #'variable-name))

(defmethod find-constraint-edge ((graph constraint-graph) var1 var2)
  (when (symbolp var1)
    (setf var1 (find-constraint-variable graph var1)))
  (when (symbolp var2)
    (setf var2 (find-constraint-variable graph var2)))
  (flet ((match-p (edge)
	   (and (or (eq (edge-src edge) var1)
		    (eq (edge-dst edge) var1))
		(or (eq (edge-dst edge) var2)
		    (eq (edge-src edge) var2)))))
    (find nil (constraint-edges graph) :test #'match-p)))

(defmethod add-constraint ((graph constraint-graph) var constraint bindings)
  (unless (find-constraint-variable graph var)
    (make-instance 'constraint-variable 
		   :class (get-var-class bindings var)
		   (push constraint (constraint-variables (find-constraint-variable graph var)))

(defclass constraint-variable ()
  ((name :accessor variable-name :initarg :name)
   (class :accessor variable-class :initarg :class)
   (constraints :accessor variable-constraints :initarg :constraints :initform nil)))

(defclass edge ()
  ((src :accessor edge-src :initarg :src)
   (dst :accessor edge-dst :initarg :dst)
   (constraint :accessor destination-constraint :initarg :constraint)))

(defclass constraint ()
  ((class :accessor constraint-class :initarg :class)
   (fn :accessor constraint-fn :initarg :test-fn
       :documentation "Predicate accepting an instance and returns 
                       whether it was accepted (t) or rejected (nil)")
   (expr :accessor constraint-expr :initarg :test-expr
	 :documentation "Predicate expression for inline expansion")))

(defclass value-constraint (constraint)
  ((slot :accessor constraint-slot :initarg :slot :initform nil)
   (indexed-p :accessor indexed-p :initarg :indexed-p :initform nil)
   (index-type :accessor index-type :initarg :type :initform t)
   (range-p :accessor range-p :initarg :range-p :initform nil)
   (value :accessor constraint-value :initarg :value)))

(defmethod initialize-index-info ((c value-constraint))
  (when (constraint-slot c)
    (let ((idx (find-inverted-index (constraint-class c) (constraint-slot c) :null-on-fail t)))
      (when idx (setf (indexed-p c) t)))))

(defclass range-constraint (constraint)
  ((range :accessor constraint-range :initarg :range)))

(defclass and-constraint (constraint)
  ((constraints :accessor constraints :initarg :constraints)))
(defclass or-constraint (constraint) ())
(defclass xor-constraint (constraint) ())

;;
;; Constraint patterns for parsing
;;

(defvar *constraint-dictionary*
  '((= parse-numeric)
    (< parse-numeric range)
    (> parse-numeric range)
    (>= parse-numeric range)
    (<= parse-numeric range)
    (string= parse-string)
    (string< parse-string range)
    (string> parse-string range)
    (string>= parse-string range)
    (string<= parse-string range)
    (member parse-member)
    (fn parse-function)
    (between parse-range)
    (or parse-or)
    (and parse-and)
    (eq parse-equiv)))

(defun parse-constraint (expr bindings graph)
  (let ((op (first expr)))
    (multiple-value-bind (var constraint) 
	(funcall (symbol-function (second (assoc op *constraint-dictionary*)))
		 expr binding)
      (add-constraint graph var constraint bindings))))
	     

(defun parse-numeric (expr bindings)
  (destructuring-bind (rel (slot var) value) expr
    (assert (numberp value))
    (values var
	    (make-instance 'value-constraint 
			   :slot slot
			   :range-p nil
			   :class (binding-class var)
			   :value value
			   :expr `((inst) (,rel (slot-value inst ,slot) ,value))))))

;;
;; Bindings
;;

(defun make-constraint-bindings ()
  (make-hash-table :test #'equal))

(defun add-binding (name rec bindings)
  (setf (gethash name bindings) rec))

(defun get-binding (name bindings)
  (gethash name bindings))

(defun make-binding (type name)
  (list type name))

(defun binding-type (rec)
  (first rec))

(defun binding-target (rec)
  (second rec))


--- /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/scratch.lisp	2007/03/06 04:17:14	NONE
+++ /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/scratch.lisp	2007/03/06 04:17:14	1.1
;;
;; Constraint definitions
;;
;; A constraint is an expression that requires the value of an object slot
;; to be one or more values or a reference to an object satisfying a constraint.  
;; The object slot reference and the value slot reference can be complex.
;;

(defvar *constraint-definitions*
  (make-hash-table :size 40))

(defmacro define-constraint (name &body body)
  `(progn
     (push ,(generate-constraint-pattern body) 
	   (gethash ',name *constraint-dispatch*))))


[276 lines skipped]


From rread at common-lisp.net  Tue Mar  6 04:43:02 2007
From: rread at common-lisp.net (rread)
Date: Mon,  5 Mar 2007 23:43:02 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/db-clsql
Message-ID: <20070306044302.ACE2A710E4@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src/db-clsql
In directory clnet:/tmp/cvs-serv379

Modified Files:
	sql-controller.lisp 
Log Message:
changed query to execute-command


--- /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp	2007/02/18 22:09:01	1.21
+++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp	2007/03/06 04:43:02	1.22
@@ -370,7 +370,7 @@
 	(progn
 	  (clsql::create-sequence [serial] :database con)
 	  (sqlite3-harmless-read sc)
-	  (clsql::query
+	  (clsql::execute-command
 	   (format nil "create table keyvalue (
  pk integer PRIMARY KEY DEFAULT nextval('serial'),
  clctn_id integer NOT NULL,
@@ -378,7 +378,7 @@
  value varchar
  )")
 	 :database con)
-	)
+	  )
 	(clsql::create-table [keyvalue]
 			   ;; This is most likely to work with any database system..
 			   '(



From ieslick at common-lisp.net  Wed Mar  7 22:01:01 2007
From: ieslick at common-lisp.net (ieslick)
Date: Wed,  7 Mar 2007 17:01:01 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/memutil
Message-ID: <20070307220101.37975B2B6@common-lisp.net>

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

Modified Files:
	libmemutil.c 
Log Message:
Fixes for type and fname conflicts

--- /project/elephant/cvsroot/elephant/src/memutil/libmemutil.c	2007/02/01 04:03:27	1.3
+++ /project/elephant/cvsroot/elephant/src/memutil/libmemutil.c	2007/03/07 22:01:01	1.4
@@ -82,22 +82,22 @@
 --------------------------------------------------------------------------------
 */
 
-#define reader_and_writer( DATATYPE ) \
-DATATYPE read_##DATATYPE (char *buf, int offset) { \
+#define reader_and_writer( FNAME, DATATYPE )	\
+DATATYPE read_##FNAME (char *buf, int offset) { \
   DATATYPE i; \
   memcpy(&i, buf+offset, sizeof( DATATYPE )); \
   return i; \
 } \
-void write_##DATATYPE (char *buf, DATATYPE num, int offset) { \
+void write_##FNAME (char *buf, DATATYPE num, int offset) { \
   memcpy(buf+offset, &num, sizeof( DATATYPE )); \
 }
 
-reader_and_writer(int32_t)
-reader_and_writer(uint32_t)
-reader_and_writer(int64_t)
-reader_and_writer(uint64_t)
-reader_and_writer(float)
-reader_and_writer(double)
+reader_and_writer(int32,int32_t)
+reader_and_writer(uint32,uint32_t)
+reader_and_writer(int64,int64_t)
+reader_and_writer(uint64,uint64_t)
+reader_and_writer(float,float)
+reader_and_writer(double,double)
 
 char *offset_charp(char *p, int offset) {
   return p + offset;



From ieslick at common-lisp.net  Thu Mar  8 19:24:08 2007
From: ieslick at common-lisp.net (ieslick)
Date: Thu,  8 Mar 2007 14:24:08 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070308192408.624AA7615E@common-lisp.net>

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

Modified Files:
	classes.lisp 
Log Message:
Fix for class indexing test

--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/03 17:24:59	1.19
+++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/08 19:24:08	1.20
@@ -49,6 +49,7 @@
 
 (defmethod ensure-class-using-class :around ((class (eql nil)) name &rest args &key index)
   "Support the :index class option"
+  (format t "ecuc nil index = ~A~%" index)
   (let ((result (apply #'call-next-method class name (remove-keywords '(:index) args))))
     (when (and index (subtypep (type-of result) 'persistent-metaclass))
       (update-indexed-record result nil :class-indexed t))
@@ -56,6 +57,7 @@
 
 (defmethod ensure-class-using-class :around ((class persistent-metaclass) name &rest args &key index)
   "Support the :index class option on redefinition"
+  (format t "ecuc class index = ~A~%" index)
   (let ((result (apply #'call-next-method class name (remove-keywords '(:index) args))))
     (when index
       (update-indexed-record result nil :class-indexed t))



From ieslick at common-lisp.net  Thu Mar  8 19:24:45 2007
From: ieslick at common-lisp.net (ieslick)
Date: Thu,  8 Mar 2007 14:24:45 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20070308192445.5B0537615E@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv18112

Modified Files:
	testindexing.lisp 
Log Message:
Fix for clas indexing test

--- /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2007/03/03 17:25:01	1.32
+++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2007/03/08 19:24:45	1.33
@@ -110,9 +110,12 @@
       
       (defclass idx-cslot ()
 	((slot1 :initarg :slot1 :initform 0 :accessor slot1))
-	(:metaclass persistent-metaclass :index t))
+	(:metaclass persistent-metaclass) 
+	(:index t))
 
-      (values (class-indexedp-by-name 'idx-cslot)))
+      (make-instance 'idx-cslot)
+
+      (values (if (class-indexedp-by-name 'idx-cslot) t nil))
   t)
       
 



From ieslick at common-lisp.net  Thu Mar  8 19:50:20 2007
From: ieslick at common-lisp.net (ieslick)
Date: Thu,  8 Mar 2007 14:50:20 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20070308195020.52ACC3801C@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv24009

Modified Files:
	testindexing.lisp 
Log Message:
Fix for premature checkin

--- /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2007/03/08 19:24:45	1.33
+++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2007/03/08 19:50:20	1.34
@@ -115,9 +115,9 @@
 
       (make-instance 'idx-cslot)
 
-      (values (if (class-indexedp-by-name 'idx-cslot) t nil))
+      (values (if (class-indexedp-by-name 'idx-cslot) t nil)))
   t)
-      
+
 
 ;; test inherited slots
 (deftest indexing-inherit



From ieslick at common-lisp.net  Thu Mar  8 21:29:53 2007
From: ieslick at common-lisp.net (ieslick)
Date: Thu,  8 Mar 2007 16:29:53 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070308212953.5FE722B05E@common-lisp.net>

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

Modified Files:
	TODO 
Log Message:
A few details to go green on sbcl and acl on mac32

--- /project/elephant/cvsroot/elephant/TODO	2007/03/03 17:24:55	1.66
+++ /project/elephant/cvsroot/elephant/TODO	2007/03/08 21:29:53	1.67
@@ -20,7 +20,6 @@
 - Migration: Improve scaling properties of migration so all objects do not need to be resident in memory?
 - Migration: Validate that graph structures with loop are copied properly
 - Migration: Improve printing and informative messages
-- Fix class index slot option (and validate test)
 
 Lisp Support:
 - Validate Lispworks on PC
@@ -69,6 +68,7 @@
 x 
 
 Minor Bugs:
+x Fix class index slot option test
 x Enable with-transactions to properly process forms returning multiple values (Ian)
 x Fixed typos in SQL backend (Ian/Robert/Henrik)
 x Fixed build bug for linux (Henrik)



From ieslick at common-lisp.net  Thu Mar  8 21:29:53 2007
From: ieslick at common-lisp.net (ieslick)
Date: Thu,  8 Mar 2007 16:29:53 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070308212953.A1D803001D@common-lisp.net>

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

Modified Files:
	classes.lisp classindex.lisp metaclasses.lisp 
Log Message:
A few details to go green on sbcl and acl on mac32

--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/08 19:24:08	1.20
+++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/08 21:29:53	1.21
@@ -49,7 +49,6 @@
 
 (defmethod ensure-class-using-class :around ((class (eql nil)) name &rest args &key index)
   "Support the :index class option"
-  (format t "ecuc nil index = ~A~%" index)
   (let ((result (apply #'call-next-method class name (remove-keywords '(:index) args))))
     (when (and index (subtypep (type-of result) 'persistent-metaclass))
       (update-indexed-record result nil :class-indexed t))
@@ -57,7 +56,6 @@
 
 (defmethod ensure-class-using-class :around ((class persistent-metaclass) name &rest args &key index)
   "Support the :index class option on redefinition"
-  (format t "ecuc class index = ~A~%" index)
   (let ((result (apply #'call-next-method class name (remove-keywords '(:index) args))))
     (when index
       (update-indexed-record result nil :class-indexed t))
@@ -83,6 +81,7 @@
 	(setf (%persistent-slots instance) 
 	      (cons (persistent-slot-names instance) nil)))
     (update-indexed-record instance (indexed-slot-names-from-defs instance))))
+			   
 
 (defmethod reinitialize-instance :around ((instance persistent-metaclass) &rest initargs &key &allow-other-keys)
   (declare (ignore initargs))
--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/02/26 19:12:18	1.26
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/08 21:29:53	1.27
@@ -71,7 +71,8 @@
   (find-class-index (find-class class-name) :sc sc :errorp errorp))
 
 (defmethod class-indexedp-by-name ((class-name symbol) &key (sc *store-controller*))
-  (get-value class-name (controller-class-root sc)))
+  (let ((class (find-class class-name nil)))
+    (when class (indexed class))))
 
 (defmethod find-class-index ((class persistent-metaclass) &key (sc *store-controller*) (errorp t))
   (ensure-finalized class)
--- /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp	2007/02/26 19:12:18	1.9
+++ /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp	2007/03/08 21:29:53	1.10
@@ -132,7 +132,7 @@
 		    (indexed-record class)
 		    nil)))
     (setf (%indexed-slots class) 
-	  (cons (make-new-indexed-record new-slot-list oldrec class-indexed)
+	  (cons (make-new-indexed-record new-slot-list oldrec (or new-slot-list class-indexed))
 		(if oldrec oldrec nil)))))
 
 (defmethod make-new-indexed-record (new-slot-list oldrec class-indexed)



From ieslick at common-lisp.net  Thu Mar  8 21:29:53 2007
From: ieslick at common-lisp.net (ieslick)
Date: Thu,  8 Mar 2007 16:29:53 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/query
Message-ID: <20070308212953.D15873001D@common-lisp.net>

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

Modified Files:
	syntax.lisp 
Log Message:
A few details to go green on sbcl and acl on mac32

--- /project/elephant/cvsroot/elephant/src/query/syntax.lisp	2007/03/06 04:15:27	1.1
+++ /project/elephant/cvsroot/elephant/src/query/syntax.lisp	2007/03/08 21:29:53	1.2
@@ -72,13 +72,18 @@
 ;; Dictionary
 
 (defun make-relation-dictionary ()
-  (cons nil nil))
+  (cons nil 0))
 
 (defun add-set (name class stmt dictionary &optional annotations)
   (push (list name class stmt annotations) (car dictionary)))
 
+(defun add-anonymous-set (class dict)
+  (let ((name (format nil "?class~A" (incf (cdr dict)))))
+    (add-set name class nil dict)
+    name))
+
 (defun lookup-set (name dict)
-  (awhen (assoc name (car dict))
+  (awhen (assoc name (car dict) :test #'equal)
     it))
 
 (defun set-name (setrec)
@@ -94,6 +99,7 @@
   (fourth setrec))
 
 
+
 ;; Constraints
     
 (defun parse-constraints (exprs dictionary)
@@ -212,18 +218,68 @@
 		  ,(reference-slot-or-value rec2))
 	     ,(setname))))
 
-(defun make-join-statement (op rec1 rec2)
+(defun make-join-statement (op rec1 rec2 dictionary)
   (cond ((and (simple-record-p rec1) (simple-record-p rec2))
-	 ;; An explicit join (assuming op is '=')
 	 `(theta-join ,op 
 		      ,(reference-slot rec1) ,(reference-setname rec1)
 		      ,(reference-slot rec2) ,(reference-setname rec2)))
 	((and (nested-record-p rec1) (value-record-p rec2))
-	 `(theta-join ,op 
- 	 )
+	 (make-nested-join op rec1 rec2))
 	((and (value-record-p rec1) (nested-record-p rec1))
-	 )
+	 (make-nested-join op rec2 rec1 :reverse t))
+	(t (error "Cannot construct complex join statement with ~A and ~A" rec1 rec2))))
 
+(defun make-nested-join (op rec-nest rec-value dict &key reverse)
+  (let* ((slot (reference-slot rec-nest))
+	 (sc-list (assign-join-types nil (reference-form rec-nest)))
+	 (select `(select (,op ,@(when reverse 
+				       (list value slot)
+				       (list slot value))
+			       ,(second (first sc-list))))))
+    (nest-joins (rest sc-list) select)))
+
+(defun nest-joins (sc-list inner-stmt)
+  "Wraps a cascade of joins with anonymous classes"
+  (if (null sc-list)
+      inner-stmt
+      (let ((slot-class (first sc-list)))
+	(nest-joins (cdr sc-list)
+		    `(join ,(first slot-class) ,(second slot-class) oid ,inner-stmt)))))
+
+(defun assign-join-types (accessor nested-form dict)
+  (if (simple-reference-form-p nested-form dict)
+      (list nested-form)
+      (let* ((list (assign-join-types (first nested-form) (second nested-form) dict))
+	     (type-form (first list)))
+	(cons (list accessor
+		    (get-set-type (list (first type-form) (get-set-type (second type-form) dict)) dict))
+	      list))))
+
+(defun get-set-type (form dict)
+  (let ((setrec (lookup-set form dict)))
+    (if setrec (set-type setrec)
+	(ifret (infer-type (first form) (second form)) nil))))
+	       
+	       
+
+(defun infer-type (slot class)
+  "Determine the type "
+
+  ((nil namerec)
+   (name person)
+   (manager department)
+   (department emp))
+
+	 
+
+(= (name (manager (department emp))) "George")
+(department emp) = foo
+(manager foo) = foo1
+(name foo1) 
+
+(join department emp oid 
+      (project (oid) (join manager ?class1 oid 
+			   (project oid (select (= name "George") ?class2)))))
 
 (defun reference-slot-or-value (rec)
   (cond ((value-record-p rec)



From ieslick at common-lisp.net  Thu Mar  8 21:29:54 2007
From: ieslick at common-lisp.net (ieslick)
Date: Thu,  8 Mar 2007 16:29:54 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20070308212954.0DFE830021@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv17545/tests

Modified Files:
	testindexing.lisp 
Log Message:
A few details to go green on sbcl and acl on mac32

--- /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2007/03/08 19:50:20	1.34
+++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2007/03/08 21:29:53	1.35
@@ -105,8 +105,8 @@
 (deftest indexing-class-opt
     (progn
       (when (class-indexedp-by-name 'idx-cslot)
-	(disable-class-indexing 'idx-cslot :errorp nil)
-	(setf (find-class 'idx-cslot) nil))
+	(disable-class-indexing 'idx-cslot :errorp nil))
+      (setf (find-class 'idx-cslot) nil)
       
       (defclass idx-cslot ()
 	((slot1 :initarg :slot1 :initform 0 :accessor slot1))
@@ -227,9 +227,9 @@
 
 (deftest indexing-wipe-index
     (progn 
-      (when (class-indexedp-by-name 'idx-five-del )
-	(disable-class-indexing 'idx-five-del :errorp nil)
-	(setf (find-class 'idx-five-del) nil))
+      (when (class-indexedp-by-name 'idx-five-del)
+	(disable-class-indexing 'idx-five-del :errorp nil))
+      (setf (find-class 'idx-five-del) nil)
 
       (defclass idx-five-del ()
 	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))



From ieslick at common-lisp.net  Fri Mar  9 00:44:35 2007
From: ieslick at common-lisp.net (ieslick)
Date: Thu,  8 Mar 2007 19:44:35 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070309004435.49D493801F@common-lisp.net>

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

Modified Files:
	TODO 
Log Message:
Fixed migrate bug that created new dst objects for each src persistent object

--- /project/elephant/cvsroot/elephant/TODO	2007/03/08 21:29:53	1.67
+++ /project/elephant/cvsroot/elephant/TODO	2007/03/09 00:44:35	1.68
@@ -15,7 +15,6 @@
 - Validate SQL migration 0.6.0->0.6.1 (Robert)
 
 Stability and Performance:
-- Migration: Validate that migrate can use either O(c) or O(n/c) where c << n memory for large DBs
 - Migration: Improve support for nested persistent objects inside standard objects, arrays, etc?
 - Migration: Improve scaling properties of migration so all objects do not need to be resident in memory?
 - Migration: Validate that graph structures with loop are copied properly
@@ -27,7 +26,6 @@
 - Validate OpenMCL 1.1 and/or 64-bit on Mac OS X?
   - 64-bit lisp verification
 - Verify db_deadlock for other lisps (launch and kill background program I/F)
-  sbcl and allegro are OK
 
 Test coverage:
 - Clean up interface to tests
@@ -84,6 +82,8 @@
 x Tests to validate new map interfaces on top of existing tests (Ian)
 x Added support and tests for serializing structure objects on all supported platforms (Ian)
 x Fixed cygwin-ming32 -mno-cygwin build for Windows for Lispworks and Allegro (Frank, Ian)
+x Migration: Validate that migrate can use either O(c) or O(n*c) where c approaches 0 memory for large DBs
+             Uses O(n*c) where C is the cost to store a persistent object reference and old oid reference
 
 DEVELOPMENT CHECKINS:
 



From ieslick at common-lisp.net  Fri Mar  9 00:44:35 2007
From: ieslick at common-lisp.net (ieslick)
Date: Thu,  8 Mar 2007 19:44:35 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070309004435.7C0367E003@common-lisp.net>

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

Modified Files:
	migrate.lisp 
Log Message:
Fixed migrate bug that created new dst objects for each src persistent object

--- /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp	2007/02/26 19:12:18	1.9
+++ /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp	2007/03/09 00:44:35	1.10
@@ -48,10 +48,11 @@
 ;;   other way to do comparisons between objects across stores (different
 ;;   oid namespaces) so user beware of the pitfalls of partial migrations...
 ;;
-;; - Migrate keeps a memory-resident hash of all objects; this means
-;;   you cannot currently migrate a store that has more data than your 
-;;   main memory.  (This could be fixed by keeping the oid table in
-;;   the target store and deleting it on completion)
+;; - Migrate keeps a memory-resident hash of all persistent objects;
+;;   this is not as bad as it sounds as an object is only an oid reference 
+;;   and a pointer to the store controller it belongs to.  However, you 
+;;   may eventually run out of heap space for very large DB's.  We can use
+;;   the old DB to store the mappings if this becomes a problem.
 ;;
 ;; - Migration does not maintain OID equivalence so any datastructures which
 ;;   index into those will have to have a way to reconstruct themselves (better
@@ -73,6 +74,7 @@
 ;;
 
 
+
 (defgeneric migrate (dst src)
   (:documentation 
    "Migrate an object from the src object, collection or controller
@@ -96,7 +98,7 @@
 
 ;; ERROR CHECKING
 
-(defmethod migrate :around ((dst store-controller) (src t))
+(defmethod migrate :around ((dst store-controller) (src store-controller))
   "This method ensures that we wipe our duplication detection
    around any top level call to migrate"
   (if *migrating*



From ieslick at common-lisp.net  Sun Mar 11 03:31:09 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 10 Mar 2007 22:31:09 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070311033109.DEFA26A004@common-lisp.net>

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

Modified Files:
	TODO 
Log Message:
Added functionality and test for migrating persistent references inside lisp aggregates: array, list and hash tables

--- /project/elephant/cvsroot/elephant/TODO	2007/03/09 00:44:35	1.68
+++ /project/elephant/cvsroot/elephant/TODO	2007/03/11 03:31:09	1.69
@@ -14,12 +14,6 @@
 Migration:
 - Validate SQL migration 0.6.0->0.6.1 (Robert)
 
-Stability and Performance:
-- Migration: Improve support for nested persistent objects inside standard objects, arrays, etc?
-- Migration: Improve scaling properties of migration so all objects do not need to be resident in memory?
-- Migration: Validate that graph structures with loop are copied properly
-- Migration: Improve printing and informative messages
-
 Lisp Support:
 - Validate Lispworks on PC
 - Validate OpenMCL pre-1.1 on Mac OS X
@@ -27,6 +21,11 @@
   - 64-bit lisp verification
 - Verify db_deadlock for other lisps (launch and kill background program I/F)
 
+TASKS TO GET TO FINAL RELEASE:
+
+Bugs:
+- Fix any bugs found in BETA
+
 Test coverage:
 - Clean up interface to tests
 - Test for optimize storage method (just add probe-file methods to get file size?)
@@ -36,10 +35,6 @@
   - Ensure that variable length UTF-8 reps are automatically stored as UTF-16
 - Class / DB sychronization tests
 
-TASKS TO GET TO FINAL RELEASE:
-
-Fix any bugs found in BETA
-
 Documentation:
 - License and copyright file headers
 - Add document section about backend interface & developer decisions
@@ -63,7 +58,7 @@
 x Fix a bug where slot-makunbound on a persistent object failed to remove secondary index references
   for class and slot indices.  Made a test to validate this. (Ian)
 x Fixed a bug in string serialization for char-code > #x7F (Henrik, Ties)
-x 
+x Fixed migrate bug where oid->oid map was reset on every migrate call, yikes! (Ian)
 
 Minor Bugs:
 x Fix class index slot option test
@@ -77,6 +72,8 @@
 x Fixed a missing package export: translate-and-intern-symbol from elephant (Ties)
 
 Feature tweaking:
+x Migration: Improve support for nested persistent objects inside lists, arrays and hash tables (Ian)
+x Migration: Test embedded object support
 x Enabled 8-bit encoding of char-codes between #x7F and #xFF; enabled by earlier rewrite of memutil (Ian)
 x Orthogonal feature addition: map-index, map-class and map-instances to avoid consing (Ian)
 x Tests to validate new map interfaces on top of existing tests (Ian)



From ieslick at common-lisp.net  Sun Mar 11 03:31:10 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 10 Mar 2007 22:31:10 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070311033110.2305D731FA@common-lisp.net>

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

Modified Files:
	collections.lisp migrate.lisp 
Log Message:
Added functionality and test for migrating persistent references inside lisp aggregates: array, list and hash tables

--- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/06 04:15:27	1.12
+++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/11 03:31:09	1.13
@@ -423,40 +423,40 @@
   (dump-btree bt :print-fn print-fn :count count))
 
 (defmethod btree-differ-p ((x btree) (y btree))
-  (assert (eq (get-con x) (get-con y)))
+;;  (assert (eq (get-con x) (get-con y)))
   (ensure-transaction (:store-controller (get-con x))
-  (let ((cx1 (make-cursor x)) 
-	(cy1 (make-cursor y))
-	(done nil)
-	(rv nil)
-	(mx nil)
-	(kx nil)
-	(vx nil)
-	(my nil)
-	(ky nil)
-	(vy nil))
-    (cursor-first cx1)
-    (cursor-first cy1)
-    (do ((i 0 (1+ i)))
-	(done nil)
-	(multiple-value-bind (m k v) (cursor-current cx1)
-	  (setf mx m)
-	  (setf kx k)
-	  (setf vx v))
-	(multiple-value-bind (m k v) (cursor-current cy1)
-	  (setf my m)
-	  (setf ky k)
-	  (setf vy v))
-      (if (not (and (equal mx my)
-		    (equal kx ky)
-		    (equal vx vy)))
-	  (setf rv (list mx my kx ky vx vy)))
-      (setf done (and (not mx) (not mx))
-	    )
-      (cursor-next cx1)
-      (cursor-next cy1)
-      )
-    (cursor-close cx1)
-    (cursor-close cy1)
-    rv
-    )))
+    (ensure-transaction (:store-controller (get-con y))
+      (let ((cx1 (make-cursor x)) 
+	    (cy1 (make-cursor y))
+	    (done nil)
+	    (rv nil)
+	    (mx nil)
+	    (kx nil)
+	    (vx nil)
+	    (my nil)
+	    (ky nil)
+	    (vy nil))
+	(cursor-first cx1)
+	(cursor-first cy1)
+	(do ((i 0 (1+ i)))
+	    (done nil)
+	  (multiple-value-bind (m k v) (cursor-current cx1)
+	    (setf mx m)
+	    (setf kx k)
+	    (setf vx v))
+	  (multiple-value-bind (m k v) (cursor-current cy1)
+	    (setf my m)
+	    (setf ky k)
+	    (setf vy v))
+	  (if (not (and (equal mx my)
+			(equal kx ky)
+			(equal vx vy)))
+	      (setf rv (list mx my kx ky vx vy)))
+	  (setf done (and (not mx) (not mx)))
+	  (cursor-next cx1)
+	  (cursor-next cy1)
+	  )
+	(cursor-close cx1)
+	(cursor-close cy1)
+	rv
+	))))
--- /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp	2007/03/09 00:44:35	1.10
+++ /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp	2007/03/11 03:31:09	1.11
@@ -26,8 +26,6 @@
 
 ;; LIMITATIONS:
 ;; - Migrate currently will not handle circular list objects
-;; - Migrate does not support arrays or standard objects with nested persistent objects
-;; - There are potential problems with graphs and other deep structures
 ;;
 ;; - Indexed classes only have their class index copied if you use the
 ;;   top level migration.  Objects will be copied without slot data if you
@@ -41,19 +39,18 @@
 ;;   a validation test) the source store should be closed.  Any failures
 ;;   in migration should then be easy to catch.
 ;;
-;; - Each call to migration will be good about keeping track of already
-;;   copied objects to avoid duplication.  Duplication _shouldn't_ screw
-;;   up the semantics, just add storage overhead but is to be avoided.  
-;;   However this information is not saved between calls and there's no 
-;;   other way to do comparisons between objects across stores (different
-;;   oid namespaces) so user beware of the pitfalls of partial migrations...
-;;
 ;; - Migrate keeps a memory-resident hash of all persistent objects;
 ;;   this is not as bad as it sounds as an object is only an oid reference 
 ;;   and a pointer to the store controller it belongs to.  However, you 
 ;;   may eventually run out of heap space for very large DB's.  We can use
 ;;   the old DB to store the mappings if this becomes a problem.
 ;;
+;; - Each top-level call to migration will be good about keeping track
+;;   of already copied persistent objects.  However the hash is not
+;;   saved between calls and there's no other way to do comparisons
+;;   between objects across stores (different oid namespaces) so user
+;;   beware of the pitfalls of partial migrations...
+;;
 ;; - Migration does not maintain OID equivalence so any datastructures which
 ;;   index into those will have to have a way to reconstruct themselves (better
 ;;   to keep the object references themselves rather than oids in general)
@@ -69,7 +66,7 @@
 ;;   to get a destination repository object with all the slots copied over
 ;;   to the target repository which you can then overwrite.  To avoid the
 ;;   default persistent slot copying, bind the dynamic variable 
-;;   *inhibit-slot-writes* in your user method using 
+;;   *inhibit-slot-copy* in your user method using 
 ;;   (with-inhibited-slot-copy () ...), a convenience macro.
 ;;
 
@@ -121,7 +118,9 @@
 	(store-controller (assert (not (equal dst-spec (controller-spec src)))))
 	(persistent (assert (not (equal dst-spec (dbcn-spc-pst src)))))))))
 
+;;
 ;; WHOLE STORE MIGRATION
+;;
 
 (defmethod migrate ((dst store-controller) (src store-controller))
   "Perform a wholesale repository migration from the root. 
@@ -184,20 +183,43 @@
 		     (setf (get-value (oid newinst) new) newinst))))
 	       old)))
 
+;;
+;; Utilities for persistent objects
+;;
 
-;; PERSISTENT OBJECTS THAT AREN'T INDICES
+(defun reset-migrate-duplicate-detection ()
+  "Reset oid map so that all references to a given object
+   in the source only point to one copy in the target"
+  (setf *migrate-copied-oids* (make-hash-table)))
 
-(defvar *inhibit-slot-copy* nil)
+(defun object-was-copied-p (src)
+  "Test whether a source object has been copied"
+  (and (subtypep (type-of src) 'persistent)
+       (gethash (oid src) *migrate-copied-oids*)))
+
+(defun register-copied-object (src dst)
+  "When copying a source object, store it in the oid map"
+  (assert (not (equal (dbcn-spc-pst src) (dbcn-spc-pst dst))))
+  (setf (gethash (oid src) *migrate-copied-oids*) dst))
+
+(defun retrieve-copied-object (src)
+  "Get a copied object from the oid map"
+  (gethash (oid src) *migrate-copied-oids*))
 
 (defmacro with-inhibited-slot-copy ((&key &allow-other-keys) &body body)
+  "A user macro to support special slot handling in persistent objects"
   `(let ((*inhibit-slot-copy* t))
-     (declare (special *inhibit-slot-copy*)
-	      (dynamic-extent *inhibit-slot-copy*))
+     (declare (special *inhibit-slot-copy*))
      , at body))
 
+;;
+;; PERSISTENT OBJECTS
+;;
+
+(defvar *inhibit-slot-copy* nil)
+
 (defmethod migrate ((dst store-controller) (src persistent))
    "Migrate a persistent object and apply a binary (lambda (dst src) ...) 
-
     function to the new object.  Users can override migrate by creating
     a function that calls the default copy and then does stuff with the
     slot values.  A dynamic variable: *inhibit-slot-copy* can be bound
@@ -207,58 +229,38 @@
        (retrieve-copied-object src)
        (copy-persistent-object dst src)))
 
-;; (defmethod migrate ((dst store-controller) (class persistent-metaclass))
-;;   "Migrate classes with indices"
-;;   (let ((dstcidx (get-value (class-name class) (controller-class-root dst))))
-;;     (when (and (indexed class)       ;; indexed
-;; 	       (not dstcidx)         ;; hasn't been copied
-;; 	       (%index-cache class)) ;; we have a valid reference
-;;       (format t "Migrating class~A~%" (class-name class))
-;;       (let ((new-cidx (migrate dst (%index-cache class)
-;;        (setf (get-value (class-name class) (controller-class-root dst)) new-cidx)
-;;       (setf (%index-cache class) new-cidx)))
-;;   class)
-
-(defun reset-migrate-duplicate-detection ()
-  (setf *migrate-copied-oids* (make-hash-table)))
-
-(defun object-was-copied-p (src)
-  (and (subtypep (type-of src) 'persistent)
-       (gethash (oid src) *migrate-copied-oids*)))
-
-(defun register-copied-object (src dst)
-  (assert (not (equal (dbcn-spc-pst src) (dbcn-spc-pst dst))))
-  (setf (gethash (oid src) *migrate-copied-oids*) dst))
-
-(defun retrieve-copied-object (src)
-  (gethash (oid src) *migrate-copied-oids*))
-
 (defun copy-persistent-object (dstsc src)
   "Copy the persistent object reference by making a new one and
    potentially copy over the slot values as well"
   (let* ((class (class-of src))
 	 (dst (make-instance (class-of src) :sc dstsc)))
     (register-copied-object src dst)
-    (when (and (not *inhibit-slot-copy*)
-	       (not (inhibit-indexed-slot-copy? dstsc class)))
-      (copy-persistent-slots dstsc (class-of src) src dst))
+    (unless (inhibit-indexed-slot-copy? dstsc class)
+      (copy-persistent-slots dstsc dst (class-of src) src))
     dst))
 
 (defun inhibit-indexed-slot-copy? (sc class)
-  (and (indexed class)
-       (not (equal (controller-spec sc)
-		   (dbcn-spc-pst (%index-cache class))))))
+  "Make sure that we don't copy slots if the user inhibits
+   or if the class is indexed and has not yet migrated to
+   the new store - the indexing copy will do this."
+  (or *inhibit-slot-copy*
+      (and (indexed class)
+	   (not (equal (controller-spec sc)
+		       (dbcn-spc-pst (%index-cache class)))))))
 
-(defun copy-persistent-slots (dstsc class src dst)
+(defun copy-persistent-slots (dstsc dst class src)
   "Copy only persistent slots from src to dst"
   (ensure-transaction (:store-controller dstsc)
     (loop for slot-def in (persistent-slot-defs class) do
 	 (when (slot-boundp-using-class class src slot-def)
+;;	   (format t "Slotname: ~A  value: ~A~%" (elephant::slot-definition-name slot-def) 
+;;		   (slot-value-using-class class src slot-def))
 	   (let ((value (migrate dstsc (slot-value-using-class class src slot-def))))
 	     (setf (slot-value-using-class class dst slot-def) value))))))
 
-
-;; MIGRATE INDICES (Override normal persistent copies)
+;;
+;; MIGRATE BTREE INDICES (override default persistent behavior)
+;;
 
 (defmethod migrate ((dst store-controller) (src btree))
   "Copy an index and it's contents to the target repository"
@@ -295,40 +297,46 @@
 		   (setf (get-value newkey dst) newval)))
 	     src))
 
+;;
+;; These functions handle standard objects that may contain nested indices or 
+;; user-defined persistent objects.  
+;;
 
-;; SUPPORT LISP COLLECTIONS TO HANDLE NESTED PERSISTENT OBJECTS
-;; CLEANLY
-
-;; If we don't do this, then a nested persistent object may be
-;; of the source store's class and fail to copy slots on a write
-;; and we'll silently lose data...
+(defmethod migrate ((dst store-controller) (src standard-object))
+  "If we have persistent objects that are unindexed and ONLY stored in
+   a standard object slot that is referenced from the root, then it
+   will only be copied by recursing through the slot substructure just
+   as the serializer will, but copying any persistent objects found"
+  (let ((svs (slots-and-values src)))
+    (loop for i from 0 below (/ (length svs) 2) do
+	 (let ((name (pop svs))
+	       (value (pop svs)))
+	   (setf (slot-value src name) (migrate dst value))))))
 
-(defmethod migrate ((dst store-controller) (src hash-table))
-  "Copy the hash elements one at a time"
-  (let ((newhash (make-hash-table 
-		  :test (hash-table-test src)
-		  :size (hash-table-size src)
-		  :rehash-size (hash-table-rehash-size src)
-		  :rehash-threshold (hash-table-rehash-threshold src))))
-    (maphash (lambda (key value)
-	       (setf (gethash key newhash) 
-		     (migrate dst value)))
-	     src)))
 
 (defmethod migrate ((dst store-controller) (src cons))
-  "WARNING: This assumes a standard list or tree-of-lists, but doesn't
-   work for circular lists!"
+  "WARNING: This doesn't work for circular lists"
   (cons (migrate dst (car src))
 	(migrate dst (cdr src))))
 
-(defmethod migrate ((dst store-controller) (src string))
-  "Strings are fine to copy as is"
+(defmethod migrate ((dst store-controller) (src array))
+  "We only need to handle arrays of type 't' that point to other objects; 
+   fixnum, float, etc arrays don't need to be copied"
+  (loop for i fixnum from 0 below (array-total-size src) do
+       (let ((value (row-major-aref src i)))
+	 (setf (row-major-aref src i)
+	       (migrate dst value))))
   src)
 
-(defmethod migrate ((dst store-controller) (src array))
-  "NOTE: We need to handle arrays that might contain persistent objects!"
-  (warn "Arrays containing persistent objects will fail migration!")
+(defmethod migrate ((dst store-controller) (src hash-table))
+  "Migrate each hash element as the types are non-uniform"
+  (maphash (lambda (key value)
+	     (setf (gethash key src)
+		   (migrate dst value)))
+	   src)
   src)
 
+  
+
 
 



From ieslick at common-lisp.net  Sun Mar 11 03:31:10 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 10 Mar 2007 22:31:10 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20070311033110.5861A742C1@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv26571/tests

Modified Files:
	elephant-tests.lisp testmigration.lisp 
Log Message:
Added functionality and test for migrating persistent references inside lisp aggregates: array, list and hash tables

--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2007/02/26 19:12:19	1.26
+++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2007/03/11 03:31:10	1.27
@@ -145,6 +145,7 @@
     (print (do-test 'migrate-btree))
     (print (do-test 'migrate-idx-btree))
     (print (do-test 'migrate-pclass))
+    (print (do-test 'migrate-mult-pclass))
     (print (do-test 'migrate-ipclass))))
     
 (defun do-migration-test-spec (test spec1 spec2)
--- /project/elephant/cvsroot/elephant/tests/testmigration.lisp	2007/02/03 04:09:14	1.14
+++ /project/elephant/cvsroot/elephant/tests/testmigration.lisp	2007/03/11 03:31:10	1.15
@@ -65,7 +65,7 @@
 		      do
 		      (setf (get-value i ibt) (* i i))))
 		 (let ((mig (migrate sc2 ibt)))
-		   (btree-differ ibt mig)))
+		   (btree-differ-p ibt mig)))
 	    (close-store sc1)
 	    (close-store sc2))))
   nil)
@@ -103,7 +103,7 @@
 		       (progn
 			 (format t "YIKES ~A ~%" i)
 			 )))
-		(not (btree-differ ibt mig)))))
+		(not (btree-differ-p ibt mig)))))
 	  (progn
 	    (setq *store-controller* old-store)
 	    (close-store sc1)
@@ -144,6 +144,45 @@
 	    (close-store sc2))))
   t)
 
+(deftest migrate-mult-pclass 
+    (progn
+      (let* ((*store-controller* nil)
+	     (sc1 (open-store *test-spec-primary* :recover t :deadlock-detect t))
+	     (sc2 (open-store *test-spec-secondary* :recover t :deadlock-detect t)))
+	(unwind-protect
+	     (progn (elephant::reset-migrate-duplicate-detection)
+		    (let* ((simplesrc (make-instance 'pfoo :slot1 0 :sc sc1))
+			   (i1 (make-instance 'pfoo :slot1 1 :sc sc1))
+			   (i2 (make-instance 'pfoo :slot1 2 :sc sc1))
+			   (i3 (make-instance 'pfoo :slot1 3 :sc sc1))
+			   (list (list i1 i1))
+			   (array (make-array '(2 2) :initial-contents `((,i2 1)
+									 (,i2 2))))
+			   (hash (make-hash-table)))
+	    (setf (gethash 1 hash) i3)
+	    (setf (gethash 2 hash) i3)
+	    (let* ((newsimple (migrate sc2 simplesrc))
+		   (newlist (migrate sc2 list))
+		   (newarray (migrate sc2 array))
+		   (newhash (migrate sc2 hash)))
+		(values (and (and (slot-boundp newsimple 'slot1)
+				  (eq (slot1 newsimple) 0)))
+			(and (not (eq i1 (first newlist)))
+			     (eq (first newlist) (second newlist))
+			     (and (slot-boundp (first newlist) 'slot1)
+				  (eq (slot1 (first newlist)) 1)))
+			(and (not (eq i2 (aref newarray 0 0)))
+			     (eq (aref newarray 0 0) (aref newarray 1 0))
+			     (and (slot-boundp (aref newarray 0 0) 'slot1)
+				  (eq (slot1 (aref newarray 0 0)) 2)))
+			(and (not (eq i3 (gethash 1 newhash)))
+			     (eq (gethash 1 newhash) (gethash 2 newhash))
+			     (and (slot-boundp (gethash 1 newhash) 'slot1)
+				  (eq (slot1 (gethash 1 newhash)) 3)))))))
+	  (close-store sc1)
+	  (close-store sc2))))
+  t t t t t t t t t t)
+
 (defpclass ipfoo ()
   ((slot1 :accessor slot1 :initarg :slot1 :index t)))
 
@@ -167,7 +206,7 @@
 		     (remove-kv 'ipfoo (elephant::controller-class-root sc2)))
 		   (setf (elephant::%index-cache (find-class 'ipfoo)) nil)
 		   (find-class-index 'ipfoo :sc sc1)
-		   (format t "Making objects~%")
+;;		   (format t "Making objects~%")
 ;;		   (with-transaction (:store-controller sc2)
 ;;		     (drop-instances (get-instances-by-class 'ipfoo) :sc sc2))
 		   (with-transaction (:store-controller sc1 :retries 2)
@@ -175,12 +214,12 @@
 		     (make-instance 'ipfoo :slot1 1 :sc sc1)
 		     (make-instance 'ipfoo :slot1 10 :sc sc1)
 		     (make-instance 'ipfoo :slot1 20 :sc sc1))
-		   (format t "Migrating~%")
+;;		   (format t "Migrating~%")
 		   (migrate sc2 sc1)
 		   ;; Make sure our ipfoo class now points at a cache in sc2!
 		   (assert (equal (elephant::controller-spec sc2)
-				  (:dbcn-spc-pst (elephant::%index-cache (find-class 'ipfoo)))))
-		   (format t "Fetching~%")
+				  (elephant::dbcn-spc-pst (elephant::%index-cache (find-class 'ipfoo)))))
+;;		   (format t "Fetching~%")
 		   (let ((fm1 (get-instances-by-value 'ipfoo 'slot1 1))
 			 (fm2 (get-instances-by-value 'ipfoo 'slot1 10))
 			 (fm3 (get-instances-by-value 'ipfoo 'slot1 20))



From ieslick at common-lisp.net  Sun Mar 11 04:08:00 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 10 Mar 2007 23:08:00 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests/testdb-oid
Message-ID: <20070311040800.2AA247430A@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests/testdb-oid
In directory clnet:/tmp/cvs-serv2234/testdb-oid

Log Message:
Directory /project/elephant/cvsroot/elephant/tests/testdb-oid added to the repository





From ieslick at common-lisp.net  Sun Mar 11 05:45:17 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 11 Mar 2007 00:45:17 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070311054517.0F18026002@common-lisp.net>

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

Modified Files:
	migrate.lisp package.lisp 
Log Message:
Added support for maintaining oid-to-oid map in an external database; cleaned up tests and do-migration-tests to allow validation

--- /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp	2007/03/11 03:31:09	1.11
+++ /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp	2007/03/11 05:45:14	1.12
@@ -71,7 +71,6 @@
 ;;
 
 
-
 (defgeneric migrate (dst src)
   (:documentation 
    "Migrate an object from the src object, collection or controller
@@ -79,47 +78,9 @@
     store so you can drop it into a parent object or the root of
     the dst controller"))
 
-;; DEFAULT HANDLERS
-
-(defmethod migrate ((dst t) (src t))
-  (error "Cannot migrate ~A of type ~A to destination of type ~A" src (type-of src) (type-of dst)))
-
-(defmethod migrate ((dst store-controller) (src t))
-  "Default: standard objects are automatically migrated"
-  src)
-
-;; Avoiding Duplication Semantics
-
-(defvar *migrate-copied-oids* (make-hash-table))
-(defvar *migrating* nil)
-
-;; ERROR CHECKING
-
-(defmethod migrate :around ((dst store-controller) (src store-controller))
-  "This method ensures that we wipe our duplication detection
-   around any top level call to migrate"
-  (if *migrating*
-      (call-next-method)
-      (let ((*migrating* t))
-	(declare (special *migrating*))
-	(reset-migrate-duplicate-detection)
-	(let ((result (call-next-method)))
-	  (reset-migrate-duplicate-detection)
-	  result))))
-
-(defmethod migrate :before ((dst store-controller) (src persistent))
-  "This provides some sanity checking that we aren't trying to copy
-   to the same controller.  We also need to be careful about deadlocking
-   our transactions among the two gets/puts.  Each leaf migration should
-   be in its own transaction to avoid too many write locks. "
-  (let ((dst-spec (controller-spec dst)))
-    (unless (object-was-copied-p src)
-      (typecase src
-	(store-controller (assert (not (equal dst-spec (controller-spec src)))))
-	(persistent (assert (not (equal dst-spec (dbcn-spc-pst src)))))))))
-
 ;;
-;; WHOLE STORE MIGRATION
+;; MIGRATE ALL OBJECTS IN SRC STORE-CONTROLLER TO THE 
+;; (TYPICALLY FRESH) DST STORE-CONTROLLER
 ;;
 
 (defmethod migrate ((dst store-controller) (src store-controller))
@@ -184,33 +145,44 @@
 	       old)))
 
 ;;
-;; Utilities for persistent objects
+;; HANDLE DEFAULTS
 ;;
 
-(defun reset-migrate-duplicate-detection ()
-  "Reset oid map so that all references to a given object
-   in the source only point to one copy in the target"
-  (setf *migrate-copied-oids* (make-hash-table)))
+(defmethod migrate ((dst t) (src t))
+  (error "Cannot migrate ~A of type ~A to destination of type ~A" src (type-of src) (type-of dst)))
 
-(defun object-was-copied-p (src)
-  "Test whether a source object has been copied"
-  (and (subtypep (type-of src) 'persistent)
-       (gethash (oid src) *migrate-copied-oids*)))
+(defmethod migrate ((dst store-controller) (src t))
+  "Default: standard objects are automatically migrated"
+  src)
 
-(defun register-copied-object (src dst)
-  "When copying a source object, store it in the oid map"
-  (assert (not (equal (dbcn-spc-pst src) (dbcn-spc-pst dst))))
-  (setf (gethash (oid src) *migrate-copied-oids*) dst))
+;;
+;; ERROR CHECKING
+;;
 
-(defun retrieve-copied-object (src)
-  "Get a copied object from the oid map"
-  (gethash (oid src) *migrate-copied-oids*))
+(defmethod migrate :before ((dst store-controller) (src persistent))
+  "This provides some sanity checking that we aren't trying to copy
+   to the same controller.  We also need to be careful about deadlocking
+   our transactions among the two gets/puts.  Each leaf migration should
+   be in its own transaction to avoid too many write locks. "
+  (let ((dst-spec (controller-spec dst)))
+    (unless (object-was-copied-p src)
+      (typecase src
+	(store-controller (assert (not (equal dst-spec (controller-spec src)))))
+	(persistent (assert (not (equal dst-spec (dbcn-spc-pst src)))))))))
 
-(defmacro with-inhibited-slot-copy ((&key &allow-other-keys) &body body)
-  "A user macro to support special slot handling in persistent objects"
-  `(let ((*inhibit-slot-copy* t))
-     (declare (special *inhibit-slot-copy*))
-     , at body))
+(defmethod migrate :before ((dst store-controller) (src store-controller))
+  "This method ensures that we reset duplicate object detection over the store-controller"
+  (initialize-migrate-duplicate-detection))
+
+(defmethod migrate :after ((dst store-controller) (src store-controller))
+  "This method ensures that we reset duplicate object detection over the store-controller"
+  (clear-migrate-duplicate-detection))
+
+(defmethod migrate ((dst store-controller) (src standard-class))
+  (error "Cannot migrate class objects (i.e. ~A)" src))
+
+(defmethod migrate ((dst store-controller) (src function))
+  (error "Cannot migrate function objects (i.e. ~A)" src))
 
 ;;
 ;; PERSISTENT OBJECTS
@@ -226,7 +198,7 @@
     in the caller to keep the new object from having it's slots copied"
    ;; Copy or lookup persistent object
    (if (object-was-copied-p src)
-       (retrieve-copied-object src)
+       (retrieve-copied-object dst src)
        (copy-persistent-object dst src)))
 
 (defun copy-persistent-object (dstsc src)
@@ -259,13 +231,23 @@
 	     (setf (slot-value-using-class class dst slot-def) value))))))
 
 ;;
+;; User utilities for persistent objects
+;;
+
+(defmacro with-inhibited-slot-copy ((&key &allow-other-keys) &body body)
+  "A user macro to support special slot handling in persistent objects"
+  `(let ((*inhibit-slot-copy* t))
+     (declare (special *inhibit-slot-copy*))
+     , at body))
+
+;;
 ;; MIGRATE BTREE INDICES (override default persistent behavior)
 ;;
 
 (defmethod migrate ((dst store-controller) (src btree))
   "Copy an index and it's contents to the target repository"
   (if (object-was-copied-p src)
-      (retrieve-copied-object src)
+      (retrieve-copied-object dst src)
       (let ((newbtree  (build-btree dst)))
 	(ensure-transaction (:store-controller dst :txn-nosync t)
 	  (copy-btree-contents dst newbtree src))
@@ -275,7 +257,7 @@
 (defmethod migrate ((dst store-controller) (src indexed-btree))
   "Also copy the inverse indices for indexed btrees"
   (if (object-was-copied-p src)
-      (retrieve-copied-object src)
+      (retrieve-copied-object dst src)
       (let ((newbtree 
 	     (ensure-transaction (:store-controller dst :txn-nosync t)
 	       (build-indexed-btree dst))))
@@ -298,8 +280,7 @@
 	     src))
 
 ;;
-;; These functions handle standard objects that may contain nested indices or 
-;; user-defined persistent objects.  
+;; MIGRATE AGGREGATE LISP OBJECTS THAT MAY REFER TO OTHER PERSISTENT OBJECTS
 ;;
 
 (defmethod migrate ((dst store-controller) (src standard-object))
@@ -309,10 +290,22 @@
    as the serializer will, but copying any persistent objects found"
   (let ((svs (slots-and-values src)))
     (loop for i from 0 below (/ (length svs) 2) do
-	 (let ((name (pop svs))
+	 (let ((slotname (pop svs))
 	       (value (pop svs)))
-	   (setf (slot-value src name) (migrate dst value))))))
+	   (setf (slot-value src slotname) (migrate dst value)))))
+  src)
+
 
+(defmethod migrate ((dst store-controller) (src structure-object))
+  "Walks structure slot values and ensures that any persistent references
+   are written back into the slot pointint to the new store"
+  (let ((svs (struct-slots-and-values src)))
+    (loop for i from 0 below (/ (length svs) 2) do
+	 (let ((slotname (pop svs))
+	       (value (pop svs)))
+	   (setf (slot-value src slotname)
+		 (migrate dst value)))))
+  src)
 
 (defmethod migrate ((dst store-controller) (src cons))
   "WARNING: This doesn't work for circular lists"
@@ -336,7 +329,72 @@
 	   src)
   src)
 
+;;
+;; MAINTAIN CORRESPONDENCE BETWEEN OLD STORE POBJS and NEW STORE POBJS
+;;  
+
+(defvar *oid-hash* (make-hash-table))
+(defvar *oid-store* nil) 
+(defvar *oid-spec* nil)
+(defvar *oid-btree* nil)
+
+(defun set-oid-spec (spec)
+  "Set to nil to perform oid mapping in memory, set to a valid spec to
+   perform the mapping on disk"
+  (setf *oid-spec* spec))
+
+(defun initialize-migrate-duplicate-detection ()
+  "Reset oid map so that all references to a given object
+   in the source only point to one copy in the target"
+  (if *oid-spec*
+      (progn
+	(setf *oid-store* (open-store *oid-spec* :recover t))
+	(setf *oid-btree* (make-btree *oid-store*))
+	(setf *oid-hash* nil))
+      (progn
+	(setf *oid-hash* (make-hash-table))
+	(setf *oid-btree* nil))))
+
+(defun clear-migrate-duplicate-detection ()
+  (when *oid-spec*
+    (setf *oid-btree* nil)
+    (close-store *oid-store*)
+    (setf *oid-store* nil))
+  (when *oid-hash* 
+    (setf *oid-hash* nil)))
+
+(defun object-was-copied-p (src)
+  "Test whether a source object has been copied"
+  (assert (subtypep (type-of src) 'persistent))
+  (cond (*oid-btree*
+	 (existsp (oid src) *oid-btree*))
+	(*oid-hash*
+	 (gethash (oid src) *oid-hash*))
+	(t (warn "Test for persistent copy not inside top level call; returning nil")
+	   nil)))
+
+
+(defun register-copied-object (src dst)
+  "When copying a source object, store it in the oid map"
+  (assert (not (equal (dbcn-spc-pst src) (dbcn-spc-pst dst))))
+  (when (or *oid-btree* *oid-hash*)
+    (if *oid-btree*
+	(setf (get-value (oid src) *oid-btree*)
+	      (cons (oid dst) (type-of dst)))
+	(setf (gethash (oid src) *oid-hash*) dst))))
   
+(defun retrieve-copied-object (dst src)
+  "Get a copied object from the oid map"
+  (assert (subtypep (type-of dst) 'store-controller))
+  (cond (*oid-btree*
+	 (let ((record (get-value (oid src) *oid-btree*)))
+	   (get-cached-instance dst (car record) (cdr record))))
+	(*oid-hash*
+	 (gethash (oid src) *oid-hash*))
+	(t (error "Cannot retrieve an object from oid-to-oid map 
+                   when not inside top-level call"))))
+	 
+
 
 
 
--- /project/elephant/cvsroot/elephant/src/elephant/package.lisp	2007/03/06 04:15:27	1.22
+++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp	2007/03/11 05:45:14	1.23
@@ -64,7 +64,7 @@
 
 	   #:struct-constructor
 
- 	   #:migrate #:*inhibit-slot-copy* 
+ 	   #:migrate #:set-oid-spec #:*inhibit-slot-copy* 
 	   #:add-symbol-conversion #:add-package-conversion
 	   #:*always-convert*
 



From ieslick at common-lisp.net  Sun Mar 11 05:45:18 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 11 Mar 2007 00:45:18 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20070311054518.A2EB730021@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv24007/tests

Modified Files:
	delscript.sh elephant-tests.lisp testmigration.lisp 
Log Message:
Added support for maintaining oid-to-oid map in an external database; cleaned up tests and do-migration-tests to allow validation

--- /project/elephant/cvsroot/elephant/tests/delscript.sh	2007/02/05 17:22:58	1.4
+++ /project/elephant/cvsroot/elephant/tests/delscript.sh	2007/03/11 05:45:17	1.5
@@ -1,14 +1,14 @@
 rm testdb/__*
 rm testdb/%*
 rm testdb/log*
-rm testdb/VERSION
 rm testdb2/__*
 rm testdb2/%*
 rm testdb2/log*
-rm testdb2/VERSION
+rm testdb-oid/__*
+rm testdb-oid/%*
+rm testdb-oid/log*
 rm testbdb/testsbdb
 rm testbdb/__*
 rm testbdb/log*
-rm testbdb/VERSION
 rm sqlite3-test.db
 rm sqlite3-test2.db
\ No newline at end of file
--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2007/03/11 03:31:10	1.27
+++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2007/03/11 05:45:17	1.28
@@ -76,6 +76,13 @@
        (asdf:component-pathname (asdf:find-system 'elephant-tests)))))
   "A second bdb test directory for bdb-to-bdb tests")
   
+(defvar *testbdb-spec-oid*
+  `(:bdb
+    ,(namestring
+      (merge-pathnames
+       #p"tests/testdb-oid/"
+       (asdf:component-pathname (asdf:find-system 'elephant-tests))))))
+
 (defvar *testpg-spec*
   '(:clsql (:postgresql "localhost.localdomain" "test" "postgres" "")))
 
@@ -135,18 +142,23 @@
       (let ((*auto-commit* nil))
 	(do-test testname)))))
 
-(defun do-migration-tests (spec1 spec2)
+(defun do-migration-tests (spec1 spec2 &optional oid-spec)
   "Interface to do explicit migration tests between backends"
   (let ((*test-spec-primary* spec1)
 	(*test-spec-secondary* spec2))
     (declare (special *test-spec-primary* *test-spec-secondary*))
+    (if oid-spec
+	(set-oid-spec oid-spec)
+	(set-oid-spec nil))
     (print (do-test 'remove-element))
     (print (do-test 'migrate-basic))
     (print (do-test 'migrate-btree))
     (print (do-test 'migrate-idx-btree))
     (print (do-test 'migrate-pclass))
     (print (do-test 'migrate-mult-pclass))
-    (print (do-test 'migrate-ipclass))))
+    (print (do-test 'migrate-ipclass))
+    (when oid-spec
+      (set-oid-spec nil))))
     
 (defun do-migration-test-spec (test spec1 spec2)
   (let ((*test-spec-primary* spec1)
--- /project/elephant/cvsroot/elephant/tests/testmigration.lisp	2007/03/11 03:31:10	1.15
+++ /project/elephant/cvsroot/elephant/tests/testmigration.lisp	2007/03/11 05:45:17	1.16
@@ -39,10 +39,12 @@
 	   (sc2 (open-store *test-spec-secondary* :recover t)))
       (unwind-protect 
 	   (progn
+	     (elephant::initialize-migrate-duplicate-detection)
 	     (add-to-root "x" "y" :store-controller sc1)
 	     (migrate sc2 sc1)
 	     (equal (get-from-root "x" :store-controller sc1)
 		    (get-from-root "x" :store-controller sc2)))
+	(elephant::clear-migrate-duplicate-detection)
 	(close-store sc1)
 	(close-store sc2))))
   t)
@@ -59,13 +61,16 @@
 	      (sc2 (open-store *test-spec-secondary* :recover t)))
 	  (declare (special *store-controller*))
 	  (unwind-protect 
-	       (let ((ibt (make-btree sc1)))
-		 (with-transaction (:store-controller sc1)
-		   (loop for i from 0 to 10
-		      do
-		      (setf (get-value i ibt) (* i i))))
-		 (let ((mig (migrate sc2 ibt)))
-		   (btree-differ-p ibt mig)))
+	       (progn
+		 (elephant::initialize-migrate-duplicate-detection)
+		 (let ((ibt (make-btree sc1)))
+		   (with-transaction (:store-controller sc1)
+		     (loop for i from 0 to 10
+			do
+			  (setf (get-value i ibt) (* i i))))
+		   (let ((mig (migrate sc2 ibt)))
+		     (btree-differ-p ibt mig))))
+	    (elephant::clear-migrate-duplicate-detection)
 	    (close-store sc1)
 	    (close-store sc2))))
   nil)
@@ -84,6 +89,7 @@
 	      (sc2 (open-store *test-spec-secondary* :recover t)))
 	  (unwind-protect 
 	  (let* ((ibt (make-indexed-btree sc1)))
+	    (elephant::initialize-migrate-duplicate-detection)
 	    (let ((index
 		   (add-index ibt :index-name 'crunch :key-form 'crunch
 			      :populate t)))
@@ -105,6 +111,7 @@
 			 )))
 		(not (btree-differ-p ibt mig)))))
 	  (progn
+	    (elephant::clear-migrate-duplicate-detection)
 	    (setq *store-controller* old-store)
 	    (close-store sc1)
 	    (close-store sc2)))))
@@ -123,6 +130,7 @@
 	  (declare (special *store-controller*))
 	  (unwind-protect
 	       (progn
+		 (elephant::initialize-migrate-duplicate-detection)
 		 ;; Make instances
 		 (let* ((f1 (with-transaction (:store-controller sc1)
 			      (make-instance 'pfoo  :sc sc1)))
@@ -140,48 +148,72 @@
 		      (equal (slot1 fm2) (slot1 f2))
 		      (equal (slot2 bm1) (slot2 b1)))
 		     )))
+	    (elephant::clear-migrate-duplicate-detection)
 	    (close-store sc1)
 	    (close-store sc2))))
   t)
 
+(defclass simple-class ()
+  ((slot1 :accessor slot1 :initarg :slot1)
+   (slot2 :accessor slot2 :initarg :slot2)))
+
+(defstruct simple-struct s1 s2)
+
 (deftest migrate-mult-pclass 
     (progn
-      (let* ((*store-controller* nil)
-	     (sc1 (open-store *test-spec-primary* :recover t :deadlock-detect t))
-	     (sc2 (open-store *test-spec-secondary* :recover t :deadlock-detect t)))
+      (let* ((sc1 (open-store *test-spec-primary* :recover t :deadlock-detect t))
+	     (sc2 (open-store *test-spec-secondary* :recover t :deadlock-detect t))
+	     (*store-controller* nil))
+	(declare (special *store-controller*))
 	(unwind-protect
-	     (progn (elephant::reset-migrate-duplicate-detection)
+	     (progn (elephant::initialize-migrate-duplicate-detection)
 		    (let* ((simplesrc (make-instance 'pfoo :slot1 0 :sc sc1))
 			   (i1 (make-instance 'pfoo :slot1 1 :sc sc1))
 			   (i2 (make-instance 'pfoo :slot1 2 :sc sc1))
 			   (i3 (make-instance 'pfoo :slot1 3 :sc sc1))
+			   (i4 (make-instance 'pfoo :slot1 4 :sc sc1))
+			   (i5 (make-instance 'pfoo :slot1 5 :sc sc1))
 			   (list (list i1 i1))
 			   (array (make-array '(2 2) :initial-contents `((,i2 1)
 									 (,i2 2))))
-			   (hash (make-hash-table)))
-	    (setf (gethash 1 hash) i3)
-	    (setf (gethash 2 hash) i3)
-	    (let* ((newsimple (migrate sc2 simplesrc))
-		   (newlist (migrate sc2 list))
-		   (newarray (migrate sc2 array))
-		   (newhash (migrate sc2 hash)))
-		(values (and (and (slot-boundp newsimple 'slot1)
-				  (eq (slot1 newsimple) 0)))
-			(and (not (eq i1 (first newlist)))
-			     (eq (first newlist) (second newlist))
-			     (and (slot-boundp (first newlist) 'slot1)
-				  (eq (slot1 (first newlist)) 1)))
-			(and (not (eq i2 (aref newarray 0 0)))
-			     (eq (aref newarray 0 0) (aref newarray 1 0))
-			     (and (slot-boundp (aref newarray 0 0) 'slot1)
-				  (eq (slot1 (aref newarray 0 0)) 2)))
-			(and (not (eq i3 (gethash 1 newhash)))
-			     (eq (gethash 1 newhash) (gethash 2 newhash))
-			     (and (slot-boundp (gethash 1 newhash) 'slot1)
-				  (eq (slot1 (gethash 1 newhash)) 3)))))))
+			   (hash (make-hash-table))
+			   (object (make-instance 'simple-class :slot1 i4 :slot2 i4))
+			   (struct (make-simple-struct :s1 i5 :s2 i5)))
+		      (setf (gethash 1 hash) i3)
+		      (setf (gethash 2 hash) i3)
+		      (let* ((newsimple (migrate sc2 simplesrc))
+			     (newlist (migrate sc2 list))
+			     (newarray (migrate sc2 array))
+			     (newhash (migrate sc2 hash))
+			     (newobject (migrate sc2 object))
+			     (newstruct (migrate sc2 struct)))
+			(values (and (and (slot-boundp newsimple 'slot1)
+					  (eq (slot1 newsimple) 0)))
+				(and (not (eq i1 (first newlist)))
+				     (eq (first newlist) (second newlist))
+				     (and (slot-boundp (first newlist) 'slot1)
+					  (eq (slot1 (first newlist)) 1)))
+				(and (not (eq i2 (aref newarray 0 0)))
+				     (eq (aref newarray 0 0) (aref newarray 1 0))
+				     (and (slot-boundp (aref newarray 0 0) 'slot1)
+					  (eq (slot1 (aref newarray 0 0)) 2)))
+				(and (not (eq i3 (gethash 1 newhash)))
+				     (eq (gethash 1 newhash) (gethash 2 newhash))
+				     (and (slot-boundp (gethash 1 newhash) 'slot1)
+					  (eq (slot1 (gethash 1 newhash)) 3)))
+				(and (not (eq i4 (slot1 newobject)))
+				     (eq (slot1 newobject) (slot2 newobject))
+				     (and (slot-boundp (slot1 newobject) 'slot1)
+					  (eq (slot1 (slot1 newobject)) 4)))
+				(and (not (eq i5 (simple-struct-s1 newstruct)))
+				     (eq (simple-struct-s1 newstruct) 
+					 (simple-struct-s2 newstruct))
+				     (and (slot-boundp (simple-struct-s1 newstruct) 'slot1)
+					  (eq (slot1 (simple-struct-s1 newstruct)) 5)))))))
 	  (close-store sc1)
-	  (close-store sc2))))
-  t t t t t t t t t t)
+	  (close-store sc2)
+	  (elephant::clear-migrate-duplicate-detection))))
+  t t t t t t)
 
 (defpclass ipfoo ()
   ((slot1 :accessor slot1 :initarg :slot1 :index t)))
@@ -241,5 +273,3 @@
 	      (close-store sc2)))))
   3 1 1 1 1 10 20 )
 
-
-



From ieslick at common-lisp.net  Sun Mar 11 05:45:18 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 11 Mar 2007 00:45:18 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests/testdb-oid
Message-ID: <20070311054518.E6AC530021@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests/testdb-oid
In directory clnet:/tmp/cvs-serv24007/tests/testdb-oid

Added Files:
	README 
Log Message:
Added support for maintaining oid-to-oid map in an external database; cleaned up tests and do-migration-tests to allow validation


--- /project/elephant/cvsroot/elephant/tests/testdb-oid/README	2007/03/11 05:45:18	NONE
+++ /project/elephant/cvsroot/elephant/tests/testdb-oid/README	2007/03/11 05:45:18	1.1
This directory for using Berkeley DB as a storage medium for oid-to-oid maps


From ieslick at common-lisp.net  Sun Mar 11 05:59:03 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 11 Mar 2007 00:59:03 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20070311055903.93A8638013@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv26243/tests

Modified Files:
	elephant-tests.lisp testmigration.lisp 
Log Message:
Migrate no longer has any dependency on memory size; improved migrate tests; cleaned up duplicate detection

--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2007/03/11 05:45:17	1.28
+++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2007/03/11 05:59:03	1.29
@@ -130,10 +130,9 @@
    test another backend"
   (when (and (consp spec) (symbolp (car spec)))
     (with-open-store (spec)
-      (cond ((eq (car spec) :bdb)
-	     (asdf:operate 'asdf:load-op :elephant-tests-bdb)))
-      (let ((*auto-commit* nil))
-	(do-tests)))))
+      (when (eq (car spec) :bdb)
+	(asdf:operate 'asdf:load-op :elephant-tests-bdb))
+      (do-tests))))
   
 (defun do-test-spec (testname &optional (spec *default-spec*))
   "For easy interactive running of single tests while debugging"
--- /project/elephant/cvsroot/elephant/tests/testmigration.lisp	2007/03/11 05:45:17	1.16
+++ /project/elephant/cvsroot/elephant/tests/testmigration.lisp	2007/03/11 05:59:03	1.17
@@ -35,16 +35,18 @@
 	  (format t "~%Single store mode: ignoring")
 	  t)
     (let* ((*store-controller*)
-	   (sc1 (open-store *test-spec-primary* :recover t))
-	   (sc2 (open-store *test-spec-secondary* :recover t)))
+	   (sc1 (open-store *test-spec-primary* :recover t :deadlock-detect t))
+	   (sc2 (open-store *test-spec-secondary* :recover t :deadlock-detect t)))
       (unwind-protect 
 	   (progn
-	     (elephant::initialize-migrate-duplicate-detection)
+	     (mapcar (lambda (x) 
+		       (disable-class-indexing x :sc sc1))
+		     '(idx-two idx-three idx-four idx-five idx-six idx-seven idx-eight
+		       idx-five-del stress-index idx-unbound-del))
 	     (add-to-root "x" "y" :store-controller sc1)
 	     (migrate sc2 sc1)
 	     (equal (get-from-root "x" :store-controller sc1)
 		    (get-from-root "x" :store-controller sc2)))
-	(elephant::clear-migrate-duplicate-detection)
 	(close-store sc1)
 	(close-store sc2))))
   t)



From ieslick at common-lisp.net  Mon Mar 12 01:32:06 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 11 Mar 2007 20:32:06 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070312013206.070801A09F@common-lisp.net>

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

Modified Files:
	TODO ele-bdb.asd 
Log Message:
Henrik's change for linux/bdb compile

--- /project/elephant/cvsroot/elephant/TODO	2007/03/11 03:31:09	1.69
+++ /project/elephant/cvsroot/elephant/TODO	2007/03/12 01:32:05	1.70
@@ -11,6 +11,10 @@
 
 TASKS TO GET TO BETA:
 
+Bugs:
+- Fix db open bug in SQlite
+- Fix Henrik's bugs (if still there)
+
 Migration:
 - Validate SQL migration 0.6.0->0.6.1 (Robert)
 
@@ -24,7 +28,7 @@
 TASKS TO GET TO FINAL RELEASE:
 
 Bugs:
-- Fix any bugs found in BETA
+- Fix any bugs found during BETA
 
 Test coverage:
 - Clean up interface to tests
--- /project/elephant/cvsroot/elephant/ele-bdb.asd	2007/03/03 17:24:58	1.19
+++ /project/elephant/cvsroot/elephant/ele-bdb.asd	2007/03/12 01:32:05	1.20
@@ -32,7 +32,7 @@
 (defmethod compiler-options ((compiler (eql :gcc)) (c bdb-c-source) &key &allow-other-keys)
   (append (library-directories c)
 	  (call-next-method)
-	  (list "-ldb45")))
+	  #-linux (list "-ldb45")))
 
 (defmethod compiler-options ((compiler (eql :cygwin)) (c bdb-c-source) &key &allow-other-keys)
   (append (library-directories c)



From ieslick at common-lisp.net  Mon Mar 12 01:32:06 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 11 Mar 2007 20:32:06 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20070312013206.3F6087D002@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv16651/tests

Modified Files:
	elephant-tests.lisp 
Log Message:
Henrik's change for linux/bdb compile

--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2007/03/11 05:59:03	1.29
+++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2007/03/12 01:32:06	1.30
@@ -102,6 +102,14 @@
 	       (asdf:component-pathname (asdf:find-system 'elephant-tests))))))
   "This is of the form '(filename &optional init-function),")
 
+(defvar *testsqlite3-spec-oid*
+  `(:clsql (:sqlite3 
+	    ,(namestring
+	      (merge-pathnames 
+	       #p"tests/sqlite3-test-oid.db"
+	       (asdf:component-pathname (asdf:find-system 'elephant-tests))))))
+  "This is of the form '(filename &optional init-function),")
+
 (defvar *testsqlite3-memory-spec*
   '(:clsql (:sqlite3 :memory))
   "Using :memory: as a file name will get you an completely in-memory system")



From ieslick at common-lisp.net  Fri Mar 16 14:44:44 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 16 Mar 2007 09:44:44 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070316144444.E2CEC45091@common-lisp.net>

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

Modified Files:
	TODO ele-bdb.asd elephant.asd 
Log Message:
Small changes for lispworks; mainly fixing pointer types

--- /project/elephant/cvsroot/elephant/TODO	2007/03/12 01:32:05	1.70
+++ /project/elephant/cvsroot/elephant/TODO	2007/03/16 14:44:44	1.71
@@ -13,12 +13,12 @@
 
 Bugs:
 - Fix db open bug in SQlite
-- Fix Henrik's bugs (if still there)
 
 Migration:
 - Validate SQL migration 0.6.0->0.6.1 (Robert)
 
 Lisp Support:
+- Validate Lispworks on Mac
 - Validate Lispworks on PC
 - Validate OpenMCL pre-1.1 on Mac OS X
 - Validate OpenMCL 1.1 and/or 64-bit on Mac OS X?
--- /project/elephant/cvsroot/elephant/ele-bdb.asd	2007/03/12 01:32:05	1.20
+++ /project/elephant/cvsroot/elephant/ele-bdb.asd	2007/03/16 14:44:44	1.21
@@ -32,7 +32,7 @@
 (defmethod compiler-options ((compiler (eql :gcc)) (c bdb-c-source) &key &allow-other-keys)
   (append (library-directories c)
 	  (call-next-method)
-	  #-linux (list "-ldb45")))
+	  #-(or linux) (list "-ldb-4.5")))
 
 (defmethod compiler-options ((compiler (eql :cygwin)) (c bdb-c-source) &key &allow-other-keys)
   (append (library-directories c)
@@ -40,8 +40,8 @@
 	  (list "-ldb45")))
 
 (defun library-directories (c)
-  (let ((include (make-pathname :directory (get-config-option :berkeley-db-include-dir c)))
-	(lib (make-pathname :directory (get-config-option :berkeley-db-lib-dir c))))
+  (let ((include (make-pathname :defaults (get-config-option :berkeley-db-include-dir c)))
+	(lib (make-pathname :defaults (get-config-option :berkeley-db-lib-dir c))))
     #+(or windows mswindows)
     (list (format nil "-L\"~A\"" lib) (format nil "-I\"~A\"" include))
     #-(or windows mswindows)
@@ -49,9 +49,9 @@
 
 (defmethod foreign-libraries-to-load-first ((c bdb-c-source))
   (remove-if #'(lambda (x) (null (car x)))
-	     (list
-	      (cons (get-config-option :pthread-lib c) "pthread")
-	      (cons (get-config-option :berkeley-db-lib c) "berkeley-db"))))
+	     (list (cons (get-config-option :pthread-lib c) "pthread")
+	      (cons (get-config-option :berkeley-db-lib c) 
+		    (get-config-option :berkeley-db-lib c)))))
 
 ;;
 ;; System definition
--- /project/elephant/cvsroot/elephant/elephant.asd	2007/03/01 02:46:42	1.36
+++ /project/elephant/cvsroot/elephant/elephant.asd	2007/03/16 14:44:44	1.37
@@ -126,7 +126,7 @@
                              (compiler-options (c-compiler c) c
                                                :input-file
                                                (list (format nil "\"~A\"" (namestring 
-                                                                           (make-pathname :type "o" :defaults pathname)))
+                                                                           (make-pathname :type "o" :defaults patohname)))
                                                      "exports.o")
                                                :output-file (format nil "\"~A\"" (first (output-files o c)))
                                                :library t))))
@@ -211,7 +211,8 @@
    #+(and X86-64 linux) "-march=x86-64"
    "-fPIC"
    "-Wall"
-   "-O3"
+   "-O2"
+   "-g"
    input-file
    "-o" output-file
    "-lm"))
@@ -237,13 +238,15 @@
 
 (defmethod perform ((o load-op) (c elephant-c-source))
   ;; Load any required external libraries
-  (dolist (file+module (foreign-libraries-to-load-first c))
-    (destructuring-bind (file . module) file+module
-      (or (uffi-funcall :load-foreign-library file :module module)
-	  (error "Could not load ~A into ~A" file module))))
+  (let ((libs (foreign-libraries-to-load-first c)))
+    (dolist (file+module libs)
+      (destructuring-bind (file . module) file+module
+	(format t "Loading ~A~%" file)
+	(or (uffi-funcall :load-foreign-library file :module module)
+	    (error "Could not load ~A into ~A" file module)))))
   ;; Load the compiled libraries
   (dolist (file (output-files (make-instance 'compile-op) c))
-    (format t "~A" file)
+    (format t "Loading ~A~%" file)
     (or (uffi-funcall :load-foreign-library file :module (component-name c))
 	(error "Could not load ~A" file))))
 



From ieslick at common-lisp.net  Fri Mar 16 14:44:46 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 16 Mar 2007 09:44:46 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/db-bdb
Message-ID: <20070316144446.5766447005@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src/db-bdb
In directory clnet:/tmp/cvs-serv1438/src/db-bdb

Modified Files:
	bdb-controller.lisp 
Log Message:
Small changes for lispworks; mainly fixing pointer types

--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp	2007/02/18 10:58:58	1.30
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp	2007/03/16 14:44:44	1.31
@@ -76,7 +76,7 @@
 			    (recover-fatal nil) (thread t) 
 			    (deadlock-detect nil))
   (let ((env (db-env-create))
-	(new-p (not (probe-file (make-pathname :directory (second (controller-spec sc))
+	(new-p (not (probe-file (make-pathname :defaults (second (controller-spec sc))
 					       :name "%ELEPHANT")))))
     (setf (controller-environment sc) env)
     (db-env-set-flags env 0 :auto-commit t)
@@ -95,7 +95,7 @@
 
       ;; Open metadata database
       (setf (controller-metadata sc) metadata)
-      (db-open metadata :file "%ELEPHANT" :database "%METADATA"
+      (db-open metadata :file "%ELEPHANT" :database "%METADATA" 
 	       :auto-commit t :type DB-BTREE :create t :thread t)
 
       ;; Establish database version if new



From ieslick at common-lisp.net  Fri Mar 16 14:44:46 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 16 Mar 2007 09:44:46 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/memutil
Message-ID: <20070316144446.9BB6747005@common-lisp.net>

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

Modified Files:
	memutil.lisp 
Log Message:
Small changes for lispworks; mainly fixing pointer types

--- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp	2007/03/03 17:24:59	1.25
+++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp	2007/03/16 14:44:46	1.26
@@ -79,8 +79,8 @@
   (def-type pointer-int (* :int))
   (def-type pointer-void :pointer-void)
   (def-foreign-type array-or-pointer-char
-      #+(or allegro lispworks) (:array :unsigned-char)
-      #+(or cmu sbcl scl openmcl) (* :unsigned-char))
+      #+(or allegro) (:array :unsigned-char)
+      #+(or cmu sbcl scl openmcl lispworks) (* :unsigned-char))
   (def-type array-or-pointer-char array-or-pointer-char)
 
   ;; Standard utility for copying two foreign buffers -- 



From ieslick at common-lisp.net  Fri Mar 16 14:44:47 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 16 Mar 2007 09:44:47 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20070316144447.558E54814C@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv1438/tests

Modified Files:
	testmigration.lisp 
Log Message:
Small changes for lispworks; mainly fixing pointer types

--- /project/elephant/cvsroot/elephant/tests/testmigration.lisp	2007/03/11 05:59:03	1.17
+++ /project/elephant/cvsroot/elephant/tests/testmigration.lisp	2007/03/16 14:44:46	1.18
@@ -155,7 +155,7 @@
 	    (close-store sc2))))
   t)
 
-(defclass simple-class ()
+(defclass migrate-simple-class ()
   ((slot1 :accessor slot1 :initarg :slot1)
    (slot2 :accessor slot2 :initarg :slot2)))
 
@@ -179,7 +179,7 @@
 			   (array (make-array '(2 2) :initial-contents `((,i2 1)
 									 (,i2 2))))
 			   (hash (make-hash-table))
-			   (object (make-instance 'simple-class :slot1 i4 :slot2 i4))
+			   (object (make-instance 'migrate-simple-class :slot1 i4 :slot2 i4))
 			   (struct (make-simple-struct :s1 i5 :s2 i5)))
 		      (setf (gethash 1 hash) i3)
 		      (setf (gethash 2 hash) i3)



From ieslick at common-lisp.net  Sun Mar 18 20:40:50 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 18 Mar 2007 15:40:50 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070318204050.32458431BB@common-lisp.net>

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

Modified Files:
	ele-bdb.asd 
Log Message:
Fixed lispworks serialization issues with floats & strings; fixed remove-derived-index bug that wouldn't properly delete

--- /project/elephant/cvsroot/elephant/ele-bdb.asd	2007/03/16 14:44:44	1.21
+++ /project/elephant/cvsroot/elephant/ele-bdb.asd	2007/03/18 20:40:50	1.22
@@ -32,7 +32,13 @@
 (defmethod compiler-options ((compiler (eql :gcc)) (c bdb-c-source) &key &allow-other-keys)
   (append (library-directories c)
 	  (call-next-method)
-	  #-(or linux) (list "-ldb-4.5")))
+	  #-(or linux) (list (format nil "-l~A" (get-db-name c)))))
+
+(defun get-db-name (c)
+  (subseq (pathname-name 
+	   (make-pathname :defaults (get-config-option :berkeley-db-lib c)) )
+	  3))
+    
 
 (defmethod compiler-options ((compiler (eql :cygwin)) (c bdb-c-source) &key &allow-other-keys)
   (append (library-directories c)



From ieslick at common-lisp.net  Sun Mar 18 20:40:50 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 18 Mar 2007 15:40:50 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/db-bdb
Message-ID: <20070318204050.962754D042@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src/db-bdb
In directory clnet:/tmp/cvs-serv15998/src/db-bdb

Modified Files:
	libberkeley-db.c 
Log Message:
Fixed lispworks serialization issues with floats & strings; fixed remove-derived-index bug that wouldn't properly delete

--- /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c	2007/02/04 04:34:56	1.8
+++ /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c	2007/03/18 20:40:50	1.9
@@ -1011,6 +1011,7 @@
 #define S2_FIXNUM32 1
 #define S2_FIXNUM64 2
 #define S2_CHAR 3
+#define S2_SHORT_FLOAT 30
 #define S2_SINGLE_FLOAT 4
 #define S2_DOUBLE_FLOAT 5
 #define S2_NEGATIVE_BIGNUM 6
@@ -1034,7 +1035,7 @@
 #define S2_FILL_POINTER_P 0x40
 #define S2_ADJUSTABLE_P 0x80
 
-#define type_numeric2(c) (((c)<9) || ((c)==14))
+#define type_numeric2(c) (((c)<9) || ((c)==14) || ((c)==30))
 
 /******
   Serialized BTree keys have the form:
@@ -1149,6 +1150,8 @@
   case S2_FIXNUM64:
   case S2_SYMBOL_ID:
     return (double)read_int(buf, 1);
+  case S2_SHORT_FLOAT:
+    return (double)read_float(buf, 1);
   case S2_SINGLE_FLOAT:
     return (double)read_float(buf, 1);
   case S2_DOUBLE_FLOAT:



From ieslick at common-lisp.net  Sun Mar 18 20:40:51 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 18 Mar 2007 15:40:51 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070318204051.2443C4D042@common-lisp.net>

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

Modified Files:
	classindex.lisp collections.lisp serializer2.lisp 
	unicode2.lisp 
Log Message:
Fixed lispworks serialization issues with floats & strings; fixed remove-derived-index bug that wouldn't properly delete

--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/08 21:29:53	1.27
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/18 20:40:50	1.28
@@ -302,22 +302,21 @@
 	(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 (make-derived-name name)
-		       :key-form (make-derived-key-form derived-defun)
-		       :populate populate)))))
+	  (add-index class-idx
+		     :index-name (make-derived-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)
+  (if (find-inverted-index class (make-derived-name 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))
+	  (remove-index (find-class-index class :sc sc) (make-derived-name name)))
 	t)
       (progn
 	(warn "Derived index ~A does not exist in ~A" name (class-name class))
--- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/11 03:31:09	1.13
+++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/18 20:40:50	1.14
@@ -404,7 +404,7 @@
 (defun print-btree-entry (k v) 
   (format t "key: ~A / value: ~A~%" k v))
 
-(defun dump-btree (bt &key (print-fn #'print-btree-node) (count nil))
+(defun dump-btree (bt &key (print-fn #'print-btree-entry) (count nil))
   "Print the contents of a btree for easy inspection & debugging"
   (format t "DUMP ~A~%" bt)
   (let ((i 0))
--- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp	2007/02/26 19:12:18	1.30
+++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp	2007/03/18 20:40:50	1.31
@@ -81,6 +81,9 @@
 (defconstant +struct+               20)
 (defconstant +class+                21)
 
+;; Lispworks support
+(defconstant +short-float+          30)
+
 (defconstant +nil+                  #x3F)
 (defconstant +reserved-dbinfo+      #xF0)
 
@@ -201,6 +204,10 @@
 		    (setf tp (class-name (class-of frob))))
 		(%serialize tp))
 	      )
+	     #+lispworks
+	     (short-float
+	      (buffer-write-byte +short-float+ bs)
+	      (buffer-write-float (coerce frob 'single-float) bs))
 	     #-(and :lispworks (or :win32 :linux))
 	     (single-float
 	      (buffer-write-byte +single-float+ bs)
@@ -339,6 +346,7 @@
   `((,+fixnum32+ . "fixnum32")
     (,+fixnum64+ . "fixnum32")
     (,+char+ . "char")
+    (,+short-float+ . "short-float")
     (,+single-float+ . "single-float")
     (,+double-float+ . "double float")
     (,+negative-bignum+ . "neg bignum")
@@ -402,10 +410,19 @@
 	      (buffer-read-fixnum64 bs))
 	     ((= tag +nil+) nil)
 	     ((= tag +utf8-string+)
+	      #+lispworks
+	      (coerce (deserialize-string :utf8 bs) 'base-string)
+	      #-lispworks
 	      (deserialize-string :utf8 bs))
 	     ((= tag +utf16-string+)
+	      #+lispworks
+	      (coerce (deserialize-string :utf16le bs) 'lw:text-string)
+	      #-lispworks
 	      (deserialize-string :utf16le bs))
 	     ((= tag +utf32-string+)
+	      #+lispworks
+	      (coerce (deserialize-string :utf32le bs) 'sys:augmented-string)
+	      #-lispworks
 	      (deserialize-string :utf32le bs))
 	     ((= tag +symbol+)
 	      (let ((name (%deserialize bs))
@@ -415,6 +432,9 @@
 	      (get-cached-instance sc
 				   (buffer-read-fixnum32 bs)
 				   (%deserialize bs)))
+	     #+lispworks
+	     ((= tag +short-float+)
+	      (coerce (buffer-read-float bs) 'short-float))
 	     ((= tag +single-float+)
 	      (buffer-read-float bs))
 	     ((= tag +double-float+)
--- /project/elephant/cvsroot/elephant/src/elephant/unicode2.lisp	2007/02/25 20:02:32	1.6
+++ /project/elephant/cvsroot/elephant/src/elephant/unicode2.lisp	2007/03/18 20:40:50	1.7
@@ -199,6 +199,10 @@
 
 (defgeneric deserialize-string (type bstream &optional temp-string))
 
+(defmethod deserialize-string :around ((type t) bstream &optional temp-string)
+  #+lispworks (coerce (call-next-method) 'lispworks:simple-text-string)
+  #-lispworks (call-next-method))
+
 (defmethod deserialize-string ((type (eql :utf8)) bstream &optional temp-string)
   (declare (type buffer-stream bstream))
   ;; Default char-code method



From ieslick at common-lisp.net  Sun Mar 18 20:47:29 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 18 Mar 2007 15:47:29 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20070318204729.505E52F040@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv16838/tests

Modified Files:
	testmigration.lisp 
Log Message:
Fixed migrate-mult-pclass test bug

--- /project/elephant/cvsroot/elephant/tests/testmigration.lisp	2007/03/16 14:44:46	1.18
+++ /project/elephant/cvsroot/elephant/tests/testmigration.lisp	2007/03/18 20:47:28	1.19
@@ -162,6 +162,11 @@
 (defstruct simple-struct s1 s2)
 
 (deftest migrate-mult-pclass 
+    (if (or (not (boundp '*test-spec-secondary*) )
+	    (null *test-spec-secondary*))
+	(progn
+	  (format t "~%Single store mode: ignoring")
+	  (values t t t t t t))
     (progn
       (let* ((sc1 (open-store *test-spec-primary* :recover t :deadlock-detect t))
 	     (sc2 (open-store *test-spec-secondary* :recover t :deadlock-detect t))
@@ -214,7 +219,7 @@
 					  (eq (slot1 (simple-struct-s1 newstruct)) 5)))))))
 	  (close-store sc1)
 	  (close-store sc2)
-	  (elephant::clear-migrate-duplicate-detection))))
+	  (elephant::clear-migrate-duplicate-detection)))))
   t t t t t t)
 
 (defpclass ipfoo ()



From ieslick at common-lisp.net  Mon Mar 19 19:41:35 2007
From: ieslick at common-lisp.net (ieslick)
Date: Mon, 19 Mar 2007 14:41:35 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070319194135.8C5C95908E@common-lisp.net>

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

Modified Files:
	TODO 
Log Message:
Fixed lispworks MOP support; lispworks is green under Mac OS X

--- /project/elephant/cvsroot/elephant/TODO	2007/03/16 14:44:44	1.71
+++ /project/elephant/cvsroot/elephant/TODO	2007/03/19 19:41:35	1.72
@@ -12,7 +12,10 @@
 TASKS TO GET TO BETA:
 
 Bugs:
-- Fix db open bug in SQlite
+- Lispworks/Mac: error in finalize indexed class
+- Lispworks/Mac: %oid missing in BDB-BTREE on close
+- Lispworks/Mac: fix warning in ensure-class-using-class :around (eql nil) method
+- Fix build for Win32 (Frank)
 
 Migration:
 - Validate SQL migration 0.6.0->0.6.1 (Robert)



From ieslick at common-lisp.net  Mon Mar 19 19:41:36 2007
From: ieslick at common-lisp.net (ieslick)
Date: Mon, 19 Mar 2007 14:41:36 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070319194136.336285D083@common-lisp.net>

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

Modified Files:
	classes.lisp classindex.lisp metaclasses.lisp package.lisp 
Log Message:
Fixed lispworks MOP support; lispworks is green under Mac OS X

--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/08 21:29:53	1.21
+++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/19 19:41:35	1.22
@@ -47,14 +47,14 @@
 ;; METACLASS INITIALIZATION AND CHANGES
 ;; ================================================
 
-(defmethod ensure-class-using-class :around ((class (eql nil)) name &rest args &key index)
+(defmethod ensure-class-using-class :around ((class null) name &rest args &key index)
   "Support the :index class option"
   (let ((result (apply #'call-next-method class name (remove-keywords '(:index) args))))
     (when (and index (subtypep (type-of result) 'persistent-metaclass))
       (update-indexed-record result nil :class-indexed t))
     result))
 
-(defmethod ensure-class-using-class :around ((class persistent-metaclass) name &rest args &key index)
+(defmethod ensure-class-using-class ((class persistent-metaclass) name &rest args &key index)
   "Support the :index class option on redefinition"
   (let ((result (apply #'call-next-method class name (remove-keywords '(:index) args))))
     (when index
@@ -222,28 +222,28 @@
     (call-next-method)))
 
 
-;;
-;; SLOT ACCESS PROTOCOLS
-;;
+;; =============================================
+;; SHARED SLOT ACCESS PROTOCOL DEFINITIONS
+;; =============================================
 
-(defmethod slot-value-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
+(defmethod slot-value-using-class ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Get the slot value from the database."
   (let ((name (slot-definition-name slot-def)))
     (persistent-slot-reader (get-con instance) instance name)))
 
-(defmethod (setf slot-value-using-class) :around (new-value (class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
+(defmethod (setf slot-value-using-class) (new-value (class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Set the slot value in the database."
   (if (indexed class)
       (indexed-slot-writer class instance slot-def new-value)
       (let ((name (slot-definition-name slot-def)))
 	(persistent-slot-writer (get-con instance) new-value instance name))))
 
-(defmethod slot-boundp-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
+(defmethod slot-boundp-using-class ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Checks if the slot exists in the database."
   (let ((name (slot-definition-name slot-def)))
     (persistent-slot-boundp (get-con instance) instance name)))
 
-(defmethod slot-boundp-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-name symbol))
+(defmethod slot-boundp-using-class ((class persistent-metaclass) (instance persistent-object) (slot-name symbol))
   "Checks if the slot exists in the database."
   (loop for slot in (class-slots class)
 	for matches-p = (eq (slot-definition-name slot) slot-name)
@@ -253,7 +253,7 @@
 			    (persistent-slot-boundp (get-con instance) instance slot-name)
 			    (call-next-method)))))
 
-(defmethod slot-makunbound-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
+(defmethod slot-makunbound-using-class ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Removes the slot value from the database."
   (if (indexed class)
       (indexed-slot-makunbound class instance slot-def)
@@ -268,12 +268,14 @@
 ;;
 
 #+allegro
-(defmethod slot-makunbound-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-name symbol))
+(defmethod slot-makunbound-using-class ((class persistent-metaclass) (instance persistent-object) (slot-name symbol))
   (loop for slot in (class-slots class)
-	until (eq (slot-definition-name slot) slot-name)
-	finally (return (if (typep slot 'persistent-slot-definition)
-			    (slot-makunbound-using-class class instance slot)
-			    (call-next-method)))))
+     until (eq (slot-definition-name slot) slot-name)
+     finally (return (if (typep slot 'persistent-slot-definition)
+			 (if (indexed class)
+			     (indexed-slot-makunbound class instance slot)
+			     (slot-makunbound-using-class class instance slot))
+			 (call-next-method)))))
 
 
 #+allegro
@@ -346,3 +348,36 @@
 	  (make-persistent-slot-boundp name)))
   slot-def)
 
+;;
+;; LISPWORKS
+;;
+
+#+lispworks
+(defmethod slot-value-using-class ((class persistent-metaclass) (instance persistent-object) slot)
+  (let ((slot-def (or (find slot (class-slots class) :key 'slot-definition-name)
+		      (find slot (class-slots class)))))
+    (if (typep slot-def 'persistent-slot-definition)
+	(persistent-slot-reader (get-con instance) instance (slot-definition-name slot-def))
+	(call-next-method class instance (slot-definition-name slot-def)))))
+
+#+lispworks
+(defmethod (setf slot-value-using-class) (new-value (class persistent-metaclass) (instance persistent-object) slot)
+  "Set the slot value in the database."
+  (let ((slot-def (or (find slot (class-slots class) :key 'slot-definition-name)
+		      (find slot (class-slots class)))))
+    (if (typep slot-def 'persistent-slot-definition)
+	(if (indexed class)
+	    (indexed-slot-writer class instance slot-def new-value)
+	    (persistent-slot-writer (get-con instance) new-value instance (slot-definition-name slot-def)))
+	(call-next-method new-value class instance (slot-definition-name slot-def)))))
+
+#+lispworks
+(defmethod slot-makunbound-using-class ((class persistent-metaclass) (instance persistent-object) slot)
+  "Removes the slot value from the database."
+  (let ((slot-def (or (find slot (class-slots class) :key 'slot-definition-name)
+		      (find slot (class-slots class)))))
+    (if (typep slot-def 'persistent-slot-definition)
+	(if (indexed class)
+	    (indexed-slot-makunbound class instance slot-def)
+	    (persistent-slot-makunbound (get-con instance) instance (slot-definition-name slot-def)))
+	(call-next-method class instance (slot-definition-name slot-def)))))
\ No newline at end of file
--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/18 20:40:50	1.28
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/19 19:41:35	1.29
@@ -205,7 +205,7 @@
 			(setf indexed-slot-names (union slots indexed-slot-names)))))))
       ;; Put class instance index into the class root & cache it in the class object
       (update-indexed-record class indexed-slot-names :class-indexed t)
-      (with-transaction (:store-controller sc)
+      (ensure-transaction (:store-controller sc)
 	(when (not found)
 	  (let ((class-idx (build-indexed-btree sc)))
 	    (setf (get-value (class-name class) croot) class-idx)
--- /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp	2007/03/08 21:29:53	1.10
+++ /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp	2007/03/19 19:41:35	1.11
@@ -24,7 +24,7 @@
 
 (defclass persistent ()
   ((%oid :accessor oid :initarg :from-oid)
-   (dbonnection-spec-pst :type (or list string) :accessor dbcn-spc-pst :initarg :dbconnection-spec-pst))
+   (dbconnection-spec-pst :type (or list string) :accessor dbcn-spc-pst :initarg :dbconnection-spec-pst))
   (:documentation "Abstract superclass for all persistent classes (common
     to user-defined classes and collections.)"))
 
@@ -239,12 +239,17 @@
   '(:instance :class :database))
 
 (defmethod slot-definition-allocation ((slot-definition persistent-slot-definition))
-  #-lispworks :database
-  #+lispworks nil)
+  :database)
+
+#+lispworks
+(defmethod (setf slot-definition-allocation) (allocation (slot-def persistent-slot-definition))
+  (unless (eq allocation :database)
+    (error "Invalid allocation type ~A for slot-definition-allocation" allocation))
+  allocation)
 
 (defmethod direct-slot-definition-class ((class persistent-metaclass) &rest initargs)
   "Checks for the transient tag (and the allocation type)
-and chooses persistent or transient slot definitions."
+   and chooses persistent or transient slot definitions."
   (let ((allocation-key (getf initargs :allocation))
 	(transient-p (getf initargs :transient))
 	(indexed-p (getf initargs :index)))
@@ -299,7 +304,7 @@
   (declare (ignore slot-name))
   (apply #'make-effective-slot-definition class
 	 (compute-effective-slot-definition-initargs 
-	  class direct-slot-definitions)))
+	 class slot-name direct-slot-definitions)))
 
 #+openmcl
 (defmethod compute-effective-slot-definition-initargs ((class slots-class)
@@ -336,7 +341,8 @@
   (loop for slot-definition in slot-definitions
      always (transient slot-definition)))
 
-(defmethod compute-effective-slot-definition-initargs ((class persistent-metaclass) slot-definitions)
+(defmethod compute-effective-slot-definition-initargs ((class persistent-metaclass) #+lispworks slot-name slot-definitions)
+  #+lispworks (declare (ignore slot-name))
   (let ((initargs (call-next-method)))
     (if (ensure-transient-chain slot-definitions initargs)
 	(setf initargs (append initargs '(:transient t)))
--- /project/elephant/cvsroot/elephant/src/elephant/package.lisp	2007/03/11 05:45:14	1.23
+++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp	2007/03/19 19:41:35	1.24
@@ -133,12 +133,13 @@
 		standard-slot-definition
 		standard-direct-slot-definition
 		standard-effective-slot-definition
-		direct-slot-definition-class
-		effective-slot-definition-class
 		slot-definition-name
 		slot-definition-initform
 		slot-definition-initfunction
+		direct-slot-definition-class
+		effective-slot-definition-class
 		compute-effective-slot-definition
+		compute-effective-slot-definition-initargs
 		class-slots
 		slot-value-using-class
 		slot-boundp-using-class
@@ -149,9 +150,7 @@
 		finalize-inheritance
 		ensure-class-using-class
 		compute-slots
-
 		initialize-internal-slot-functions
-		compute-effective-slot-definition-initargs
 		slot-definition-reader-function
 		slot-definition-writer-function
 		slot-definition-boundp-function
@@ -276,18 +275,20 @@
   #+lispworks  
   (:import-from :clos
 		class-finalized-p
+		finalize-inheritance
 		compute-class-precedence-list
 		validate-superclass
 		ensure-class-using-class
 		standard-slot-definition
 		standard-direct-slot-definition
 		standard-effective-slot-definition
-		direct-slot-definition-class
-		effective-slot-definition-class
 		slot-definition-name
 		slot-definition-initform
 		slot-definition-initfunction
+		direct-slot-definition-class
+		effective-slot-definition-class
 		compute-effective-slot-definition
+		compute-effective-slot-definition-initargs
 		class-slots
 		slot-value-using-class
 		slot-boundp-using-class



From ieslick at common-lisp.net  Mon Mar 19 19:41:37 2007
From: ieslick at common-lisp.net (ieslick)
Date: Mon, 19 Mar 2007 14:41:37 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20070319194137.0E98561051@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv8886/tests

Modified Files:
	mop-tests.lisp 
Log Message:
Fixed lispworks MOP support; lispworks is green under Mac OS X

--- /project/elephant/cvsroot/elephant/tests/mop-tests.lisp	2007/02/03 04:09:14	1.12
+++ /project/elephant/cvsroot/elephant/tests/mop-tests.lisp	2007/03/19 19:41:36	1.13
@@ -44,22 +44,27 @@
 	(slot2 :accessor slot2 :transient t)
 	(slot3 :accessor slot3 :allocation :class :transient t))
        (:metaclass persistent-metaclass))
+     (finalize-inheritance (find-class 'p-class))
      (defclass nonp-class ()
        ((slot1 :accessor slot1)
 	(slot2 :accessor slot2)
 	(slot3 :accessor slot3 :allocation :class)))
+     (finalize-inheritance (find-class 'nonp-class))
      (defclass minus-p-class ()
        ((slot1 :accessor slot1 :transient t)
 	(slot2 :accessor slot2)
 	(slot3 :accessor slot3))
        (:metaclass persistent-metaclass))
+     (finalize-inheritance (find-class 'minus-p-class))
      (defclass switch-transient ()
        ((slot1 :accessor slot1 :transient t)
 	(slot2 :accessor slot2))
        (:metaclass persistent-metaclass))
+     (finalize-inheritance (find-class 'switch-transient))
      (defclass make-persistent ()
        ((slot2 :accessor slot2))
-       (:metaclass persistent-metaclass)))
+       (:metaclass persistent-metaclass))
+     (finalize-inheritance (find-class 'make-persistent)))
   t)
 
 (deftest bad-inheritence



From ieslick at common-lisp.net  Mon Mar 19 20:35:31 2007
From: ieslick at common-lisp.net (ieslick)
Date: Mon, 19 Mar 2007 15:35:31 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070319203531.143EC34079@common-lisp.net>

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

Modified Files:
	TODO config.sexp ele-bdb.asd elephant.asd 
Log Message:
Path creation changes for win32 (need to remove cl-ppcre dependencies)

--- /project/elephant/cvsroot/elephant/TODO	2007/03/19 19:41:35	1.72
+++ /project/elephant/cvsroot/elephant/TODO	2007/03/19 20:35:30	1.73
@@ -11,17 +11,10 @@
 
 TASKS TO GET TO BETA:
 
-Bugs:
-- Lispworks/Mac: error in finalize indexed class
-- Lispworks/Mac: %oid missing in BDB-BTREE on close
-- Lispworks/Mac: fix warning in ensure-class-using-class :around (eql nil) method
-- Fix build for Win32 (Frank)
-
 Migration:
 - Validate SQL migration 0.6.0->0.6.1 (Robert)
 
 Lisp Support:
-- Validate Lispworks on Mac
 - Validate Lispworks on PC
 - Validate OpenMCL pre-1.1 on Mac OS X
 - Validate OpenMCL 1.1 and/or 64-bit on Mac OS X?
--- /project/elephant/cvsroot/elephant/config.sexp	2007/02/22 20:19:57	1.7
+++ /project/elephant/cvsroot/elephant/config.sexp	2007/03/19 20:35:30	1.8
@@ -1,11 +1,38 @@
-((:berkeley-db-include-dir . "/opt/local/BerkeleyDB.4.5/")
+#+(or sbcl allegro)
+((:berkeley-db-include-dir . "/opt/local/include/db45/")
  (:berkeley-db-lib-dir . "/opt/local/lib/db45/")
- (:berkeley-db-lib . "/opt/local/BerkeleyDB.4.5/lib/libDB-4.5.dylib")
+ (:berkeley-db-lib . "/opt/local/lib/db45/libdb-4.5.dylib")
  (:berkeley-db-deadlock . "/opt/local/bin/db45_deadlock")
  (:pthread-lib . nil)
  (:clsql-lib . nil)
  (:compiler . :gcc))
 
+#+openmcl
+((:berkeley-db-include-dir . "/usr/local/BerkeleyDB.4.5/include/")
+ (:berkeley-db-lib-dir . "/usr/local/BerkeleyDB.4.5/lib/")
+ (:berkeley-db-lib . "/usr/local/BerkeleyDB.4.5/lib/libdb-4.5.dylib")
+ (:pthread-lib . nil)
+ (:clsql-lib . nil)
+ (:compiler . :gcc))
+
+#+(and lispworks (not windows))
+((:berkeley-db-include-dir . "/opt/local/include/db45/")
+ (:berkeley-db-lib-dir . "/opt/local/lib/db45/")
+ (:berkeley-db-lib . "/opt/local/lib/db45/libdb-4.5.dylib")
+ (:berkeley-db-deadlock . "/opt/local/bin/db45_deadlock")
+ (:pthread-lib . nil)
+ (:clsql-lib . nil)
+ (:compiler . :gcc))
+
+#+(or mswindows windows)
+((:berkeley-db-include-dir . "C:/Programme/Oracle/Berkeley DB 4.5.20/include/")
+ (:berkeley-db-lib-dir . "C:/Programme/Oracle/Berkeley DB 4.5.20/bin/")
+ (:berkeley-db-lib . "C:/Programme/Oracle/Berkeley DB 4.5.20/bin/libdb45.dll")
+ (:berkeley-db-deadlock . "C:/Programme/Oracle/Berkeley DB 4.5.20/bin/db_deadlock.exe")
+ (:pthread-lib . nil)
+ (:clsql-lib . nil)
+ (:compiler . :cygwin))
+
 ;; Berkeley 4.5 is required, each system will have different settings for
 ;; these directories, use this as an indication of what each key means
 ;;
--- /project/elephant/cvsroot/elephant/ele-bdb.asd	2007/03/18 20:40:50	1.22
+++ /project/elephant/cvsroot/elephant/ele-bdb.asd	2007/03/19 20:35:30	1.23
@@ -27,6 +27,18 @@
 ;; Compile bdb lib and load libraries
 ;;
 
+#+(or windows mswindows)
+(defun path-for-cygwin (path)
+  "DOS pathname -> cygwin pathname. Replace backslashes with slashes and drive letter with directory.  
+\"C:\\dir\\\" -> \"/C/dir\" (drive C: must be mounted as /C/ in cgwin."
+  (let ((result (namestring path)))
+    (setf result (cl-ppcre:regex-replace "([A-Z]):" 
+                                         result 
+                                         #'(lambda (match &rest registers)
+                                             (format nil "/~a" (first registers)))
+                                         :simple-calls t))
+    (setf result (cl-ppcre:regex-replace-all "\\" result "/"))))
+
 (defclass bdb-c-source (elephant-c-source) ())
 
 (defmethod compiler-options ((compiler (eql :gcc)) (c bdb-c-source) &key &allow-other-keys)
@@ -38,18 +50,18 @@
   (subseq (pathname-name 
 	   (make-pathname :defaults (get-config-option :berkeley-db-lib c)) )
 	  3))
-    
 
 (defmethod compiler-options ((compiler (eql :cygwin)) (c bdb-c-source) &key &allow-other-keys)
   (append (library-directories c)
-	  (call-next-method)
-	  (list "-ldb45")))
+	  (list "-ldb45")
+	  (call-next-method)))
 
 (defun library-directories (c)
   (let ((include (make-pathname :defaults (get-config-option :berkeley-db-include-dir c)))
 	(lib (make-pathname :defaults (get-config-option :berkeley-db-lib-dir c))))
     #+(or windows mswindows)
-    (list (format nil "-L\"~A\"" lib) (format nil "-I\"~A\"" include))
+    (list (format nil "-L'~A'" (path-for-cygwin lib))
+	  (format nil "-I'~A'" (path-for-cygwin include)))
     #-(or windows mswindows)
     (list (format nil "-L~A" lib) (format nil "-I~A" include))))
 
--- /project/elephant/cvsroot/elephant/elephant.asd	2007/03/16 14:44:44	1.37
+++ /project/elephant/cvsroot/elephant/elephant.asd	2007/03/19 20:35:30	1.38
@@ -97,7 +97,8 @@
   #+(or mswindows windows)
   (progn
     (let* ((pathname (component-pathname c))
-           (directory (directory-namestring pathname))
+           (directory #+lispworks (make-pathname :host (pathname-host pathname) :directory (pathname-directory pathname))
+                      #-lispworks (make-pathname :device (pathname-device pathname) :directory (pathname-directory pathname)))
            (stdout-lines) (stderr-lines) (exit-status))
       (let ((command (format nil "~A ~{~A ~}"
                        (c-compiler-path c)



From ieslick at common-lisp.net  Mon Mar 19 20:51:28 2007
From: ieslick at common-lisp.net (ieslick)
Date: Mon, 19 Mar 2007 15:51:28 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070319205128.9445434075@common-lisp.net>

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

Modified Files:
	serializer2.lisp 
Log Message:
single-float fix for serializer

--- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp	2007/03/18 20:40:50	1.31
+++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp	2007/03/19 20:51:28	1.32
@@ -208,7 +208,6 @@
 	     (short-float
 	      (buffer-write-byte +short-float+ bs)
 	      (buffer-write-float (coerce frob 'single-float) bs))
-	     #-(and :lispworks (or :win32 :linux))
 	     (single-float
 	      (buffer-write-byte +single-float+ bs)
 	      (buffer-write-float frob bs))



From ieslick at common-lisp.net  Tue Mar 20 02:00:08 2007
From: ieslick at common-lisp.net (ieslick)
Date: Mon, 19 Mar 2007 21:00:08 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070320020008.18DD6650D7@common-lisp.net>

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

Modified Files:
	ele-bdb.asd 
Log Message:
Remove cl-ppcre dependency

--- /project/elephant/cvsroot/elephant/ele-bdb.asd	2007/03/19 20:35:30	1.23
+++ /project/elephant/cvsroot/elephant/ele-bdb.asd	2007/03/20 02:00:07	1.24
@@ -27,17 +27,17 @@
 ;; Compile bdb lib and load libraries
 ;;
 
+
 #+(or windows mswindows)
 (defun path-for-cygwin (path)
-  "DOS pathname -> cygwin pathname. Replace backslashes with slashes and drive letter with directory.  
-\"C:\\dir\\\" -> \"/C/dir\" (drive C: must be mounted as /C/ in cgwin."
-  (let ((result (namestring path)))
-    (setf result (cl-ppcre:regex-replace "([A-Z]):" 
-                                         result 
-                                         #'(lambda (match &rest registers)
-                                             (format nil "/~a" (first registers)))
-                                         :simple-calls t))
-    (setf result (cl-ppcre:regex-replace-all "\\" result "/"))))
+"DOS pathname -> cygwin pathname. Replace backslashes with slashes and drive letter with directory.  
+e.g. \"C:\\dir\\\" -> \"/C/dir/\" (drive C: must be mounted as /C/ in cgwin)"
+  (let* ((result (namestring path))
+         (colon-pos (position #\: result))
+         (drive-letter (char result (1- colon-pos))))
+    (setf (char result (1- colon-pos)) #\/)
+    (setf (char result colon-pos) drive-letter)
+    (substitute #\/ #\\ result)))
 
 (defclass bdb-c-source (elephant-c-source) ())
 



From ieslick at common-lisp.net  Wed Mar 21 14:29:30 2007
From: ieslick at common-lisp.net (ieslick)
Date: Wed, 21 Mar 2007 09:29:30 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/db-bdb
Message-ID: <20070321142930.C295E4C0C2@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src/db-bdb
In directory clnet:/tmp/cvs-serv17716/src/db-bdb

Modified Files:
	bdb-transactions.lisp 
Log Message:
Fixes submitted by Henrik; some OpenMCL changes

--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-transactions.lisp	2007/03/04 20:22:47	1.11
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-transactions.lisp	2007/03/21 14:29:30	1.12
@@ -39,22 +39,21 @@
 					:txn-nowait txn-nowait
 					:txn-sync txn-sync))))
 	 (declare (type pointer-void txn))
-	 (let ((result
-		(multiple-value-list
-		 (let ((*current-transaction* (make-transaction-record sc txn))
-		       (*store-controller* sc))
-		   (declare (special *current-transaction* *store-controller*))
-		   (catch 'transaction
-		     (unwind-protect
-			  (multiple-value-prog1 
-			      (funcall txn-fn)
-			    (db-transaction-commit txn 
-						   :txn-nosync txn-nosync
-						   :txn-sync txn-sync)
-			    (setq success t))
-		       (unless success 
-			 (db-transaction-abort txn))))))))
-	   (unless (and (eq result txn) (not success))
+	 (let (result)
+	   (let ((*current-transaction* (make-transaction-record sc txn))
+		 (*store-controller* sc))
+	     (declare (special *current-transaction* *store-controller*))
+	     (catch 'transaction
+	       (unwind-protect
+		    (progn
+		      (setf result (multiple-value-list (funcall txn-fn)))
+		      (db-transaction-commit txn 
+					     :txn-nosync txn-nosync
+					     :txn-sync txn-sync)
+		      (setq success t))
+		 (unless success 
+		   (db-transaction-abort txn)))))
+	   (when success
 	     (return (values-list result)))))
        finally (error "Too many retries in transaction"))))
     



From ieslick at common-lisp.net  Wed Mar 21 14:29:31 2007
From: ieslick at common-lisp.net (ieslick)
Date: Wed, 21 Mar 2007 09:29:31 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070321142931.93B364F014@common-lisp.net>

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

Modified Files:
	classes.lisp classindex.lisp collections.lisp metaclasses.lisp 
	serializer2.lisp 
Log Message:
Fixes submitted by Henrik; some OpenMCL changes

--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/19 19:41:35	1.22
+++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/21 14:29:30	1.23
@@ -240,18 +240,19 @@
 
 (defmethod slot-boundp-using-class ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Checks if the slot exists in the database."
-  (let ((name (slot-definition-name slot-def)))
-    (persistent-slot-boundp (get-con instance) instance name)))
+  (when instance
+    (let ((name (slot-definition-name slot-def)))
+      (persistent-slot-boundp (get-con instance) instance name))))
 
 (defmethod slot-boundp-using-class ((class persistent-metaclass) (instance persistent-object) (slot-name symbol))
   "Checks if the slot exists in the database."
   (loop for slot in (class-slots class)
-	for matches-p = (eq (slot-definition-name slot) slot-name)
-	until matches-p
-	finally (return (if (and matches-p
-				 (subtypep (type-of slot) 'persistent-slot-definition))
-			    (persistent-slot-boundp (get-con instance) instance slot-name)
-			    (call-next-method)))))
+     for matches-p = (eq (slot-definition-name slot) slot-name)
+     until matches-p
+     finally (return (if (and matches-p
+			      (subtypep (type-of slot) 'persistent-slot-definition))
+			 (persistent-slot-boundp (get-con instance) instance slot-name)
+			 (call-next-method)))))
 
 (defmethod slot-makunbound-using-class ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Removes the slot value from the database."
--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/19 19:41:35	1.29
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/21 14:29:30	1.30
@@ -430,7 +430,7 @@
 
 (defmethod get-instances-by-range ((class persistent-metaclass) idx-name start end)
   (declare (type (or fixnum null) start end)
-	   (type string idx-name))
+	   (type symbol idx-name))
   (let ((instances nil))
     (declare (type list instances))
     (flet ((collector (k v pk)
--- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/18 20:40:50	1.14
+++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/21 14:29:30	1.15
@@ -348,17 +348,20 @@
     (string (string<= a b))
     (persistent (<= (oid a) (oid b)))))
 
-(defmethod map-index (fn (index btree-index) &rest args &key start end)
+(defmethod map-index (fn (index btree-index) &rest args &key (start nil start-supplied-p) (end nil end-supplied-p))
   "Like map-btree, but takes a function of three arguments key, value and primary key
    if you want to get at the primary key value, otherwise use map-btree"
-  (declare (dynamic-extent args))
+  (declare (dynamic-extent args)
+	   (ignorable args))
   (let ((sc (get-con index)))
     (ensure-transaction (:store-controller sc)
       (with-btree-cursor (cur index)
 	(labels ((next-range ()
 		   (multiple-value-bind (exists? skey val pkey) (cursor-pnext-nodup cur)
-		     (if (or (and exists? (not end))
-			     (and exists? (lisp-compare<= skey end)))
+		     (if (and exists? 
+			      (or (not end-supplied-p)
+				  (null end)
+				  (lisp-compare<= skey end)))
 		       (progn
 			 (funcall fn skey val pkey)
 			 (next-in-range skey))
@@ -373,12 +376,14 @@
 			   (cursor-pset-range cur key)
 			   (next-range))))))
 	  (declare (dynamic-extent next-range next-in-range))
-	  (multiple-value-bind (exists? skey val pkey) 
-	      (if start
+	  (multiple-value-bind (exists? skey val pkey)
+	      (if (and start-supplied-p (not (null start)))
 		  (cursor-pset-range cur start)
 		  (cursor-pfirst cur))
-	    (if (or (and exists? (not end))
-		    (and exists? (lisp-compare<= skey end)))
+	    (if (and exists? 
+		     (or (not end-supplied-p)
+			 (null end)
+			 (lisp-compare<= skey end)))
 		(progn
 		  (funcall fn skey val pkey)
 		  (next-in-range skey))
--- /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp	2007/03/19 19:41:35	1.11
+++ /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp	2007/03/21 14:29:30	1.12
@@ -304,7 +304,7 @@
   (declare (ignore slot-name))
   (apply #'make-effective-slot-definition class
 	 (compute-effective-slot-definition-initargs 
-	 class slot-name direct-slot-definitions)))
+	 class direct-slot-definitions)))
 
 #+openmcl
 (defmethod compute-effective-slot-definition-initargs ((class slots-class)
--- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp	2007/03/19 20:51:28	1.32
+++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp	2007/03/21 14:29:31	1.33
@@ -168,7 +168,7 @@
 		    (buffer-write-byte +fixnum32+ bs)
 		    (buffer-write-int32 frob bs))
 		  (progn
-		    (assert (< #.most-positive-fixnum +2^63+))
+		    (assert (eq (< #.most-positive-fixnum +2^63+) t))
 		    (if (< (abs frob) +2^31+)
 			(progn
 			  (buffer-write-byte +fixnum32+ bs)
@@ -343,7 +343,7 @@
 
 (defparameter *tag-table*
   `((,+fixnum32+ . "fixnum32")
-    (,+fixnum64+ . "fixnum32")
+    (,+fixnum64+ . "fixnum64")
     (,+char+ . "char")
     (,+short-float+ . "short-float")
     (,+single-float+ . "single-float")



From ieslick at common-lisp.net  Wed Mar 21 14:29:32 2007
From: ieslick at common-lisp.net (ieslick)
Date: Wed, 21 Mar 2007 09:29:32 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/memutil
Message-ID: <20070321142932.B9B5483074@common-lisp.net>

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

Modified Files:
	memutil.lisp 
Log Message:
Fixes submitted by Henrik; some OpenMCL changes

--- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp	2007/03/16 14:44:46	1.26
+++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp	2007/03/21 14:29:31	1.27
@@ -550,7 +550,7 @@
     (let ((needed (+ size 1)))
       (when (> needed len)
 	(resize-buffer-stream bs needed))
-      (setf (deref-array buf '(:array :char) size) b)
+      (setf (deref-array buf '(:array :unsigned-char) size) b)
       (setf size needed))))
 
 (defun buffer-write-int32 (i bs)
@@ -677,7 +677,7 @@
   (declare (type buffer-stream bs))
   (let ((position (buffer-stream-position bs)))
     (incf (buffer-stream-position bs))
-    (deref-array (buffer-stream-buffer bs) '(:array :unsigned-byte) position)))
+    (deref-array (buffer-stream-buffer bs) '(:array :unsigned-char) position)))
 
 
 (defun buffer-read-byte-vector (bs)



From ieslick at common-lisp.net  Wed Mar 21 15:05:00 2007
From: ieslick at common-lisp.net (ieslick)
Date: Wed, 21 Mar 2007 10:05:00 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070321150500.2CC0755395@common-lisp.net>

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

Modified Files:
	TODO 
Log Message:
Beta release TODO

--- /project/elephant/cvsroot/elephant/TODO	2007/03/19 20:35:30	1.73
+++ /project/elephant/cvsroot/elephant/TODO	2007/03/21 15:04:59	1.74
@@ -9,20 +9,14 @@
 0.6.1 - performance, safety and portability 
 --------------------------------------------
 
-TASKS TO GET TO BETA:
-
-Migration:
-- Validate SQL migration 0.6.0->0.6.1 (Robert)
+TASKS TO GET TO FINAL RELEASE:
 
 Lisp Support:
-- Validate Lispworks on PC
 - Validate OpenMCL pre-1.1 on Mac OS X
 - Validate OpenMCL 1.1 and/or 64-bit on Mac OS X?
   - 64-bit lisp verification
 - Verify db_deadlock for other lisps (launch and kill background program I/F)
 
-TASKS TO GET TO FINAL RELEASE:
-
 Bugs:
 - Fix any bugs found during BETA
 



From ieslick at common-lisp.net  Thu Mar 22 19:46:17 2007
From: ieslick at common-lisp.net (ieslick)
Date: Thu, 22 Mar 2007 14:46:17 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070322194617.E4FDD37058@common-lisp.net>

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

Modified Files:
	collections.lisp 
Log Message:
Henrik's re-fix to map-index for get-instances-by-value

--- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/21 14:29:30	1.15
+++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/22 19:46:17	1.16
@@ -343,12 +343,18 @@
 	   (funcall fn k v))))))
 
 (defun lisp-compare<= (a b)
+  (assert (eq (type-of a) (type-of b)))
   (etypecase a
     (number (<= a b))
     (string (string<= a b))
     (persistent (<= (oid a) (oid b)))))
 
-(defmethod map-index (fn (index btree-index) &rest args &key (start nil start-supplied-p) (end nil end-supplied-p))
+(defun lisp-compare-eq (a b)
+  (assert (eq (type-of a) (type-of b)))
+  (assert (member (type-of a) '(number string persistent null) :test #'subtypep))
+  (eq a b))
+
+(defmethod map-index (fn (index btree-index) &rest args &key start end)
   "Like map-btree, but takes a function of three arguments key, value and primary key
    if you want to get at the primary key value, otherwise use map-btree"
   (declare (dynamic-extent args)
@@ -359,8 +365,7 @@
 	(labels ((next-range ()
 		   (multiple-value-bind (exists? skey val pkey) (cursor-pnext-nodup cur)
 		     (if (and exists? 
-			      (or (not end-supplied-p)
-				  (null end)
+			      (or (null end)
 				  (lisp-compare<= skey end)))
 		       (progn
 			 (funcall fn skey val pkey)
@@ -377,12 +382,13 @@
 			   (next-range))))))
 	  (declare (dynamic-extent next-range next-in-range))
 	  (multiple-value-bind (exists? skey val pkey)
-	      (if (and start-supplied-p (not (null start)))
-		  (cursor-pset-range cur start)
-		  (cursor-pfirst cur))
+	      (cond ((lisp-compare-eq start end)
+		     (cursor-pset cur start))
+		    ((null start)
+		     (cursor-pfirst cur))
+		    (t (cursor-pset-range cur start)))
 	    (if (and exists? 
-		     (or (not end-supplied-p)
-			 (null end)
+		     (or (null end)
 			 (lisp-compare<= skey end)))
 		(progn
 		  (funcall fn skey val pkey)



From ieslick at common-lisp.net  Fri Mar 23 16:06:44 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 23 Mar 2007 11:06:44 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/db-clsql
Message-ID: <20070323160644.731AC67096@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src/db-clsql
In directory clnet:/tmp/cvs-serv15863

Modified Files:
	sql-controller.lisp 
Log Message:
Fixed CLSQL initialization error

--- /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp	2007/03/06 04:43:02	1.22
+++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp	2007/03/23 16:06:43	1.23
@@ -436,10 +436,7 @@
 (defmethod open-controller ((sc sql-store-controller)
 			    ;; At present these three have no meaning
 			    &key 
-			    (recover nil)
-			    (recover-fatal nil)
-			    (thread t))
-  (declare (ignore recover recover-fatal thread))
+			    &allow-other-keys)
   (insure-thread-table-lock)
   (the sql-store-controller
     (let* ((dbtype (car (second (controller-spec sc))))
@@ -448,8 +445,10 @@
 		      (not (probe-file path))))
 	   (con (clsql:connect (cdr (second (controller-spec sc)))
 			       :database-type dbtype
+			       :pool t
 			       :if-exists :old)))
-     (setf (slot-value sc 'dbcons) (make-hash-table :test 'equal))
+     (setf (controller-db-table sc) (make-hash-table :test 'equal))
+     (setf (gethash (thread-hash) (controller-db-table sc)) con)
 ;;      (setf (slot-value sc 'db) con)
       ;; Now we should make sure that the KEYVALUE table exists, and, if 
       ;; it does not, we need to create it..



From ieslick at common-lisp.net  Fri Mar 23 16:08:12 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 23 Mar 2007 11:08:12 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070323160812.062054B02C@common-lisp.net>

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

Modified Files:
	classindex.lisp controller.lisp metaclasses.lisp package.lisp 
Log Message:
Initial edits for new user manual

--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/21 14:29:30	1.30
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/23 16:08:10	1.31
@@ -384,10 +384,18 @@
 ;;   USER SET API 
 ;; =================
 
-(defgeneric get-instances-by-class (persistent-metaclass))
-(defgeneric get-instance-by-value (persistent-metaclass slot-name value))
-(defgeneric get-instances-by-value (persistent-metaclass slot-name value))
-(defgeneric get-instances-by-range (persistent-metaclass slot-name start end))
+(defgeneric get-instances-by-class (persistent-metaclass)
+  (:documentation "Retrieve all instances from the class index as a list of objects"))
+(defgeneric get-instance-by-value (persistent-metaclass slot-name value)
+  (:documentation "Retrieve instances from a slot index by value.  Will return only the first
+                  instance if there are duplicates."))
+(defgeneric get-instances-by-value (persistent-metaclass slot-name value)
+  (:documentation "Returns a list of all instances where the slot value is equal to value."))
+(defgeneric get-instances-by-range (persistent-metaclass slot-name start end)
+  (:documentation "Returns a list of all instances that match
+                   values between start and end.  An argument of
+                   nil to start or end indicates, respectively,
+                   the lowest or highest value in the index"))
 
 (defmethod get-instances-by-class ((class symbol))
   (get-instances-by-class (find-class class)))
--- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp	2007/02/26 19:12:18	1.39
+++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp	2007/03/23 16:08:10	1.40
@@ -434,7 +434,7 @@
   (get-value key (controller-root store-controller)))
 
 (defun root-existsp (key &key (store-controller *store-controller*))
-  "Get a something from the root."
+  "Test whether a key exists in the root"
   (declare (type store-controller store-controller))
   (if (existsp key (controller-root store-controller))
       t 
--- /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp	2007/03/21 14:29:30	1.12
+++ /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp	2007/03/23 16:08:10	1.13
@@ -43,6 +43,8 @@
 ;;
 
 (defmacro defpclass (cname parents slot-defs &rest class-opts)
+  "Shorthand for defining persistent objects.  Wraps the main
+   class definition with persistent-metaclass"
   `(defclass ,cname ,parents
      ,slot-defs
      ,@(add-persistent-metaclass-argument class-opts)))
--- /project/elephant/cvsroot/elephant/src/elephant/package.lisp	2007/03/19 19:41:35	1.24
+++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp	2007/03/23 16:08:10	1.25
@@ -32,10 +32,10 @@
 	   #:store-controller #:controller-root #:controller-class-root
 	   #:open-store #:close-store #:with-open-store
 	   #:add-to-root #:get-from-root #:remove-from-root #:root-existsp
-	   #:get-cached-instance #:flush-instance-cache
+	   #:map-root #:get-cached-instance #:flush-instance-cache
 	   #:controller-symbol-cache #:controller-symbol-id-cache
 	   #:controller-fast-symbols-p
-	   #:optimize-layout
+	   #:optimize-layout #:drop-pobject
 	   #:get-user-configuration-parameter
 	   #:database-version
 
@@ -51,7 +51,7 @@
 	   #:initialize-serializer
 
 	   #:with-transaction #:ensure-transaction
- 	   #:start-ele-transaction #:commit-transaction #:abort-transaction 
+ 	   #:start-ele-transaction #:commit-transaction #:abort-transaction
 
  	   #:persistent #:persistent-object #:persistent-metaclass
 	   #:persistent-collection #:defpclass



From ieslick at common-lisp.net  Fri Mar 23 16:10:44 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 23 Mar 2007 11:10:44 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070323161044.0922C1E07D@common-lisp.net>

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

Modified Files:
	collections.lisp 
Log Message:
Fix for map-indexed-index bug - I was too aggressive on error checks

--- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/22 19:46:17	1.16
+++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/23 16:10:42	1.17
@@ -350,8 +350,6 @@
     (persistent (<= (oid a) (oid b)))))
 
 (defun lisp-compare-eq (a b)
-  (assert (eq (type-of a) (type-of b)))
-  (assert (member (type-of a) '(number string persistent null) :test #'subtypep))
   (eq a b))
 
 (defmethod map-index (fn (index btree-index) &rest args &key start end)



From ieslick at common-lisp.net  Fri Mar 23 16:18:59 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 23 Mar 2007 11:18:59 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070323161859.C42633201A@common-lisp.net>

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

Modified Files:
	collections.lisp 
Log Message:
Doesn't work for different numeric types

--- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/23 16:10:42	1.17
+++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/23 16:18:59	1.18
@@ -343,7 +343,6 @@
 	   (funcall fn k v))))))
 
 (defun lisp-compare<= (a b)
-  (assert (eq (type-of a) (type-of b)))
   (etypecase a
     (number (<= a b))
     (string (string<= a b))



From ieslick at common-lisp.net  Fri Mar 23 16:31:53 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 23 Mar 2007 11:31:53 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070323163153.20D61431BF@common-lisp.net>

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

Modified Files:
	ele-clsql.asd 
Log Message:
Removed legacy path computations for clsql

--- /project/elephant/cvsroot/elephant/ele-clsql.asd	2007/02/07 22:54:12	1.9
+++ /project/elephant/cvsroot/elephant/ele-clsql.asd	2007/03/23 16:31:52	1.10
@@ -27,18 +27,18 @@
 ;;    (clsql:push-library-path *elephant-lib-path*)
 ;; )
 
-(defparameter *clsql-foreign-lib-path* #p"/usr/lib")
-(defparameter *elephant-lib-path* #p"/usr/local/share/common-lisp/elephant/")
+;;(defparameter *clsql-foreign-lib-path* #p"/usr/lib")
+;;(defparameter *elephant-lib-path* #p"/usr/local/share/common-lisp/elephant/")
 
-(defmethod asdf:perform :after ((o asdf:load-op) 
-				(c (eql (asdf:find-system 'clsql))))
-  (let ((plp (find-symbol (symbol-name '#:push-library-path)
-			(find-package 'clsql))))
-  (funcall plp
-	   *clsql-foreign-lib-path*)
-  (funcall plp
-	   *elephant-lib-path*)
-))
+;;(defmethod asdf:perform :after ((o asdf:load-op) 
+;				(c (eql (asdf:find-system 'clsql))))
+;;  (let ((plp (find-symbol (symbol-name '#:push-library-path)
+;;			  (find-package 'clsql))))
+;;  (funcall plp
+;;	   *clsql-foreign-lib-path*)
+;;  (funcall plp
+;;	   *elephant-lib-path*)
+;;))
 
 (defsystem ele-clsql
   :name "elephant"



From ieslick at common-lisp.net  Sat Mar 24 03:03:00 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 23 Mar 2007 22:03:00 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070324030300.9A6C33406A@common-lisp.net>

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

Modified Files:
	controller.lisp 
Log Message:
Reduce typing for store controller keyword

--- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp	2007/03/23 16:08:10	1.40
+++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp	2007/03/24 03:03:00	1.41
@@ -420,34 +420,34 @@
 ; Operations on the root index
 ;;
 
-(defun add-to-root (key value &key (store-controller *store-controller*))
+(defun add-to-root (key value &key (sc *store-controller*))
   "Add an arbitrary persistent thing to the root, so you can
 retrieve it in a later session.  N.B. this means it (and
 everything it points to) won't get gc'd."
   (declare (type store-controller store-controller))
   (assert (not (eq key *elephant-properties-label*)))
-  (setf (get-value key (controller-root store-controller)) value))
+  (setf (get-value key (controller-root sc)) value))
 
-(defun get-from-root (key &key (store-controller *store-controller*))
+(defun get-from-root (key &key (sc *store-controller*))
   "Get a something from the root."
-  (declare (type store-controller store-controller))
-  (get-value key (controller-root store-controller)))
+  (declare (type store-controller sc))
+  (get-value key (controller-root sc)))
 
-(defun root-existsp (key &key (store-controller *store-controller*))
+(defun root-existsp (key &key (sc *store-controller*))
   "Test whether a key exists in the root"
-  (declare (type store-controller store-controller))
-  (if (existsp key (controller-root store-controller))
+  (declare (type store-controller sc))
+  (if (existsp key (controller-root sc))
       t 
       nil))
 
-(defun remove-from-root (key &key (store-controller *store-controller*))
+(defun remove-from-root (key &key (sc *store-controller*))
   "Remove something from the root."
-  (declare (type store-controller store-controller))
-  (remove-kv key (controller-root store-controller)))
+  (declare (type store-controller sc))
+  (remove-kv key (controller-root sc)))
 
-(defun map-root (fn &key (store-controller *store-controller*))
+(defun map-root (fn &key (sc *store-controller*))
   "Map over all key-value pairs in the root"
-  (map-btree fn (controller-root store-controller)))
+  (map-btree fn (controller-root sc)))
 
 ;;
 ;; Explicit storage reclamation



From ieslick at common-lisp.net  Sat Mar 24 10:49:59 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 24 Mar 2007 05:49:59 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070324104959.930C8751A6@common-lisp.net>

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

Modified Files:
	migrate.lisp 
Log Message:
Fix for add-to-root, etc api change

--- /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp	2007/03/11 05:45:14	1.12
+++ /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp	2007/03/24 10:49:59	1.13
@@ -125,7 +125,7 @@
 	       (let ((newval (migrate dst value)))
 		 (unless (eq key *elephant-properties-label*)
 		   (ensure-transaction (:store-controller dst :txn-nosync t)
-		     (add-to-root key newval :store-controller dst)))))
+		     (add-to-root key newval :sc dst)))))
 	     (controller-root src))
   dst)
 



From ieslick at common-lisp.net  Sat Mar 24 10:51:45 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 24 Mar 2007 05:51:45 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20070324105145.8559254166@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv20292

Modified Files:
	testmigration.lisp 
Log Message:
Fix for add-to-root, etc api change

--- /project/elephant/cvsroot/elephant/tests/testmigration.lisp	2007/03/18 20:47:28	1.19
+++ /project/elephant/cvsroot/elephant/tests/testmigration.lisp	2007/03/24 10:51:45	1.20
@@ -43,10 +43,10 @@
 		       (disable-class-indexing x :sc sc1))
 		     '(idx-two idx-three idx-four idx-five idx-six idx-seven idx-eight
 		       idx-five-del stress-index idx-unbound-del))
-	     (add-to-root "x" "y" :store-controller sc1)
+	     (add-to-root "x" "y" :sc sc1)
 	     (migrate sc2 sc1)
-	     (equal (get-from-root "x" :store-controller sc1)
-		    (get-from-root "x" :store-controller sc2)))
+	     (equal (get-from-root "x" :sc sc1)
+		    (get-from-root "x" :sc sc2)))
 	(close-store sc1)
 	(close-store sc2))))
   t)



From ieslick at common-lisp.net  Sat Mar 24 12:16:02 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 24 Mar 2007 07:16:02 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070324121602.9F8284B021@common-lisp.net>

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

Modified Files:
	TODO config.sexp ele-bdb.asd 
Log Message:
Cleanup indexing tests so we always have a clean slate

--- /project/elephant/cvsroot/elephant/TODO	2007/03/21 15:04:59	1.74
+++ /project/elephant/cvsroot/elephant/TODO	2007/03/24 12:16:02	1.75
@@ -30,8 +30,11 @@
 - Class / DB sychronization tests
 
 Documentation:
-- License and copyright file headers
-- Add document section about backend interface & developer decisions
+~ License and copyright file headers
+- Redo tutorial
+- Proper user guide
+- Update install, build and test procedures
+- Upgrade, migration and other system level issues
 - Performance and design issues
   - More notes about transaction performance
   - Serious discussion of threading implications
@@ -39,7 +42,7 @@
   - Add notes about optimize-storage
   - Add notes about deadlock-detect
   - Add notes about checkpoint (null in SQL?)
-- Upgrade, migration and other system level issues
+- Add document section about backend interface & developer decisions
 
 0.6.1 - Features COMPLETED to date
 ----------------------------------
--- /project/elephant/cvsroot/elephant/config.sexp	2007/03/19 20:35:30	1.8
+++ /project/elephant/cvsroot/elephant/config.sexp	2007/03/24 12:16:02	1.9
@@ -25,10 +25,10 @@
  (:compiler . :gcc))
 
 #+(or mswindows windows)
-((:berkeley-db-include-dir . "C:/Programme/Oracle/Berkeley DB 4.5.20/include/")
- (:berkeley-db-lib-dir . "C:/Programme/Oracle/Berkeley DB 4.5.20/bin/")
- (:berkeley-db-lib . "C:/Programme/Oracle/Berkeley DB 4.5.20/bin/libdb45.dll")
- (:berkeley-db-deadlock . "C:/Programme/Oracle/Berkeley DB 4.5.20/bin/db_deadlock.exe")
+((:berkeley-db-include-dir . "C:/Program Files/Oracle/Berkeley DB 4.5.20/include/")
+ (:berkeley-db-lib-dir . "C:/Program Files/Oracle/Berkeley DB 4.5.20/bin/")
+ (:berkeley-db-lib . "C:/Program Files/Oracle/Berkeley DB 4.5.20/bin/libdb45.dll")
+ (:berkeley-db-deadlock . "C:/Program Files/Oracle/Berkeley DB 4.5.20/bin/db_deadlock.exe")
  (:pthread-lib . nil)
  (:clsql-lib . nil)
  (:compiler . :cygwin))
--- /project/elephant/cvsroot/elephant/ele-bdb.asd	2007/03/20 02:00:07	1.24
+++ /project/elephant/cvsroot/elephant/ele-bdb.asd	2007/03/24 12:16:02	1.25
@@ -37,6 +37,7 @@
          (drive-letter (char result (1- colon-pos))))
     (setf (char result (1- colon-pos)) #\/)
     (setf (char result colon-pos) drive-letter)
+    (setf result (concatenate 'string "/cygdrive" result))
     (substitute #\/ #\\ result)))
 
 (defclass bdb-c-source (elephant-c-source) ())



From ieslick at common-lisp.net  Sat Mar 24 12:16:03 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 24 Mar 2007 07:16:03 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/doc
Message-ID: <20070324121603.063EA4D042@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/doc
In directory clnet:/tmp/cvs-serv6422/doc

Modified Files:
	Makefile copying.texinfo elephant.texinfo installation.texinfo 
	intro.texinfo make-ref.lisp package-elephant.texinfo 
	reference.texinfo tutorial.texinfo 
Log Message:
Cleanup indexing tests so we always have a clean slate

--- /project/elephant/cvsroot/elephant/doc/Makefile	2005/11/23 17:51:34	1.2
+++ /project/elephant/cvsroot/elephant/doc/Makefile	2007/03/24 12:16:02	1.3
@@ -5,4 +5,4 @@
 	makeinfo -v --html --force elephant.texinfo
 
 includes-stuff: 
-	cd includes; lisp < ../make-ref.lisp
+	cd includes; sbcl  < ../make-ref.lisp
--- /project/elephant/cvsroot/elephant/doc/copying.texinfo	2006/03/02 14:44:49	1.2
+++ /project/elephant/cvsroot/elephant/doc/copying.texinfo	2007/03/24 12:16:02	1.3
@@ -15,15 +15,13 @@
 as governed by the terms of the Lisp Lesser GNU Public License
 @uref{http://opensource.franz.com/preamble.html}, also known as the LLGPL.
 
-
-
 Copyrights include: 
 
 Copyright (c) 2004 by Andrew Blumberg and Ben Lee
 
-Copyright (c) 2006 by Ian Eslick
+Copyright (c) 2006-2007 by Ian Eslick
 
-Copyright (c) 2005,2006 by Robert L. Read
+Copyright (c) 2005-2007 by Robert L. Read
 
 
 Portions of this program (namely the C unicode string
--- /project/elephant/cvsroot/elephant/doc/elephant.texinfo	2006/03/02 14:44:49	1.4
+++ /project/elephant/cvsroot/elephant/doc/elephant.texinfo	2007/03/24 12:16:02	1.5
@@ -6,7 +6,7 @@
      
 @copying
 Copyright @copyright{} 2004 Ben Lee and Andrew Blumberg.
-Copyright @copyright{} 2006 Robert L. Read.
+Copyright @copyright{} 2006-2007 Robert L. Read and Ian Eslick
 
 @quotation
 Permission is granted to copy, distribute and/or modify this document
@@ -19,8 +19,8 @@
      
 @titlepage
 @title Elephant User Manual
- at subtitle Elephant version 0.6
- at author Ben Lee
+ at subtitle Elephant version 0.6.1
+ at author Ben Lee and Ian Eslick
      
 @c  The following two commands
 @c  start the copyright page.
@@ -29,24 +29,35 @@
 @insertcopying
 @end titlepage
      
- at c So the toc is printed at the start.
- at contents
-     
 @ifnottex
 @node Top
 @comment  node-name,  next,  previous,  up
- at top Elephant
+ at top Copyright
      
 @insertcopying
 @end ifnottex
      
 @menu
-* Introduction:: Introducing Elephant!
-* Tutorial::     A leisurely walk-through.
-* Reference::    API documentation.
-* Installation:: Installation and test-suite procedures and issues
-* Design Notes:: Internals.
-* Copying::      Your rights and freedoms.
+* Table of Contents::
+ at end menu
+
+ at chapheading Chapters
+
+ at menu
+* Introduction::   Introduction to the Elephant Persistent Object System.
+* Tutorial::       A basic ``getting started'' tutorial.
+* Installation::   Installation and test-suite procedures.
+* User Guide::     In depth discussion of all Elephant facilities and features.
+* Usage scenarios::    Design scenarios for Elephant applications.
+* User API Reference:: Function and class documentation of the user API.
+* Elephant Design::    An overview of elephant's internal architecture.
+* Data Store API Reference::  Function level documentation for data store implementors.
+* Copying::        Your rights and freedoms.
+ at end menu
+
+ at chapheading Appendices
+
+ at menu
 * Concept Index::
 * Object Index::     
 * Function / Macro Index::     
@@ -54,11 +65,18 @@
 * Colophon::     
 @end menu
 
+ at node Table of Contents
+ at comment  node-name,  next,  previous,  up
+ at contents 
+     
 @include intro.texinfo
 @include tutorial.texinfo
- at include reference.texinfo
- at include notes.texinfo
 @include installation.texinfo
+ at include user-guide.texinfo
+ at include scenarios.texinfo
+ at include reference.texinfo
+ at include elephant-design.texinfo
+ at include data-store-reference.texinfo
 @include copying.texinfo
 
 @node Concept Index
--- /project/elephant/cvsroot/elephant/doc/installation.texinfo	2006/05/15 13:02:26	1.3
+++ /project/elephant/cvsroot/elephant/doc/installation.texinfo	2007/03/24 12:16:02	1.4
@@ -8,10 +8,11 @@
 @menu
 * Installation Basics:: Basic installation
 * Test-Suites:: Running the test suites
-* SQL-Introduction:: The design and status of the SQL back-end extention.
-* Extension Status:: The current status of the SQL back-end extention.
-* Multi-repository Operation:: Specifying repositories
-* Setting up PostGres:: An example
+* Berkeley DB Introduction:: The Berkeley DB backend
+* SQL Data Store:: The design and status of the SQL back-end extension.
+* Lisp Data Store:: A native lisp-based repository.
+* Multi-repository Operation:: Specifying repositories.
+* Setting up PostGres:: An example.
 @end menu
 
 @node Installation Basics 
@@ -148,11 +149,14 @@
 If you get errors, you may wish to report it the 
 @code{ elephant-devel at common-lisp.net} email list.
 
+ at node Berkeley DB Repository
+ at comment node-name, next, previous, up
+ at section Berkeley DB Repository
 
 
- at node SQL-Introduction
+ at node SQL Repository
 @comment node-name, next, previous, up
- at section SQL-Introduction
+ at section SQL Repository
 
 Although originally designed as an interface to the BerkeleyDB system,
 the original Elephant system has been experimenetally extended to 
--- /project/elephant/cvsroot/elephant/doc/intro.texinfo	2006/04/26 17:53:43	1.4
+++ /project/elephant/cvsroot/elephant/doc/intro.texinfo	2007/03/24 12:16:02	1.5
@@ -5,66 +5,96 @@
 @chapter Introduction
 @cindex Introduction
 
-Elephant is a persistent object database for Common Lisp that 
-supports storing CLOS objects and most lisp primitives.
-It supports persistent collections via a BTree interface.
-
-Elephant was originally developed as an interface layer on top 
-of the Sleepycat / Berkeley DB library, a widely-distributed 
-embedded database.  Many unix systems have it installed by default.  
-Berkeley DB is ACID compliant, transactional, process and 
-thread safe, and fast relative to relational databases.  Recently,
-Elephant was extended to provide support for relational database backends.
-It has been tested with Postgres and SQLite 3.  It supports, with some
-care, simultaneous multi-repository operation and enables convenient 
-migration of data between repositories.
+Elephant is a persistent object protocol and database for Common
+Lisp. The persistent protocol component of elephant overrides class
+creation and standard slot accesses using the Meta-Object Protocol
+(MOP) to render slot values persistent. Database functionality
+includes the ability to persistently index and retrieve ordered sets
+of class instances and ordinary lisp values.  Elephant has an
+extensive test suite and the core functionality is becoming quite
+mature.
+
+The Elephant code base is available under the LLGPL license. Data
+stores each come with their own, separate license and you will have to
+evaluate the implications of using them yourself.
+
+ at section History
+
+Elephant was originally envisioned as a lightweight interface layer on
+top of the Berkeley DB library, a widely-distributed embedded database
+that many unix systems have installed by default.  Berkeley DB is ACID
+compliant, transactional, process and thread safe, and fast relative
+to relational databases.
+
+Elephant has been extended to provide support for multiple backends,
+specifically a relational database backend based on CL-SQL which has
+been tested with Postgres and SQLite 3.  It supports, with some care,
+multi-repository operation and enables convenient migration of data
+between repositories.
 
 The support for relational backends and migration to the LLGPL was to 
 allow for broader use of Elephant in both not-for-profit and commercial
-settings. 
+settings.  Several additional backends are planned for future releases
+including a native Lisp implementation released under the LLGPL.
 
-Elephant goals:
+Elephant's current development focus is to enhance the feature set
+including a native lisp backend, a simple query language, and flexible
+persistence models that selectively break one or more of the ACID
+constraints to improve performance.
+
+ at section Elephant Goals
 
 @itemize
- at item Transparency: most Lisp values are easy to persist without
-signifcant effort or special syntax.  Talk to the DB entirely from Lisp;
-not requirement for domain-specific languages (such as SQL) to access persistent
-resources.  Enable interactive control of the database with no external 
-server dependencies.
-
- at item Safety: ACID, transactions. Concurrent with good multi-user and 
-multi-threaded semantics, isolation, locking and deadlock detection.
-(Deadlock detection does require an external process to be launched)
+ at item @strong{Transparency:} most Lisp values are easy to persist without
+significant effort or special syntax.  You can interact with the DB
+entirely from Lisp.  There is no requirement to use domain-specific
+languages, such as SQL, to access persistent resources.  Elephant
+loads via ASDF and requires no external server (except for some SQL
+backends like Postgres).
 
- at item Simplicity: a small library with few surprises for the
+ at item @strong{Simplicity:} a small library with few surprises for the
 programmer. Lisp and Berkeley DB together are an excellent substrate;
-Elephant tries to leverage their features as much as possible.  
-Support for multiple backends should be load-time options and mostly
+Elephant tries to leverage their features as much as possible.
+Support for additional backends are load-time options and more or less
 transparent to the user.
 
- at item Performance: leverage Sleepycat performance and
+ at item @strong{Safety:} ACID, transactions. Concurrent with good multi-user (BDB) and 
+multi-threaded semantics (BDB/SQL), isolation, locking and deadlock
+detection.  (Deadlock detection does require an external process to be
+launched for Berkeley DB)
+
+ at item @strong{Performance:} leverage Berkeley DB performance and/or Relational database
 reliability.  In addition to fast concurrent / transactional modes,
-elephant will (eventually) offer an accellerated single-user as
-well as in-memory modes that should be comparable to prevalence 
-style solutions, but leverage a common interface.  
+elephant will (eventually) offer an accelerated single-user as well as
+pure in-memory mode that should be comparable to prevalence style
+solutions, but employ a common programmer interface.
 
- at item Historical continuity: Elephant does not try to innovate
+ at item @strong{Historical continuity:} Elephant does not try to innovate
 significantly over prior Lisp persistent object stores such as
 AllegroStore (also based on Berkeley DB), the new AllegroCache,
 the Symbolics system Statice and PLOB.  Anyone familiar with
 those systems will recognize the Elephant interface.
 
- at item License Flexibility: Elephant is released under the LLGPL.
+ at item @strong{License Flexibility:} Elephant is released under the LLGPL.
 Because it supports multiple implementation of the backend, one
 can choose a backend with licensing and other features appropriate 
 to your needs.
 
 @end itemize
 
-Join the Elephant mailing lists to ask your questions and
-receive updates.  Pointers can be found on the Elephant website at
+ at section More Information
+
+Join the Elephant mailing lists to ask your questions and receive
+updates.  You can also review archives for past discussions and
+questions.  Pointers can be found on the Elephant website at
 
 @uref{http://www.common-lisp.net/project/elephant}.
 
-Installation documents can be found in the file @file{INSTALL}.
-Opportunities to contribute can be found in the file @file{TODO}.
+Installation instructions can be found in the @ref{Installation}
+section.  Bugs can be reported via the Elephant Trac system at
+
+ at uref{http://trac.common-lisp.net/elephant/}.
+
+This also serves as a good starting point for finding out what new
+features or capabilities you can contribute to Elephant. The Trac
+system also contains a wiki with design discussions and a FAQ.
--- /project/elephant/cvsroot/elephant/doc/make-ref.lisp	2005/11/23 17:51:34	1.2
+++ /project/elephant/cvsroot/elephant/doc/make-ref.lisp	2007/03/24 12:16:02	1.3
@@ -1,10 +1,15 @@
 (require 'asdf)
-(require 'elephant)
-(load "../docstrings.lisp")
+(asdf:operate 'asdf:load-op 'elephant-tests)
+(sb-posix:chdir "/Users/eslick/Work/fsrc/elephant-cvs/doc/includes/")
+(load "/Users/eslick/Work/fsrc/elephant-cvs/doc/docstrings.lisp")
 
 (defun make-docs ()
 ;;  (when (check-complete)
   (when t
-    (sb-texinfo:generate-includes #p"includes" (find-package :ele))))
+    (elephant:open-store elephant-tests::*testbdb-spec*)
+    (make-instance 'elephant::persistent-collection)
+    (make-instance 'elephant::secondary-cursor)
+    (make-instance 'elephant::indexed-btree)
+    (sb-texinfo:generate-includes #p"/Users/eslick/Work/fsrc/elephant-cvs/doc/includes/" (find-package :elephant) (find-package :elephant-backend) (find-package 'elephant-memutil) (find-package 'elephant-system))))
 
 (make-docs)
--- /project/elephant/cvsroot/elephant/doc/package-elephant.texinfo	2004/09/19 17:44:42	1.1
+++ /project/elephant/cvsroot/elephant/doc/package-elephant.texinfo	2007/03/24 12:16:02	1.2
@@ -1,6 +1,5 @@
 @anchor{Package elephant}
 @defvr {Package} elephant
-Elephant: an object-oriented database for Common Lisp.
-Uses the @code{sleepycat} package to talk to Berkeley @code{db} /
-Sleepycat.
+Elephant: an object-oriented database for Common Lisp with
+    multiple backends for Berkeley @code{db}, @code{sql} and others.
 @end defvr
--- /project/elephant/cvsroot/elephant/doc/reference.texinfo	2006/05/15 13:02:26	1.5
+++ /project/elephant/cvsroot/elephant/doc/reference.texinfo	2007/03/24 12:16:02	1.6
@@ -1,52 +1,42 @@
 @c -*-texinfo-*-
 
- at node Reference
+ at node User API Reference
 @comment node-name, next, previous, up
- at chapter Reference
- at cindex Reference
+ at chapter User API Reference
+ at cindex User API Reference
 @cindex API Reference
 
 @menu
-* Controller:: The connection to Sleepycat.
-* Transactions:: Transactions.
-* Persistent Objects:: CLOS persistence.
-* Persistent Slot Indexing:: Convenient indexing.
+* Store Controllers:: Connecting to a data store.
+* Persistent Objects:: Creating and using persistent objects.
+* Persistent Object Indexing:: Convenient indexing.
+* Query Interfaces:: Finding instances.
 * Collections:: BTrees and indices.
 * Cursors:: Traversing BTrees.
-* Sleepycat:: Some functions from the low-level Sleepycat interface.
+* Transactions:: Transactions.
+* Multithreading:: Multithreading.
+* Migration and Upgrading:: Migration and upgrading.
 @end menu
 
- at node Controller
+ at node Store Controllers
 @comment node-name, next, previous, up
- at section Controller
- at cindex Controller
+ at section Store Controllers
+ at cindex Store Controllers
+
+Store controllers provide the persistent storage for CLOS objects and BTree collections.  Any persistent operations must be done in the context of a store controller.
+
+ at include includes/class-elephant-store-controller.texinfo
+ at include includes/var-elephant-star-store-controller-star.texinfo
 
 @include includes/fun-elephant-open-store.texinfo
 @include includes/fun-elephant-close-store.texinfo
 @include includes/macro-elephant-with-open-store.texinfo
 
- at include includes/fun-elephant-add-to-root.texinfo
 @include includes/fun-elephant-get-from-root.texinfo
- at include includes/fun-elephant-run-elephant-thread.texinfo
-
- at include includes/var-elephant-star-store-controller-star.texinfo
- at include includes/class-elephant-store-controller.texinfo
- at include includes/fun-elephant-open-controller.texinfo
- at include includes/fun-elephant-close-controller.texinfo
- at include includes/macro-elephant-with-open-controller.texinfo
-
- at node Transactions
- at comment node-name, next, previous, up
- at section Transactions
- at cindex Transactions
-
- at include includes/macro-elephant-with-transaction.texinfo
-
- at include includes/var-elephant-star-auto-commit-star.texinfo
- at include includes/var-elephant-star-current-transaction-star.texinfo
- at include includes/fun-elephant-start-ele-transaction.texinfo
- at include includes/fun-elephant-commit-transaction.texinfo
- at include includes/fun-elephant-abort-transaction.texinfo
+ at include includes/fun-elephant-add-to-root.texinfo
+ at include includes/fun-elephant-remove-from-root.texinfo
+ at include includes/fun-elephant-root-existsp.texinfo
+ at include includes/fun-elephant-map-root.texinfo
 
 @node Persistent Objects
 @comment node-name, next, previous, up
@@ -57,10 +47,14 @@
 @include includes/class-elephant-persistent.texinfo
 @include includes/class-elephant-persistent-object.texinfo
 
- at node Persistent Slot Indexing
+ at include includes/macro-elephant-defpclass.texinfo
+
+ at include includes/fun-elephant-drop-pobject.texinfo
+
+ at node Persistent Object Indexing
 @comment node-name, next, previous, up
- at section Persistent Slot Indexing
- at cindex Persistent Slot Indexing
+ at section Persistent Object Indexing
+ at cindex Persistent Object Indexing
 
 @include includes/fun-get-instances-by-class.texinfo
 @include includes/fun-get-instance-by-value.texinfo
@@ -74,6 +68,11 @@
 @include includes/fun-add-class-derived-index.texinfo
 @include includes/fun-remove-class-derived-index.texinfo
 
+ at node Query Interfaces
+ at comment node-name, next, previous, up
+ at section Query Interfaces
+ at cindex Query Interfaces
+
 @node Collections
 @comment node-name, next, previous, up
 @section Collections
@@ -133,24 +132,25 @@
 @include includes/fun-elephant-cursor-set-range.texinfo
 @include includes/fun-elephant-cursor-set.texinfo
 
- at node Sleepycat
+ at node Transactions
 @comment node-name, next, previous, up
- at section Sleepycat
- at cindex Sleepycat
+ at section Transactions
+ at cindex Transactions
 
- at include includes/macro-elephant-with-lock.texinfo
- at include includes/fun-elephant-db-env-get-flags.texinfo
- at include includes/fun-elephant-db-env-get-lock-detect.texinfo
- at include includes/fun-elephant-db-env-get-timeout.texinfo
- at include includes/fun-elephant-db-env-lock-get.texinfo
- at include includes/fun-elephant-db-env-lock-id-free.texinfo
- at include includes/fun-elephant-db-env-lock-id.texinfo
- at include includes/fun-elephant-db-env-lock-put.texinfo
- at include includes/fun-elephant-db-env-set-flags.texinfo
- at include includes/fun-elephant-db-env-set-lock-detect.texinfo
- at include includes/fun-elephant-db-env-set-timeout.texinfo
- at include includes/fun-elephant-db-transaction-abort.texinfo
- at include includes/fun-elephant-db-transaction-begin.texinfo
- at include includes/fun-elephant-db-transaction-commit.texinfo
- at include includes/fun-elephant-db-transaction-id.texinfo
+ at include includes/macro-elephant-with-transaction.texinfo
+
+ at include includes/var-elephant-star-auto-commit-star.texinfo
+ at include includes/var-elephant-star-current-transaction-star.texinfo
+ at include includes/fun-elephant-start-ele-transaction.texinfo
+ at include includes/fun-elephant-commit-transaction.texinfo
+ at include includes/fun-elephant-abort-transaction.texinfo
 
+ at node Multithreading
+ at comment node-name, next, previous, up
+ at section Multithreading
+ at cindex Multithreading
+
+ at node Migration and Upgrading
+ at comment node-name, next, previous, up
+ at section Migration and Upgrading
+ at cindex Migration and Upgrading
--- /project/elephant/cvsroot/elephant/doc/tutorial.texinfo	2006/04/26 17:53:43	1.6
+++ /project/elephant/cvsroot/elephant/doc/tutorial.texinfo	2007/03/24 12:16:02	1.7
@@ -6,306 +6,348 @@
 @cindex Tutorial
 
 @menu
-* Preliminaries:: Some general remarks.
-* Getting Started:: Accessing a store.
-* Running the Tests:: Gaining confidence.
-* The Root:: Staying alive.
-* Serialization:: Lisp -> (char *).
-* Persistent Classes:: CLOS the Elephant way.
+* Overview:: Overview of elphant's features
+* Getting Started:: Opening and accessing a store.
+* The Store Root:: Accessing persistent data.
+* Serialization:: Storage semantics for lisp values.
+* Persistent Classes:: Persistent semantics for objects.
 * Rules about Persistent Classes:: What you need to know.
-* Using Transactions:: Using ACID.
-* Using BTrees:: Storing lots of things.
-* Using Cursors:: Tranversing BTrees.
-* Secondary Indices:: By any other name...
-* Class Indices:: Speed and Convenience.
-* The Store Controller:: Behind the curtain.
-* Repository Migration:: How to move objects from one repository to another
-* Threading:: Playing nice with others.
-* Performance Tips:: Bogoflops for your buck.
+* Persistent collections:: Keep track of collections of objects.
+* Class Indices:: Simple way to keep track of instances.
+* Using Transactions:: Enabling ACID database properties.
 @end menu
 
- at node Preliminaries
+ at node Overview
 @comment node-name, next, previous, up
- at section Preliminaries
+ at section Overview
 
-Elephant is a Common Lisp OODB.  It provides a partial solution to the 
-problem of making Lisp data persistent.  It does this through two mechanisms:
-a simple API for storing and retrieving lisp values from a persistent store, 
-and the ability to make CLOS class slot values be persistent.
-
-When someone says "database," most people think of SQL Relation Data Base 
-Management Systems (e.g. Oracle, Postgresql, MySql).  Elephant can use either 
-RDBMSs or Berkeley DB (Sleepycat) as a backend repository, but relies on 
-LISP as its data manipulation system.  Unlike systems such as Hibernate 
-for Java, the user does not need to construct or worry about a mapping 
-from the object space into the database.  Elephant is designed to be a 
-simple and convenient tool for the programmer.
-
-Elephant supports easy migration of data between different repositories and
-different backends, allowing the user to choose which repository backend they 
-will use at a particular point in time.
-
-Berkeley DB/Sleepycat is a database library that was the initial inspiration for Elephant's
-design and is well-matched to Elephant's data model.  BDB is implemented as a C library, 
-not a client/server model, so access can be very fast.  Berkeley DB is also quite mature, 
-robust and has many features, such as transactions and replication.  While we hope 
-that you won't need to understand a specific backend to use Elephant, reading the 
-docs will certainly help you when things go wrong.  For the Sleepycat backend, 
-they can be found at @uref{http://www.sleepycat.com}.
+Elephant is a Persistence Metaprotocol and Database for Common Lisp.
+It provides the ability for users to define and interact with
+persistent objects and to transparently store ordinary lisp values.
+Persistent objects are CLOS instances that overload the ordinary slot
+access semantics so that every write to a slot is passed through and
+written to disk.  Non-persistent lisp objects and values can be
+written to slots and will be automatically persisted.  In addition,
+Elephant provides a persistent index which maintains an ordered
+collection of lisp values or persistent object references.
+
+When someone says "database," most people think of SQL Relational Data
+Base Management Systems (e.g. Oracle, Postgresql, MySql).  Those
+systems store data in statically typed tables with unique shared
+values to connect rows in separate tables.  Objects can be mapped into
+these tables in an object-relational mapping that assigns objects to
+rows and slot values to columns in a row's table.  If a slot
+references another type of object, a unique ID can be used to
+reference that object's table.  CL-SQL, for example, provides
+facilities for this kind of object-relational mapping and there are
+many systems for other languages that do the same (i.e. Hibernate for
+Java).  
+
+While Elephant can use either RDBMSs or Berkeley DB as a data store,
+the model it supports is that of objects stored in persistent indices.
+Unlike systems such as Hibernate for Java, the user does not need to
+construct or worry about a mapping from the object space into the
+database.  Elephant relies on LISP rather than SQL for its data
+manipulation language.  Elephant is designed to be a simple and
+convenient tool for the programmer.
+
+Elephant consists of a small universe of basic concepts:
+
+ at itemize
+ at item @strong{Store controller:} the interface between lisp and a data store.  
+Most operations require or accept a store controller, or a default
+store controller stored in @code{*store-controller*} to function.
+ at item @strong{BTrees:} Elephant provides a persistent key-value 
+abstraction based on the BTree data structure.  Values can be written
+to or read from a BTree and are stored in a sorted order.  
+ at item @strong{Values:} most lisp values, including standard objects, arrays, etc
+can be used as either key or value in a persistent BTree.
+ at item @strong{Persistent objects:} An object where most slot values are stored in
+the data store and are written to or retrieved from disk on slot
+accesses.  Any value that can be written to an index can be written to
+a persistent slot.  
+ at item @strong{Transactions:} a dynamic context for executing operations on persistent
+objects or BTrees that ensures that a set of changes is made atomically.
+ at item @strong{BTree indices:} A BTree index is a BTree that stores 
+an alternative ordering of the elements in a reference BTree.
+ at end itemize
+
+There are a set of more advanced concepts you will learn about later,
+but these basic concepts will serve to acquaint you with Elephant.
+
+If you do not already have Elephant installed and building correctly,
+read the @ref{Installation} section of this manual and then move on to
+ at ref{Getting Started}.
 
-Elephant can also use RDBMS backends via the excellent CL-SQL package.  
-It has been tested with Postgres and SQLite3, and can probably easily work with others.
-
- at node Running the Tests
+ at node Getting Started
 @comment node-name, next, previous, up
- at section Running the Tests
-
-There are three files in the directory @code{tests} that make running 
-the automated tests particularly easy.  @code{BerkeleyDB-tests.lisp} is
-for running against the BerkeleyDB backend, and @code{SQLDB-tests.lisp} is
-for running agains the CL-SQL backend.  @code{MigrationTests.lisp} is
-for testing data migration functions, and can be used with either or both backends.
-
-The normal way to execute the tests, following the instruction in the file 
- at code{INSTALL}, is to open a listener and execute the lines found in 
-one of these files, such as:
- at lisp
-(asdf:operate 'asdf:load-op :elephant-tests)
+ at section Getting Started 
 
-(in-package "ELEPHANT-TESTS")
+The first step in using elephant is to open a store controller.  A
+store controller is an object that coordinates lisp program access
+to the chosen data store.
 
-(setf *default-spec* *testbdb-spec*)
+To obtain a store controller, you call @code{open-store} with a store
+specification.  A store specification is a list containing a backend
+specifier (@code{:BDB} or @code{:CLSQL}) and a backend-specific
+reference.
 
-(do-backend-tests)
- at end lisp
+For :BDB, the second element is a string or pathname that references a
+local directory for the database files.  This directory must be
+created prior to calling open-store.
 
-The SQL test file differs only in using a different ``controller spec'':
- at lisp(setf *default-spec* *testpg-spec*)
- at end lisp
-These default parameters are set in @file{tests/elephant-tests.lisp},
-they will looks something like this in a default distribution:
- at lisp
-(:BDB "/home/read/projects/sql-back-end/elephant/tests/testdb/")
- at end lisp
-and for postgres:
 @lisp
-(:CLSQL (:POSTGRESQL "localhost.localdomain" "test" "postgres" ""))
+(open-store '(:BDB ``/users/me/db/my-db/''))
 @end lisp
 
+For :CLSQL the second argument is another list consisting of a
+specific SQL database and the name of a database file or connection
+record to the SQL server.  Examples are:
 
- at node Getting Started
- at comment node-name, next, previous, up
- at section Getting Started 
-
-In order to use Elephant, you have to have an open store controller.
-To obtain an open store controller you call @code{open-store}
-
-The chapter ``SQL back-end'' has information about setting up a 
-SQL based backend; this tutorial will assume that you are using 
-Berkeley-DB as a backend.
-
-Make a directory to put your database store in.  (This is called the
-environment in Sleepycat terminology.)  That's all you need to set up
-your store!  We'll assume in this tutorial you created a folder
- at code{testdb} in the current directory.
-
-It is strongly recommended that you run the automated tests @xref{Running the Tests} that 
-come with Elephant before you begin this tutorial; this takes less
-than five minutes and if will give you both confidence and clarity
-and your continued work.  Since the default distribution comes
-with a directory structure set up, this is actually the easiest
-way to get started with Elephant before beginning this tutorial.
-If the tests fail for you, the Elephant developers will help you
-solve the problem, but will want to know the outcome of the tests
-as a starting point.
-
-If you have run the tests successfully, you can just do:
 @lisp
-(open-store *default-spec*)
+(open-store '(:CLSQL (:SQLITE "/users/me/db/sqlite.db")))
+(open-store '(:CLSQL (:POSTGRESQL "localhost.localdomain" "mydb" "myuser" ""))))
 @end lisp
-But if not you might have to set up your own controller specifier like this:
+
+We use Berkeley DB as our example backend.  To open a BDB
+store-controller we can do the following:
+
 @lisp
 (asdf:operate 'asdf:load-op :elephant)
-(use-package "ELE")
-(setf *testbdb-spec*
-'(:BDB "/home/read/projects/sql-back-end/elephant/tests/testdb/"))
-(open-store *testbdb-spec*)
- at end lisp
+(use-package :elephant)
+(setf *test-db-spec*
+      '(:BDB "/home/me/db/testdb/"))
+(open-store *test-db-spec*)
+ at end lisp
+
+We do not need to store the reference to the store just now as it is
+automatically assigned to the variable, @code{*store-controller*}.
+For a deeper discussion of store controller management see the
+ at ref{User Guide}.
+
+When you're done with your session, release the store-controller's
+resources by calling @code{close-store}.
+
+Also there is a convenience macro @code{with-open-store} that will
+open and close the store, but opening the store is an expensive
+operation so it is generally better to leave the store open until your
+application no longer needs it.
+
+ at node The Store Root
+ at comment node-name, next, previous, up
+ at section The Store Root
+
+What values live between lisp sessions is called @emph{liveness}.
+Liveness in a store is determined by whether the value can be reached
+from the root of the store.  The root is a special BTree in which
+other BTrees and lisp values can be stored.  This BTree has a special
+interface through the store controller.  (There is a second root BTree
+called the class root which will be discussed later.)
 
-When you're done with your session, don't forget to
+You can put something into the root object by
 
 @lisp
-* (close-store)
-=> NIL
+(add-to-root "my key" "my value")
+=> "my value"
 @end lisp
 
-Also there is a convenience macro @code{with-open-store}.
+and get things out via
 
- at node The Root
- at comment node-name, next, previous, up
- at section The Root
+ at lisp
+(get-from-root "my key")
+=> "my value"
+=> T
+ at end lisp
 
-Liveness in a store is determined by reachability from the root
-object.  Technically, liveness also applies to indexed
-classes, as described in @xref{Class Indices}, which live in a 
-separate class-root namespace.  When garbage collection is 
-implemented, dead objects will be collected on gc's.)  The root and
-class-root objects are BTrees, effectively a table with sorted keys
-and log(N) access time. @xref{Using BTrees}.
+The second value indicates whether the key was found.  This is
+important if your key-value pair can have nil as a value.  
 
-You can put something into the root object by
+You can perform other basic operations as well.
 
 @lisp
-* (add-to-root "my key" "my value")
+(root-existsp "my key")
+=> T
+(remove-from-root "my key")
+=> T
+(get-from-root "my key")
+=> NIL
 => NIL
 @end lisp
 
-and get things out via
+To access all the objects in the root, the simplest way is to 
+simply call @code{map-root} with a function to apply to each
+key-value pair.
 
 @lisp
-* (get-from-root "my key")
-=> "my value"
-=> T
- at end lisp
+(map-root 
+  (lambda (k v) 
+     (format t "key: ~A value:~A~%" k v)))
+ at end lisp            
 
-The root object is available as
+You can also access the root object directly.
 
 @lisp
-* (controller-root *store-controller*)
-=> #<BTREE @{492AE37D@}>
+(controller-root *store-controller*)
+=> #<DB-BDB::BDB-BTREE @ #x10e86042>
 @end lisp
 
-It is an instance of a class "btree"; @xref{Using BTrees}.
+It is an instance of a class "btree"; @pxref{Using BTrees}.
 
 @node Serialization
 @comment node-name, next, previous, up
 @section Serialization
 
-What can you put into the store?  An ever-growing list of things:
-numbers (except for complexes, which will be easy to support),
+What can you put into the store besides strings?  Almost all lisp
+values and objects can be stored: numbers (except for complexes),
 symbols, strings, nil, characters, pathnames, conses, hash-tables,
-arrays, CLOS objects.  Nested and circular things are allowed.  You
-can store basically anything except lambdas, closures, structures,
-packages and streams.  (These may eventually get supported too.)
-
-Unfortunately Berekely DB doesn't understand Lisp, so Lisp data needs
-to be serialized to enter the database (converted to byte arrays), and
-deserialized to be read.  This introduces some caveats (not unique to
-Elephant!):
+arrays, CLOS objects and structs.  Nested and circular things are
+allowed.  You can store basically anything except lambdas, closures,
+class objects, packages and streams.  (These may eventually get
+supported too.)
+
+Elephant needs to use a representation of data that is independant of
+a specific lisp or data store.  Therefore all lisp values that are
+stored must be @emph{serialized} into a canonical format.  Because
+Berkeley DB supports variable length binary buffers, Elephant uses a
+binary serialization system.  This process has some important
+consequences that it is very important to understand:
 
 @enumerate
- at item Lisp identity can't be preserved.  Since this is a store which
+ at item @strong{Lisp identity can't be preserved}.  Since this is a store which
 persists across invocations of Lisp, this probably doesn't even make
-sense.
+sense.  However if you get an object from the index, store it to a
+lisp variable, then get it again - they will not be eq:
 
 @lisp
-* (setq foo (cons nil nil))
+(setq foo (cons nil nil))
 => (NIL)
-* (add-to-root "my key" foo)
-=> NIL
-* (add-to-root "my other key" foo)
-=> NIL
-* (eq (get-from-root "my key")
+(add-to-root "my key" foo)
+=> (NIL)
+(add-to-root "my other key" foo)
+=> (NIL)
+(eq (get-from-root "my key")
       (get-from-root "my other key"))
 => NIL
 @end lisp
 
- at item Mutated substructure does not persist
+ at item @strong{Nested aggregates are stored in one buffer}.  
+If you store an set of objects in a hash table you try to store a hash
+table, all of those objects will get stored in one large binary buffer
+with the hash keys.  This is true for all other aggregates that can
+store type T (cons, array, standard object, etc).
+
+ at item @strong{Mutated substructure does not persist}.
 
 @lisp
-* (setf (car foo) T)
+(setf (car foo) T)
 => T
-* (get-from-root "my key")
+(get-from-root "my key")
 => (NIL)
 @end lisp
 
 This will affect all aggregate types: objects, conses, hash-tables, et
 cetera.  (You can of course manually re-store the cons.)  In this sense
 elephant does not automatically provide persistent collections.  If you 

[871 lines skipped]



From ieslick at common-lisp.net  Sat Mar 24 12:16:03 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 24 Mar 2007 07:16:03 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070324121603.4F04C4D042@common-lisp.net>

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

Modified Files:
	classes.lisp classindex.lisp 
Log Message:
Cleanup indexing tests so we always have a clean slate

--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/21 14:29:30	1.23
+++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/24 12:16:03	1.24
@@ -69,8 +69,9 @@
 				       never (eq (class-of superclass) persistent-metaclass))))
     (if (and (not (eq class persistent-object)) not-already-persistent)
 	(apply #'call-next-method class slot-names
-	       :direct-superclasses (cons persistent-object
-					  direct-superclasses) args)
+;;	       :direct-superclasses (cons persistent-object
+;;					  direct-superclasses) args)
+	       :direct-superclasses (append direct-superclasses (list persistent-object)) args)
 	(call-next-method))))
 
 (defmethod finalize-inheritance :around ((instance persistent-metaclass))
--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/23 16:08:10	1.31
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/24 12:16:03	1.32
@@ -232,34 +232,41 @@
   (let ((class-idx (find-class-index class :sc sc :errorp errorp)))
     (if class-idx 
 	(progn
-	  (wipe-class-indexing class class-idx :sc sc)
+	  (wipe-class-indexing class :sc sc)
 	  (update-indexed-record class nil))
 	(when errorp
 	  (error "No class index exists in persistent store ~A" sc)
 	  (return-from disable-class-indexing nil)))))
 
-(defmethod wipe-class-indexing ((class persistent-metaclass) class-idx &key (sc *store-controller*))
-  ;; Clear out the current class record
-  (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))
-    (map-indices (lambda (name secondary-index)
-		   (declare (ignore secondary-index))
-		   (push name names))
-		 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)
-  )
+(defmethod wipe-class-indexing ((class persistent-metaclass) &key (sc *store-controller*))
+  (wipe-class-indexing (class-name class) :sc sc))
+
+(defmethod wipe-class-indexing ((class-name symbol) &key (sc *store-controller*))
+  (let ((cindex (get-value class-name (controller-class-root sc)))
+	(class (find-class class-name nil)))
+    (when cindex
+      ;; Delete all the values
+      (with-transaction (:store-controller sc)
+	(with-btree-cursor (cur cindex)
+	  (loop while (cursor-next cur) do
+	       (cursor-delete cur))))
+      ;; Get the names of all indices & remove them 
+      (let ((names nil))
+	(map-indices (lambda (name secondary-index)
+		       (declare (ignore secondary-index))
+		       (push name names))
+		     cindex)
+	(dolist (name names)
+	  (when (member name (class-slots class))
+	    (if class 
+		(remove-class-slot-index class name)
+		(with-transaction (:store-controller sc)
+		  (remove-index cindex name))))))
+      ;; Drop the class instance index from the class root
+      (with-transaction (:store-controller sc)
+	(remove-kv class-name (controller-class-root sc)))
+      (when class
+	(setf (%index-cache 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))



From ieslick at common-lisp.net  Sat Mar 24 12:16:03 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 24 Mar 2007 07:16:03 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20070324121603.9200550034@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv6422/tests

Modified Files:
	testindexing.lisp 
Log Message:
Cleanup indexing tests so we always have a clean slate

--- /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2007/03/08 21:29:53	1.35
+++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2007/03/24 12:16:03	1.36
@@ -42,18 +42,22 @@
 
 (deftest indexing-basic-trivial
     (progn
-      (when (class-indexedp-by-name 'idx-one)
-	(disable-class-indexing 'idx-one  :errorp nil)
-	(setf (find-class 'idx-one) nil))
+      (defclass idx-one ()
+	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
+	(:metaclass persistent-metaclass))
+      (disable-class-indexing 'idx-one  :errorp nil)
+      (setf (find-class 'idx-one) nil)
       
       (defclass idx-one ()
 	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
 	(:metaclass persistent-metaclass))
+
       (defmethod print-object ((obj idx-one) stream)
 	(if (slot-boundp obj 'slot1)
 	    (format stream "slot1 = ~A~%" (slot1 obj))
 	    (format stream "slot1 unbound~&")
 	))
+
       (with-transaction (:store-controller *store-controller*)
 	(setq inst1 (make-instance 'idx-one :slot1 101 :sc *store-controller*))
 	(setq inst1 (make-instance 'idx-one :slot1 101 :sc *store-controller*))
@@ -73,9 +77,12 @@
       ;;(format t "Global vars:~%")
       ;;(format t "~%basic store: ~A  ~A~%" *store-controller* (elephant::controller-spec *store-controller*))
 
-      (when (class-indexedp-by-name 'idx-one)
-	(disable-class-indexing 'idx-one :errorp nil)
-	(setf (find-class 'idx-one nil) nil))
+      (defclass idx-one ()
+	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
+	(:metaclass persistent-metaclass))
+
+      (disable-class-indexing 'idx-one :errorp nil)
+      (setf (find-class 'idx-one nil) nil)
       
       (defclass idx-one ()
 	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
@@ -104,8 +111,12 @@
 
 (deftest indexing-class-opt
     (progn
-      (when (class-indexedp-by-name 'idx-cslot)
-	(disable-class-indexing 'idx-cslot :errorp nil))
+      (defclass idx-cslot ()
+	((slot1 :initarg :slot1 :initform 0 :accessor slot1))
+	(:metaclass persistent-metaclass) 
+	(:index t))
+
+      (disable-class-indexing 'idx-cslot :errorp nil)
       (setf (find-class 'idx-cslot) nil)
       
       (defclass idx-cslot ()
@@ -124,14 +135,6 @@
     (progn 
 ;;      (format t "inherit store: ~A  ~A~%" *store-controller* (controller-path *store-controller*))
 
-      (when (class-indexedp-by-name 'idx-two )
-	(disable-class-indexing 'idx-two :sc *store-controller* :errorp nil)
-	(setf (find-class 'idx-two) nil))
-
-      (when (class-indexedp-by-name 'idx-three )
-	(disable-class-indexing 'idx-three :sc *store-controller* :errorp nil)
-	(setf (find-class 'idx-three) nil))
-
       (defclass idx-two ()
 	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
 	 (slot2 :initarg :slot2 :initform 2 :accessor slot2 :index t)
@@ -145,6 +148,24 @@
 	 (slot4 :initarg :slot4 :initform 40 :accessor slot4 :index t))
 	(:metaclass persistent-metaclass))
 
+      (disable-class-indexing 'idx-two :sc *store-controller* :errorp nil)
+      (setf (find-class 'idx-two) nil)
+
+      (disable-class-indexing 'idx-three :sc *store-controller* :errorp nil)
+      (setf (find-class 'idx-three) nil)
+
+      (defclass idx-two ()
+	((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-three (idx-two)
+	((slot2 :initarg :slot2 :initform 20 :accessor slot2)
+	 (slot3 :initarg :slot3 :initform 30 :accessor slot3 :index t)
+	 (slot4 :initarg :slot4 :initform 40 :accessor slot4 :index t))
+	(:metaclass persistent-metaclass))
 
       (progn
 	(with-transaction ()
@@ -168,12 +189,13 @@
 (deftest indexing-range
     (progn
       ;;      (format t "range store: ~A  ~A~%" *store-controller* (controller-path *store-controller*))
-      (when (class-indexedp-by-name 'idx-four )
-	(defclass idx-four ()
-	  ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
-	  (:metaclass persistent-metaclass))
-	(disable-class-indexing 'idx-four :errorp nil)
-	(setf (find-class 'idx-four nil) nil))
+
+      (defclass idx-four ()
+	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
+	(:metaclass persistent-metaclass))
+
+      (disable-class-indexing 'idx-four :errorp nil)
+      (setf (find-class 'idx-four nil) nil)
 
 	(defclass idx-four ()
 	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
@@ -205,9 +227,13 @@
 
 (deftest indexing-slot-makunbound
     (progn
-      (when (class-indexedp-by-name 'idx-unbound-del)
-	(disable-class-indexing 'idx-unbound-del :errorp nil)
-	(setf (find-class 'idx-five-del) nil))
+
+      (defclass idx-unbound-del ()
+	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
+	(:metaclass persistent-metaclass))
+
+      (disable-class-indexing 'idx-unbound-del :errorp nil)
+      (setf (find-class 'idx-five-del) nil)
 
       (defclass idx-unbound-del ()
 	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
@@ -227,8 +253,12 @@
 
 (deftest indexing-wipe-index
     (progn 
-      (when (class-indexedp-by-name 'idx-five-del)
-	(disable-class-indexing 'idx-five-del :errorp nil))
+
+      (defclass idx-five-del ()
+	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
+	(:metaclass persistent-metaclass))
+
+      (disable-class-indexing 'idx-five-del :errorp nil)
       (setf (find-class 'idx-five-del) nil)
 
       (defclass idx-five-del ()
@@ -253,14 +283,15 @@
 
 (deftest indexing-reconnect-db
     (progn 
-      (when (class-indexedp-by-name 'idx-five)
-	(defclass idx-five ()
-	  ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
-	   (slot2 :initarg :slot2 :initform 2 :accessor slot2)
-	   (slot3 :initarg :slot3 :initform 3 :accessor slot3 :index t))
-	  (:metaclass persistent-metaclass))
-	(disable-class-indexing 'idx-five :errorp nil)
-	(setf (find-class 'idx-five) nil))
+
+      (defclass idx-five ()
+	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
+	 (slot2 :initarg :slot2 :initform 2 :accessor slot2)
+	 (slot3 :initarg :slot3 :initform 3 :accessor slot3 :index t))
+	(:metaclass persistent-metaclass))
+
+      (disable-class-indexing 'idx-five :errorp nil)
+      (setf (find-class 'idx-five) nil)
       
       (defclass idx-five ()
 	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
@@ -295,21 +326,22 @@
 (deftest indexing-change-class 
     (progn
 
-      (when (class-indexedp-by-name 'idx-six)
-	(defclass idx-six ()
-	  ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
-	   (slot2 :initarg :slot2 :initform 2 :accessor slot2 :index t))
-	  (:metaclass persistent-metaclass))
-	(disable-class-indexing 'idx-six :errorp nil)
-	(setf (find-class 'idx-six) nil))
-      (when (class-indexedp-by-name 'idx-seven)
-	(defclass idx-seven ()
-	  ((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))
-	(disable-class-indexing 'idx-seven :errorp nil)
-	(setf (find-class 'idx-seven) nil))
+      (defclass idx-six ()
+	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
+	 (slot2 :initarg :slot2 :initform 2 :accessor slot2 :index t))
+	(:metaclass persistent-metaclass))
+
+      (disable-class-indexing 'idx-six :errorp nil)
+      (setf (find-class 'idx-six) nil)
+
+      (defclass idx-seven ()
+	((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))
+
+      (disable-class-indexing 'idx-seven :errorp nil)
+      (setf (find-class 'idx-seven) nil)
 
       (defclass idx-six ()
 	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
@@ -350,16 +382,17 @@
 
 (deftest indexing-redef-class
     (progn
-      (when (class-indexedp-by-name 'idx-eight)
-	(defclass idx-eight ()
-	  ((slot1 :accessor slot1 :initarg :slot1 :index t)
-	   (slot2 :accessor slot2 :initarg :slot2)
-	   (slot3 :accessor slot3 :initarg :slot3 :transient t)
-	   (slot4 :accessor slot4 :initarg :slot4 :index t)
-	   (slot5 :accessor slot5 :initarg :slot5))
-	  (:metaclass persistent-metaclass))
-	(disable-class-indexing 'idx-eight :errorp nil)
-	(setf (find-class 'idx-eight nil) nil))
+
+      (defclass idx-eight ()
+	((slot1 :accessor slot1 :initarg :slot1 :index t)
+	 (slot2 :accessor slot2 :initarg :slot2)
+	 (slot3 :accessor slot3 :initarg :slot3 :transient t)
+	 (slot4 :accessor slot4 :initarg :slot4 :index t)
+	 (slot5 :accessor slot5 :initarg :slot5))
+	(:metaclass persistent-metaclass))
+      
+      (disable-class-indexing 'idx-eight :errorp nil)
+      (setf (find-class 'idx-eight nil) nil)
       ;;      (format t "sc: ~A  ct: ~A~%" *store-controller* *current-transaction*)
       (defclass idx-eight ()
 	((slot1 :accessor slot1 :initarg :slot1 :index t)
@@ -368,11 +401,13 @@
 	 (slot4 :accessor slot4 :initarg :slot4 :index t)
 	 (slot5 :accessor slot5 :initarg :slot5))
 	(:metaclass persistent-metaclass))
+
       (let ((o1 nil)
 	    (o2 nil))
 	(with-transaction ()
 	  (setf o1 (make-instance 'idx-eight :slot1 1 :slot2 2 :slot3 3 :slot4 4 :slot5 5))
 	  (setf o2 (make-instance 'idx-eight :slot1 10 :slot2 20 :slot3 30 :slot4 40 :slot5 50)))
+
 	(defclass idx-eight ()
 	  ((slot1 :accessor slot1 :initarg :slot1 :initform 11)
 	   (slot2 :accessor slot2 :initarg :slot2 :initform 12 :index t)



From ieslick at common-lisp.net  Sat Mar 24 13:55:15 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 24 Mar 2007 08:55:15 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/doc
Message-ID: <20070324135515.ECAF045082@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/doc
In directory clnet:/tmp/cvs-serv32267

Modified Files:
	Makefile make-ref.lisp 
Added Files:
	data-store-reference.texinfo elephant-design.texinfo 
	lisp-data-store.texinfo scenarios.texinfo style.css 
	user-guide.texinfo 
Removed Files:
	notes.texinfo 
Log Message:
First batch of edits for new user manual

--- /project/elephant/cvsroot/elephant/doc/Makefile	2007/03/24 12:16:02	1.3
+++ /project/elephant/cvsroot/elephant/doc/Makefile	2007/03/24 13:55:15	1.4
@@ -1,8 +1,10 @@
 
+all: docs
 
+includes-stuff: 
+	cd includes; sbcl < ../make-ref.lisp
 
 docs: includes-stuff
-	makeinfo -v --html --force elephant.texinfo
+	makeinfo -v --html --css-include=style.css --force elephant.texinfo
+	makeinfo -v --html --css-include=style.css --force --no-split elephant.texinfo
 
-includes-stuff: 
-	cd includes; sbcl  < ../make-ref.lisp
--- /project/elephant/cvsroot/elephant/doc/make-ref.lisp	2007/03/24 12:16:02	1.3
+++ /project/elephant/cvsroot/elephant/doc/make-ref.lisp	2007/03/24 13:55:15	1.4
@@ -1,10 +1,21 @@
 (require 'asdf)
 (asdf:operate 'asdf:load-op 'elephant-tests)
-(sb-posix:chdir "/Users/eslick/Work/fsrc/elephant-cvs/doc/includes/")
-(load "/Users/eslick/Work/fsrc/elephant-cvs/doc/docstrings.lisp")
+(defparameter include-dir-path 
+  (namestring 
+   (merge-pathnames 
+    #p"doc/includes/"
+    (asdf:component-pathname (asdf:find-system 'elephant-tests)))))
+
+(defparameter docstrings-path
+  (namestring 
+   (merge-pathnames 
+    #p"doc/docstrings.lisp"
+    (asdf:component-pathname (asdf:find-system 'elephant-tests)))))
+
+(sb-posix:chdir include-dir-path)
+(load docstrings-path)
 
 (defun make-docs ()
-;;  (when (check-complete)
   (when t
     (elephant:open-store elephant-tests::*testbdb-spec*)
     (make-instance 'elephant::persistent-collection)

--- /project/elephant/cvsroot/elephant/doc/data-store-reference.texinfo	2007/03/24 13:55:15	NONE
+++ /project/elephant/cvsroot/elephant/doc/data-store-reference.texinfo	2007/03/24 13:55:15	1.1
@c -*-texinfo-*-

@node Data Store API Reference
@comment node-name, next, previous, up
@chapter Data Store API Reference
@cindex Data Store API Reference
@cindex Data Store
@cindex API Reference

These are the functions that need to be overridden to implement
support for a data store backend.  Included are the exported elephant
functions that need methods defined on them.  Some functions here are
utilities from the main elephant package that support store
implementations.  Migration, class indices and query interfaces are
implemented on top of the store API and require no special support by
implementors.

@menu
* Registration:: Register the backend to parse controller specifications
* Store Controllers:: Subclassing the store controller.
* Slot access:: Support for metaprotocol slot access.
* Collections:: BTrees and indices.
* Cursors:: Traversing BTrees.
* Transactions:: Transaction implementation.
* Multithreading:: Multithreading considerations.
* Serialization:: Facilities for serializing objects.
* C Utilities:: Writing primitive C types.
* Foreign libraries:: Using UFFI and ASDF to build or link foreign libraries
@end menu

@node Registration
@comment node-name, next, previous, up
@section Registration
@cindex Registration

@include includes/fun-elephant-register-backend-con-init.texinfo
@include includes/fun-elephant-lookup-backend-con-init.texinfo

@node Store Controllers
@comment node-name, next, previous, up
@section Store Controllers
@cindex Store Controllers

Subclass store-controller and implement store and close controller
which are called by open-store and close-store respectively.

@include includes/fun-elephant-store-controller.texinfo
@include includes/fun-elephant-backend-open-controller.texinfo
@include includes/fun-elephant-backend-close-controller.texinfo

The slots for these accessors must be initialized.

@include includes/fun-elephant-backend-database-version.texinfo
@include includes/fun-elephant-backend-controller-serialize.texinfo
@include includes/fun-elephant-backend-controller-deserialize.texinfo
@include includes/fun-elephant-backend-root.texinfo
@include includes/fun-elephant-backend-class-root.texinfo

These functions are important utilities for implementing
store-controllers.

@include includes/fun-elephant-backend-oid.texinfo
@include includes/fun-elephant-backend-get-con.texinfo
@include includes/fun-elephant-backend-next-oid.texinfo
@include includes/fun-elephant-backend-connection-is-indeed-open.texinfo

@node Slot Access
@comment node-name, next, previous, up
@section Slot Access
@cindex Slot Access

These functions are called by the metaclass protocol to support
operations on persistent class slots.

@include includes/fun-elephant-backend-persistent-slot-writer.texinfo
@include includes/fun-elephant-backend-persistent-slot-reader.texinfo
@include includes/fun-elephant-backend-persistent-slot-boundp.texinfo
@include includes/fun-elephant-backend-persistent-slot-makunbound.texinfo

@node Collections
@comment node-name, next, previous, up
@section Collections
@cindex Collections

@c		#:btree #:btree-index #:indexed-btree
@c              #:build-indexed-btree #:build-btree #:existsp
@c		#:map-indices 


@node Cursors
@comment node-name, next, previous, up
@section Cursors
@cindex Cursors

@c		#:cursor
@c		#:cursor-btree
@c		#:cursor-oid
@c		#:cursor-initialized-p

@node Transactions
@comment node-name, next, previous, up
@section Transactions
@cindex Transactions

@c		#:*current-transaction*
@c		#:make-transaction-record
@c		#:transaction-store
@c		#:transaction-object
@c              #:execute-transaction
@c		#:controller-start-transaction
@c		#:controller-commit-transaction
@c		#:controller-abort-transaction

@node Multithreading
@comment node-name, next, previous, up
@section Multithreading
@cindex Multithreading

@node Serialization
@comment node-name, next, previous, up
@section Serialization
@cindex Serialization

@c		#:deserialize #:serialize 
@c		#:serialize-symbol-complete
@c		#:deserialize-from-base64-string
@c		#:serialize-to-base64-string

@node Memory utilities
@comment node-name, next, previous, up
@section Memory utilities
@cindex Memory utilities

@node Foreign libraries
@comment node-name, next, previous, up
@section Foreign libraries
@cindex Foreign libraries



--- /project/elephant/cvsroot/elephant/doc/elephant-design.texinfo	2007/03/24 13:55:15	NONE
+++ /project/elephant/cvsroot/elephant/doc/elephant-design.texinfo	2007/03/24 13:55:15	1.1
Debugger entered--Lisp error: (void-variable Design)
  eval(Design)
  eval-last-sexp-1(nil)
  eval-last-sexp(nil)
  call-interactively(eval-last-sexp)
--- /project/elephant/cvsroot/elephant/doc/lisp-data-store.texinfo	2007/03/24 13:55:15	NONE
+++ /project/elephant/cvsroot/elephant/doc/lisp-data-store.texinfo	2007/03/24 13:55:15	1.1
@c -*-texinfo-*-

@node Lisp Data Store
@comment node-name, next, previous, up
@chapter Lisp Data Store
@cindex Lisp Data Store
@cindex Data Store
@cindex API Reference

--- /project/elephant/cvsroot/elephant/doc/scenarios.texinfo	2007/03/24 13:55:15	NONE
+++ /project/elephant/cvsroot/elephant/doc/scenarios.texinfo	2007/03/24 13:55:15	1.1
@c -*-texinfo-*-

@node Usage Scenarios
@comment node-name, next, previous, up
@chapter Usage Scenarios
@cindex Usage Scenarios

Sorry, haven't written this section yet.

Simple file replacement and indexing
- Keep track of ordinary objects, ignore metaprotocol

Persist system objects
- Intermingle persistent objects and regular objects
- Look up objects using class indices

Full database system
- storage, rich data models, references, queries, etc

Multithreaded web applications
- DB + multithreading

Object-oriented data storage, large graph traversals


--- /project/elephant/cvsroot/elephant/doc/style.css	2007/03/24 13:55:15	NONE
+++ /project/elephant/cvsroot/elephant/doc/style.css	2007/03/24 13:55:15	1.1

--- /project/elephant/cvsroot/elephant/doc/user-guide.texinfo	2007/03/24 13:55:15	NONE
+++ /project/elephant/cvsroot/elephant/doc/user-guide.texinfo	2007/03/24 13:55:15	1.1
@c -*-texinfo-*-

@node User Guide
@comment node-name, next, previous, up
@chapter User Guide
@cindex User Guide

@menu
* The Store Controller:: Behind the curtain.
* Serialization details:: The devil hides in the details.
* Reachability:: Determining liveness in a store.
* Persistent objects:: All the dirt on persistent objects.
* Class indices:: In-depth discussion about indexing persistent indices.
* Querying persistent instances:: Retrieving instances of classes.
* Using BTrees:: Using the native btree.
* Secondary Indices:: Alternative ways to index collections.
* Using Cursors:: Low-level access to BTrees.
* Transaction details:: Develop a deeper understanding of transactions and avoid the pitfalls.
* Repository Migration and Upgrade:: How to move objects from one repository to another.
* Garbage collection:: How to recover storage and OIDs in long-lived repositories.
* Performance tuning:: How to get the most from Elephant.
@end menu

@node Persistent objects
@comment node-name, next, previous, up
@section Persistent Objects

Finally, if you for some reason make an instance with a specified OID
which already exists in the database, @code{initargs} take precedence
over values in the database, which take precedences over
@code{initforms}.

Also currently there is a bug where
@code{initforms} are always evaluated, so beware.
(What is the current model here?)


@node The Store Controller
@comment node-name, next, previous, up
@section The Store Controller

What is @code{open-store} doing?  It creates a @code{store-controller}
object, and sets the special @code{*store-controller*} to point to it.
The store controller holds the handles to the database environment and
tables, and some other bookkeeping.  If for some reason you need to
run recovery on the database (see sleepycat docs) you can specify that
with the @code{:recover} and @code{:recover-fatal} keys.

To create one by hand one can do, 

@lisp
* (setq *store-controller* (make-instance 'store-controller :path "testdb"))
=> #<STORE-CONTROLLER @{49252F75@}>

* (open-controller *store-controller*)
=> #<STORE-CONTROLLER @{49252F75@}>
@end lisp

but

@lisp
* (open-store "testdb"))
@end lisp

is the preferred mechanism.

This opens the environment and database.  The @code{persistent-*} objects
reference the @code{*store-controller*} special.  (This is in part because
slot accessors can't take additional arguments.)  If for some reason
you want to operate on 2 store controllers, you'll have to do that by
flipping the @code{*store-controller*} special.

@code{close-store} closes the store controller.  Alternatively
@code{close-controller} can be called on a handle.  Don't forget to do
this or else you may need to run recovery later.  There is a
@code{with-open-controller} macro.  Opening and closing a controller
is very expensive.

@node{Using BTrees}
@comment node-name, next, previous, up
@section Using BTrees

The btree class are to hash-tables as persistent-objects are to
ordinary objects. BTrees have a hash-table-like interface, but store
their keys and values directly as rows in a Sleepycat BTree. Btrees
may be persisted simply by their OID. Hence they have all the nice
properties of persistent objects: identity, fast serialization /
deserialization, no merge conflicts.....

     (defvar *friends-birthdays* (make-btree))
     => *FRIENDS-BIRTHDAYS*
     
     (add-to-root "friends-birthdays" *friends-birthdays*)
     => #<BTREE {4951CF6D}>
     
     (setf (get-value "Andrew" *friends-birthdays*)
       	   (encode-universal-time 0 0 0 22 12 1976))
     => 2429071200
     
     (setf (get-value "Ben" *friends-birthdays*)
     	   (encode-universal-time 0 0 0 14 4 1976))
     => 2407298400
     
     (get-value "Andrew" *friends-birthdays*)
     => 2429071200
     => T
     
     (decode-universal-time *)
     => 0
        0
        0
        22
        12
        1976
        2
        NIL
        6

Because of serialization semantics, BTrees hash on a value, not
identity. This is probably ok for strings, numbers, and persistent
things, but may be strange for other values.

@node Repository Migration
@comment node-name, next, previous, up
@section Repository Migration

This version of Elephant supports migration between store controllers of
any backend type.

The tests @code{migrate1} - @code{migrate5} are demonstrations of this 
capability.

There is a single generic function @code{migrate} that is used to copy
different object types to a target repository.  It is assumed that typically
migrate will be called on two repositories and all live objects (those
reachable in the root or class-root) will be copied to the target repository
via recursive calls to migrate for specific objects.

When persistent instances are copied, their internal pointer will be updated
to point to the new repository so after migration the lisp image should be
merely updated to refer to the target repository in the *store-controller* 
variable or whatever variable the application is using to store the primary
controller instance.

There are some limitations to the current migration implementation:
@enumerate
@item Migrate currently will not handle circular list objects

@item Migrate does not support arrays with nested persistent objects

@item Indexed classes only have their class index copied if you use the
   top level migration.  Objects will be copied without slot data if you
   try to migrate an object outside of a store-to-store migration due to
   the class object belonging to one store or another

@item Migrate assumes that after migration, indexed classes belong to the
   target store. 

@item In general, migration is a one-time activity and afterwards (or after
   a validation test) the source store should be closed.  Any failures
   in migration should then be easy to catch.

@item Each call to migration will be good about keeping track of already
   copied objects to avoid duplication.  Duplication shouldn't screw
   up the semantics, just add storage overhead but is to be avoided.  
   However this information is not saved between calls and there's no 
   other way to do comparisons between objects across stores (different
   oid namespaces) so user beware of the pitfalls of partial migrations...

@item Migrate keeps a memory-resident hash of all objects; this means
   you cannot currently migrate a store that has more data than your 
   main memory.  (This could be fixed by keeping the oid table in
   the target store and deleting it on completion)

@item Migration does not maintain OID equivalence so any datastructures which
   index into those will have to have a way to reconstruct themselves (better
   to keep the object references themselves rather than oids in general)
   but they can overload the migrate method to accomplish this cleanly
@end enumerate 

Users can customize migration if they create unusual datastructures that
are not automatically supported by the existing @code{migrate} methods.
For example, a datastructure that stores only object OIDs instead of
serialized object references will need to overload migrate to ensure
that all referenced objects are in fact copied (otherwise the OIDs will
just be treated as fixnums potentially leaving dangling references.

To customize migration overload a version of migrate to specialize on
your specific persistent class type.  

@lisp
(defmethod migrate ((dst store-controller) (src my-class)))
@end lisp

In the body of this method you can call @code{(call-next-method)}
to get a destination repository object with all the slots copied over
to the target repository which you can then overwrite.  To avoid the
default persistent slot copying, bind the dynamic variable 
@code{*inhibit-slot-writes*} in your user method using 
@code(with-inhibited-slot-copy () ...)} a convenience macro.


@node Threading
@comment node-name, next, previous, up
@section Threading

Sleepycat plays well with threads and processes.  The store controller
is thread-safe by default, that is, can be shared amongst threads.
This is set by the @code{:thread} key.  Transactions may not be shared
amongst threads except serially.  One thing which is NOT thread and
process safe is recovery, which should be run when no one is else is
talking to the database environment.  Consult the Sleepycat docs for
more information.

Elephant uses some specials to hold parameters and buffers.  If you're
using a natively threaded lisp, you can initialize these specials to
thread-local storage by using the @code{run-elephant-thread} function,
assuming your lisp creates thread-local storage for let-bound
specials. (This functionality is currently broken)


[72 lines skipped]


From ieslick at common-lisp.net  Sun Mar 25 11:04:39 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 25 Mar 2007 06:04:39 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/doc
Message-ID: <20070325110439.1CE445201E@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/doc
In directory clnet:/tmp/cvs-serv8936

Modified Files:
	tutorial.texinfo user-guide.texinfo 
Log Message:
Latest documentation edits - still very broken so don't look!

--- /project/elephant/cvsroot/elephant/doc/tutorial.texinfo	2007/03/24 12:16:02	1.7
+++ /project/elephant/cvsroot/elephant/doc/tutorial.texinfo	2007/03/25 11:04:38	1.8
@@ -6,15 +6,15 @@
 @cindex Tutorial
 
 @menu
-* Overview:: Overview of elphant's features
+* Overview:: Overview of elephant's features.
 * Getting Started:: Opening and accessing a store.
 * The Store Root:: Accessing persistent data.
 * Serialization:: Storage semantics for lisp values.
 * Persistent Classes:: Persistent semantics for objects.
 * Rules about Persistent Classes:: What you need to know.
-* Persistent collections:: Keep track of collections of objects.
-* Class Indices:: Simple way to keep track of instances.
-* Using Transactions:: Enabling ACID database properties.
+* Persistent collections:: Keep track of collections of values.
+* Indexing Persistent Classes:: Simple way to keep track of persistent instances.
+* Using Transactions:: Providing ACID database properties.
 @end menu
 
 @node Overview
@@ -377,82 +377,249 @@
 the most recent commits, right?  Note that this can be used as a weak
 form of IPC.  But also note that in particular, if your slot value is
 not an immediate value, reading will cons or allocate the value.  Gets
-are not an expensive operation; you can perform tens of thousands of
-primitive reads per second.  However, if you're concerned, cache
-large values.
+are not an expensive operation; you can perform thousands to tens of
+thousands of primitive reads per second.  However, if you're
+concerned, cache large values in memory.
 
 @node Persistent collections
 @comment node-name, next, previous, up
 @section Persistent collections
 
+The remaining problem outlined in @ref{Serialization} is that
+operations which mutate aggregate objects are not persistent.  While
+we solved this problem for objects, there is no collection type such
+as arrays, hashes or lists which provide this ability.  Elephant
+provides two primary types of collections, a @code{btree} and a
+ at code{indexed-btree}.
+
+We will focus on the core concepts of BTrees in this section, for a
+detailed review including the behavior of indexed BTrees, @pxref{Using
+BTrees}, @ref{Secondary Indices} and @ref{Using Cursors} in the
+ at ref{User Guide}.
 
+Elephant provides a rich data structure called a BTree for storing
+large sets of key-value pairs.  Every key-value pair is stored
+independantly in Elephant just like persistent object slots.
+Therefore they inherit all the nice properties of persistent objects:
+identity, fast serialization / deserialization, no merge conflicts,
+etc.  
+
+The primary interface to @code{btree} objects is through
+ at code{get-value}.  You can also @code{setf} @code{get-value} to store
+key-value pairs.
+
+ at lisp
+(defvar *friends-birthdays* (make-btree))
+=> *FRIENDS-BIRTHDAYS*
+     
+(add-to-root "friends-birthdays" *friends-birthdays*)
+=> #<BTREE @{4951CF6D@}>
+     
+(setf (get-value "Ben" *friends-birthdays*)
+      (encode-universal-time 0 0 0 14 4 1973))
+=> 2312600400
+
+(setf (get-value "Andrew" *friends-birthdays*)
+      (encode-universal-time 0 0 0 22 12 1976))
+=> 2429071200
+     
+(get-value "Andrew" *friends-birthdays*)
+=> 2429071200
+=> T
+     
+(decode-universal-time *)
+=> 0
+   0
+   0
+   22
+   12
+   1976
+   2
+   NIL
+   6
+ at end lisp
+
+In addition to the hash-table like interface, @code{btree} stores
+pairs sorted by the lisp value of the key, lowest to highest.  This is
+works well for numbers, strings, symbols and persistent objects, but
+due to serialization semantics may be strange for other values like
+arrays, lists, standard-objects, etc.  
+
+Because elements are sorted by value, we should be able to iterate
+over all the elements of the BTree in order.  We entered the data in
+reverse alphabetic order, but will read it out in alphabetical order.
+
+ at lisp
+(map-btree (lambda (k v) 
+             (format t "name: ~A utime: ~A~%" k 
+               (subseq (multiple-value-list (decode-universal-time v)) 3 6)))
+           *friends-birthdays*)
+"Andrew"
+"Ben"
+=> NIL
+ at end lisp
 
- at node Class Indices
+But what if we want to read out our friends from oldest to youngest,
+or youngest to oldest?  In the @ref{User Guide}, specifically the
+section on @ref{Secondary indices} you will discover ways to sort
+according to the order defined by a lisp function of the key-value pair.
+
+ at node Indexing Persistent Classes
 @comment node-name, next, previous, up
- at section Class Indices
+ at section Indexing Persistent Classes
+
+Class indices simplify the recording and retrieving of persistent
+objects.  An indexed class stores every instance of the class that is
+created, ensuring that every object is automatically persisted between
+sessions.
+
+ at lisp
+(defpclass friend ()
+  ((name :accessor name :initarg :name)
+   (birthday :initarg :birthday))
+  (:index t))
+=> #<PERSISTENT-METACLASS FRIEND>
+
+(defmethod print-object ((f friend) stream)
+  (format stream "#<~A>" (name f)))
+
+(defun encode-birthday (dmy)
+  (apply #'encode-universal-time 
+    (append '(0 0 0) dmy)))
+
+(defmethod (setf birthday) (dmy (f friend))
+  (setf (slot-value f 'birthday)
+        (encode-birthday dmy))
+  dmy)
+
+(defun decode-birthday (utime)
+  (subseq (multiple-value-list (decode-universal-time utime)) 3 6))
+
+(defmethod birthday ((f friend))
+  (decode-birthday (slot-value f 'birthday)))
+ at end lisp
+
+Notice the class argument ``:index t''.  This tells Elephant to store
+a reference to this class.  Under the covers, there are a set of
+btrees that keep track of classes, but we won't need to worry about
+that as all the functionality has been nicely packaged for you.
+
+We also created our own birthday accessor for convenience so it
+accepts and returns birthdays in a list consisting of month, day and
+year such as @code{(27 3 1972)}.  The index key will be the encoded
+universal time, however.
 
-Class indices are a very convenient way of gaining the efficiency that
-BTrees provide.  If a given object is most often sought by the value
-of one of its slots, which is of course quite common, it is convenient
-to define a class index on that slot, although the same functionality
-can be gained in a more complicated way through the use of secondary
-indices.
-
-The file @file{tests/testindexing.lisp} provides many useful examples
-of both declaring class indexes and using the API to seek objects using them.
-
-The following code from that file in the test ``indexing-range'' demonstrates
-the convenience of a class indexes and the function ``get-instances-by-range''.
-Note in the definition of the ``slot1'' the keyword ``:index'' is used to 
-specify that this slot should be indexed.
-
- at lisp
-      (defclass idx-four ()
-	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
-	(:metaclass persistent-metaclass))
-      
-
-      (defun make-idx-four (val)
-	(make-instance 'idx-four :slot1 val))
-      
-      (with-transaction ()
-	(mapc #'make-idx-four '(1 1 1 2 2 4 5 5 5 6 10)))
-
-      (let ((x1 (get-instances-by-range 'idx-four 'slot1 2 6))
-	    (x2 (get-instances-by-range 'idx-four 'slot1 0 2))
-	    (x3 (get-instances-by-range 'idx-four 'slot1 6 15))
-	    )
-	(format t " x1 = ~A~%" (mapcar #'slot1 x1))
-      	(format t " x2 = ~A~%" (mapcar #'slot1 x2))
-	(format t " x3 = ~A~%" (mapcar #'slot1 x3))
- at end lisp
-
-Additionally, the test 
- at lisp 
-(do-test 'INDEXING-TIMING) 
- at end lisp
-Can be used to judge the performance of indexing a medium sized dataset.
-
-The file @file{src/elephant/classindex.lisp} provides the source code and
-some crisp documentation of the class indexing system.
-
-Note that for retrieving items, the API is provided by three functions:
-
- at lisp 
-(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))
- at end lisp
-
-By using these functions, any class that is a subclass of persistent-metaclass
-can also be thought of as a container of all of its instances, which are 
-persistent in the database between lisp invocations.  Moreover an individual 
-object can be looked up on O(log n) time via a value on which it is indexed.
-
-At the top of this same file, you will find the a description of the API
-which can be used to dynamically add and remove indexes.  (Adding and 
-removing indexes can also be performed by a re-execution of the ``defclass''
-macro with different values.)
+Now we can easily manipulate all the instances of a class.
+
+ at lisp
+(defun print-friend (friend)
+  (format t " name: ~A birthdate: ~A~%" (name friend) (birthday friend)))
+
+(make-instance 'friend :name "Carlos" :birthday (encode-birthday '(1 1 1972)))
+(make-instance 'friend :name "Adriana" :birthday (encode-birthday '(24 4 1980)))
+(make-instance 'friend :name "Zaid" :birthday (encode-birthday '(14 8 1976)))
+
+(get-instances-by-class 'friends)
+=> (#<Carlos> #<Adriana> #<Zaid>)
+
+(mapcar #'print-friend *)
+ name: Carlos birthdate: (1 1 1972)
+ name: Adriana birthdate: (24 4 1980)
+ name: Zaid birthdate: (14 8 1976)
+=> (#<Carlos> #<Adriana> #<Zaid>)
+ at end lisp
+
+But what if we have thousands of friends?  Aside from never getting
+work done, our get-instances-by-class will be doing a great deal of
+consing, eating up lots of memory and wasting our time.  Fortunately
+there is a more efficient way of dealing with all the instances of a
+class.
+
+ at lisp
+(map-class #'print-friend 'friend)
+ name: Carlos birthdate: (1 1 1972)
+ name: Adriana birthdate: (24 4 1980)
+ name: Zaid birthdate: (14 8 1976)
+=> NIL
+ at end lisp
+
+ at code{map-class} has the advantage that it does not keep references to
+objects after they are processed.  The garbage collector can come
+along, clear references from the weak instance cache so that your
+working set is finite.  The list version above conses all objects into
+memory before you can do anything with them.  The deserialization
+costs are very low in both cases.
+
+Notice that the order in which the records are printed are not sorted
+according to either name or birthdate.  Elephant makes no guarantee
+about the ordering of class elements, so you cannot depend on the
+insertion ordering shown here.
+
+So what if we want ordered elements?  How do we access our friends
+according to name and birthdate?  This is where slot indices come into
+play.
+
+ at lisp
+(defpclass friend ()
+  ((name :accessor name :initarg :name :index t)
+   (birthday :initarg :birthday :index t)))
+ at end lisp
+
+Notice the :index argument to the slots.  Also notice that we dropped
+the class :index argument.  Specifying that a slot is indexed
+automatically registers the class as indexed.  While slot indices
+increase the cost of writes and disk storage, each entry is only
+slightly larger than the size of the slot value.  Numbers, small
+strings and symbols are good candidate types for indexed slots, but
+any value may be used, even different types.
+
+Once we've indexed a slot, we can use another set of
+ at code{get-instances} and @code{map} functions to access objects
+in-order and by their slot value.
+
+ at lisp
+(get-instances-by-value 'friends 'name "Carlos")
+=> (#<Carlos>)
+
+(get-instances-by-range 'friends 'name "Adam" "Devin")
+=> (#<Adriana> #<Carlos>)
+
+(get-instances-by-range 'friend 'birthday (encode-birthday '(1 1 1974)) (encode-birthday '(31 12 1984)))
+=> (#<Zaid> #<Adriana>)
+
+(mapc #'print-friend *)
+ name: Zaid birthdate: (14 8 1976)
+ name: Adriana birthdate: (24 4 1980)
+=> (#<Zaid> #<Adriana>)
+
+(map-class-index #'print-friend 'friend 'name "Carlos" "Carlos")
+ name: Carlos birthdate: (1 1 1972)
+=> NIL
+
+(map-class-index #'print-friend 'friend 'name "Adam" "Devin")
+ name: Adriana birthdate: (24 4 1980)
+ name: Carlos birthdate: (1 1 1972)
+=> NIL
+
+(map-class-index #'print-friend 'friend 'birthday
+                 (encode-birthday '(1 1 1974)) 
+                 (encode-birthday '(31 12 1984)))
+ name: Zaid birthdate: (14 8 1976)
+ name: Adriana birthdate: (24 4 1980)
+=> NIL
+
+(map-class-index #'print-friend 'friend 'birthday nil (encode-birthday '(10 10 1978)))
+ name: Carlos birthdate: (1 1 1972)
+ name: Zaid birthdate: (14 8 1976)
+=> NIL
+
+(map-class-index #'print-friend 'friend 'birthday
+                 (encode-birthday '(10 10 1975))
+                 nil)
+ name: Zaid birthdate: (14 8 1976)
+ name: Adriana birthdate: (24 4 1980)
+=> NIL
+ at end lisp
 
 You can enable/disable class indexing for an entire class.  When you disable
 indexing all references to instances of that class are lost.  If you re-enable
@@ -606,16 +773,14 @@
 to retry the transaction a fixed number of times by re-executing the
 whole body.
 
-You can see in the example that a single statement in lisp can include
-several primitive Elephant operations as in the decf statement in
-withdraw.  It takes some careful thinking to properly implement
-transactions, for a complete treatment @pxref{Transaction details}.
-
-The other thing transactions can give us is the ability to put off
-synchronizing our data to disk.  The expensive part of persistent
-writes is flushing data to disk.  Since a transaction caches values,
-all the read and written values are kept in memory until the
-transaction is complete, this can dramatically improve performance.
+The other value transactions provide is the capability to delay
+flushing dirty data to disk.  The most time-intensive part of
+persistent operations is flushing newly written data to disk.  Using
+the default auto-commit behavior requires a flush on every operation
+which can become very expensive.  Because a transaction caches values,
+all the values read or written are cached in memory until the
+transaction completes, dramatically decreasing the number of flushes
+and the total time taken.
 
 @lisp
 (defpclass test ()
@@ -625,8 +790,9 @@
          (make-instance 'test :slot1 i)))
 @end lisp
 
-This can take a long time.  Here each new objects that is created has
-to independantly write its value to disk and accept a disk flush cost.
+This can take a long time, well over a minute on the CLSQL data store.
+Here each new objects that is created has to independantly write its
+value to disk and accept a disk flush cost.
 
 @lisp
 (time (with-transaction ()
@@ -634,7 +800,8 @@
             (make-instance 'test :slot1 i))))
 @end lisp
 
-Here, .......
+Wrapping this operation in a transaction dramatically increases the
+time from 10's of seconds to a second or less.
 
 @lisp
 (time (with-transaction ()
@@ -642,14 +809,64 @@
             (make-instance 'test :slot1 i))))
 @end lisp
 
-These are huge differences in performance!  
-Of course since we are caching all this data in memory, we cannot have
-infinitely sized transactions.  Large operations need to get split up
-into subtransactions.  When dealing with persistent objects a good
-rule of thumb is to keep your transactions less than 1000 at a time.
+When we increase the number of objects within the transaction, the
+time cost does not go up linearly.  This is because the total time to
+write a hundred simple objects is still dominated by the final
+synchronization step.
+

[56 lines skipped]
--- /project/elephant/cvsroot/elephant/doc/user-guide.texinfo	2007/03/24 13:55:15	1.1
+++ /project/elephant/cvsroot/elephant/doc/user-guide.texinfo	2007/03/25 11:04:38	1.2
@@ -76,49 +76,71 @@
 @code{with-open-controller} macro.  Opening and closing a controller
 is very expensive.
 
+
+ at node{Class indices}
+ at comment node-name, next, previous, up
+ at section Class indicies
+
+You can enable/disable class indexing for an entire class.  When you disable
+indexing all references to instances of that class are lost.  If you re-enable
+class indexing only newly created classes will be stored in the class index.
+You can manually restore them by using @code{find-class-index} to get the 
+clas index BTree if you have an alternate in-memory index.
+
+You can add/remove a secondary index for a slot.  So long as the class index
+remains, this can be done multiple times without losing any data.
+
+There is also a facility for defining 'derived slots'.  These can be non-slot
+parameters which are a function of the class's persistent slot values.  For
+example you can use an index to keep an alternate representation available
+for fast indexing.  If an object has an x,y coordinate, you could define a
+derived index for r,theta which stored references in polar coordinates.
+These would be ordered so you could iterate over a class-index to get objects
+in order of increasing radius from the origin or over a range of theta.
+
+Beware, however, that derived indices have to compute their result every
+time you update any persistent instance's slot.  This is because there is 
+no way to know which persistent slots the derived index value(s) depends
+on.  Thus there is a fairly significant computational cost to objects
+with frequent updates having derived indices.  The storage cost, however,
+may be less as all that is added is the index value and an OID reference
+into the class index.  To add a slot value you add a serialized 
+OID+class-ref+slotname to index value which can be much larger if you
+use long slotnames and package names and unicode.
+
+Thus, the question of if and how a given class should be indexed is 
+very flexible and dynamic, and does not need to be determined at the 
+beginning of your development.  This represents the ability to ``late bind''
+the decision of what to index.  
+
+In general, there is always a tradeoff: an indexed slot increases storage
+associated with that slot and slows down write operations.  Reads however remain
+as fast as for unindexed persistent slots.  The Elephant system
+makes it simple to choose where and when one wants to utilize this tradeoff.
+
+Finally, that file @file{src/elephant/classindex-utils.lisp} documents 
+tools for handling class redefinitions and the policy that should be 
+used for synchronizing the classes with the database.  This process is
+somewhat user customizable; documentation for this exists in the source
+file referenced above.
+
 @node{Using BTrees}
 @comment node-name, next, previous, up
 @section Using BTrees
 
-The btree class are to hash-tables as persistent-objects are to
-ordinary objects. BTrees have a hash-table-like interface, but store
-their keys and values directly as rows in a Sleepycat BTree. Btrees
-may be persisted simply by their OID. Hence they have all the nice
-properties of persistent objects: identity, fast serialization /
-deserialization, no merge conflicts.....
-
-     (defvar *friends-birthdays* (make-btree))
-     => *FRIENDS-BIRTHDAYS*
-     
-     (add-to-root "friends-birthdays" *friends-birthdays*)
-     => #<BTREE {4951CF6D}>
-     
-     (setf (get-value "Andrew" *friends-birthdays*)
-       	   (encode-universal-time 0 0 0 22 12 1976))
-     => 2429071200
-     
-     (setf (get-value "Ben" *friends-birthdays*)
-     	   (encode-universal-time 0 0 0 14 4 1976))
-     => 2407298400
-     
-     (get-value "Andrew" *friends-birthdays*)
-     => 2429071200
-     => T
-     
-     (decode-universal-time *)
-     => 0
-        0
-        0
-        22
-        12
-        1976
-        2
-        NIL
-        6
-
-Because of serialization semantics, BTrees hash on a value, not
-identity. This is probably ok for strings, numbers, and persistent
-things, but may be strange for other values.
+A BTree is a data structure designed for on-disk databases.
+Traditional binary trees are a tree structure that stores a key and
+value and two links in each node.  To get to a value, you compare your
+query key to the node key.  If it is equal, return the value in this
+node.  If it is less, follow the first link and if it is greater,
+follow the second link.  The problem here is that every link requires
+a disk seek.  
+
+The BTree exploits the properties of memory/disk data heirarchies.
+The key properties are that disk seeks are expensive, loading large
+blocks of data is relatively inexpensive after a seek and comparisons
+on objects that are stored in memory is cheap.
+
 
 @node Repository Migration
 @comment node-name, next, previous, up



From ieslick at common-lisp.net  Sun Mar 25 14:57:49 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 25 Mar 2007 09:57:49 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070325145749.982863F015@common-lisp.net>

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

Modified Files:
	classindex.lisp collections.lisp 
Log Message:
Another fix for map-index / map-class-index and adding ranges for map-btree (but not map-class

--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/24 12:16:03	1.32
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/25 14:57:49	1.33
@@ -373,10 +373,12 @@
       (declare (dynamic-extent map-fn))
       (map-btree #'map-fn class-idx))))
 
-(defun map-class-index (fn class index start end)
-  "If you want to map over a subset of instances, pick an index 
-   and specify bounds for the traversal.  Otherwise use map-class
-   for all instances"
+(defun map-class-index (fn class index &rest args &key start end value)
+  "To map over a subset of instances, pick an index by slot name
+   or derived index name and specify the bounds for the traversal.
+   Otherwise use map-class for all instances.  "
+  (declare (dynamic-extent args)
+	   (ignorable args))
   (let* ((index (if (symbolp index)
 		    (find-inverted-index class index)
 		    index)))
@@ -384,7 +386,7 @@
 	     (declare (ignore key pkey))
 	     (funcall fn value)))
       (declare (dynamic-extent wrapper))
-      (map-index #'wrapper index :start start :end end))))
+      (map-index #'wrapper index :start start :end end :value value))))
 
 
 ;; =================
@@ -426,8 +428,7 @@
 	     (declare (ignore k pk))
 	     (push v instances)))
       (declare (dynamic-extent collector))
-      (map-index #'collector (find-inverted-index class slot-name) 
-		 :start value :end value))
+      (map-index #'collector (find-inverted-index class slot-name) :value value))
     (nreverse instances)))
 
 (defmethod get-instance-by-value ((class symbol) slot-name value)
--- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/23 16:18:59	1.18
+++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/25 14:57:49	1.19
@@ -318,11 +318,6 @@
 different key.)  Returns has-tuple / secondary key / value /
 primary key."))
 
-
-;; =======================================
-;;   Generic Mapping Functions
-;; =======================================
-
 (defmacro with-btree-cursor ((var bt) &body body)
   "Macro which opens a named cursor on a BTree (primary or
 not), evaluates the forms, then closes the cursor."
@@ -331,16 +326,9 @@
 	  (progn , at body)
        (cursor-close ,var))))
 
-(defmethod map-btree (fn (btree btree))
-  "Like maphash.  Default implementation - overridable
-   Function of two arguments key and value"
-  (ensure-transaction (:store-controller (get-con btree))
-    (with-btree-cursor (curs btree)
-      (loop
-	 (multiple-value-bind (more k v) (cursor-next curs)
-	   (declare (dynamic-extent more k v))
-	   (unless more (return nil))
-	   (funcall fn k v))))))
+;; =======================================
+;;   Generic Mapping Functions
+;; =======================================
 
 (defun lisp-compare<= (a b)
   (etypecase a
@@ -348,15 +336,52 @@
     (string (string<= a b))
     (persistent (<= (oid a) (oid b)))))
 
-(defun lisp-compare-eq (a b)
-  (eq a b))
+(defun lisp-compare-equal (a b)
+  (equal a b))
 
-(defmethod map-index (fn (index btree-index) &rest args &key start end)
-  "Like map-btree, but takes a function of three arguments key, value and primary key
-   if you want to get at the primary key value, otherwise use map-btree"
+;; NOTE: the use of nil for the last element in a btree only works because the C comparison
+;; function orders by type tag and nil is the highest valued type tag so nils are the last
+;; possible element in a btree ordered by value.
+(defmethod map-btree (fn (btree btree) &rest args &key start end (value nil value-set-p))
+  "Map btree maps over a btree from the value start to the value of end.
+   If values are not provided, then it maps over all values.  BTrees 
+   do not have duplicates, but map-btree can also be used with indices
+   in the case where you don't want access to the primary key so we 
+   require a value argument as well for mapping duplicate value sets."
+  (let ((end (if value-set-p value end)))
+    (ensure-transaction (:store-controller (get-con btree))
+      (with-btree-cursor (curs btree)
+	(multiple-value-bind (exists? key value)
+	    (cond (value-set-p
+		   (cursor-set curs value))
+		  ((null start)
+		   (cursor-first curs))
+		  (t (cursor-set-range curs start)))
+	  (if exists?
+	      (funcall fn key value)
+	      (return-from map-btree nil))
+	  (loop
+	     (multiple-value-bind (exists? k v)
+		 (cursor-next curs)
+	       (declare (dynamic-extent exists? k v))
+	       (if (and exists? (or (null end) (lisp-compare<= k end)))
+		   (funcall fn k v)
+		   (return nil)))))))))
+
+(defmethod map-index (fn (index btree-index) &rest args &key start end (value nil value-set-p))
+  "Map-index is like map-btree but for secondary indices, it
+   takes a function of three arguments: key, value and primary
+   key.  As with map-btree the keyword arguments start and end
+   determine the starting element and ending element, inclusive.
+   Also, start = nil implies the first element, end = nil implies
+   the last element in the index.  If you want to traverse only a
+   set of identical key values, for example all nil values, then
+   use the value keyword which will override any values of start
+   and end."
   (declare (dynamic-extent args)
 	   (ignorable args))
-  (let ((sc (get-con index)))
+  (let ((sc (get-con index))
+	(end (or value end)))
     (ensure-transaction (:store-controller sc)
       (with-btree-cursor (cur index)
 	(labels ((next-range ()
@@ -379,8 +404,8 @@
 			   (next-range))))))
 	  (declare (dynamic-extent next-range next-in-range))
 	  (multiple-value-bind (exists? skey val pkey)
-	      (cond ((lisp-compare-eq start end)
-		     (cursor-pset cur start))
+	      (cond (value-set-p
+		     (cursor-pset cur value))
 		    ((null start)
 		     (cursor-pfirst cur))
 		    (t (cursor-pset-range cur start)))
@@ -393,7 +418,6 @@
 		nil)))))))
 
 
-
 ;; ===============================
 ;; Some generic utility functions
 ;; ===============================



From ieslick at common-lisp.net  Mon Mar 26 03:37:27 2007
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 25 Mar 2007 22:37:27 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/doc
Message-ID: <20070326033727.A3EE919001@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/doc
In directory clnet:/tmp/cvs-serv18053

Modified Files:
	tutorial.texinfo user-guide.texinfo 
Log Message:
First cut new tutorial

--- /project/elephant/cvsroot/elephant/doc/tutorial.texinfo	2007/03/25 11:04:38	1.8
+++ /project/elephant/cvsroot/elephant/doc/tutorial.texinfo	2007/03/26 03:37:27	1.9
@@ -355,16 +355,9 @@
 
 Using the @code{persistent-metaclass} metaclass declares all slots to
 be persistent by default.  To make a non-persistent slot use the
- at code{:transient t} flag.  Class slots are never persisted, for either
-persistent or ordinary classes.  (Someday, if we choose to store class
-objects, this policy decision may change).
-
-Readers, writers, accessors, and @code{slot-value-using-class} are
-instrumented, so override these with care.  Because @code{slot-value,
-slot-unboundp, slot-makunbound} are not generic functions, they are
-not guaranteed to work properly with persistent slots.  Use the
- at code{*-using-class} versions or the @code{closer-to-mop} MOP compliance
-layer by Pascal Costanza (we may integrate this in later versions).
+ at code{:transient t} flag.  Class slots @code{:allocation :class} are
+never persisted, for either persistent or ordinary classes.  (Someday,
+if we choose to store class objects, this policy may change).
 
 Persistent classes may inherit from other classes.  Slots inherited
 from persistent classes remain persistent.  Transient slots and slots
@@ -372,47 +365,105 @@
 cannot inherit from persistent classes -- otherwise persistent slots 
 could not be stored!
 
-Note that the database is read every time you access a slot.  This is
-a feature, not a bug, especially in concurrent situations: you want
-the most recent commits, right?  Note that this can be used as a weak
-form of IPC.  But also note that in particular, if your slot value is
-not an immediate value, reading will cons or allocate the value.  Gets
-are not an expensive operation; you can perform thousands to tens of
-thousands of primitive reads per second.  However, if you're
-concerned, cache large values in memory.
+ at lisp
+(defclass stdclass1 ()
+  ((slot1 :initarg :slot1 :accessor slot1)))
+
+(defclass stdclass2 (stdclass1)
+  ((slot2 :initarg :slot2 :accessor slot2)))
+
+(defpclass pclass1 (stdclass2)
+  ((slot1 :initarg :slot1 :accessor slot1)
+   (slot3 :initarg :slot3 :accessor slot3)))
+
+(make-instance 'pclass1 :slot1 1 :slot2 2 :slot3 3)
+=> #<PCLASS1 @{x10deb88a@}>
+
+(add-to-root 'pinst *)
+=> #<PCLASS1 @{x10deb88a@}>
+
+(slot1 pinst)
+=> 1
+
+(slot2 pinst)
+=> 2
+
+(slot3 pinst)
+=> 3
+ at end lisp
+
+Now we can simulate a new lisp session by flushing the instance cache,
+reloading our object then see what slots remain.  Here persistent
+slot1 should shadow the standard slot1 and thus be persistent.  Slot3
+is persistent by default and slot2, since it is inherited from a
+standard class should be transient.
+
+ at lisp
+(elephant::flush-instance-cache *store-controller*)
+=> #<EQL hash-table with weak values, 0 entries @{x11198a02@}>
+
+(setf pinst (get-from-root 'pinst))
+=> #<PCLASS1 @{x1119b652@}>
+
+(slot1 pinst)
+=> 1
+
+(slot-boundp pinst slot2 pinst)
+=> nil
+
+(slot3 pinst)
+=> 3
+ at end lisp
+
+Using persistent objects has implications for the performance of your
+system.  Note that the database is read every time you access a slot.
+This is a feature, not a bug, especially in concurrent situations: you
+want the most recent commits by other threads, right?  This can be
+used as a weak form of IPC.  But also note that in particular, if your
+slot value is not an immediate value or persistent object, reading
+will cons or freshly allocate storage for the value.
+
+Gets are not an expensive operation; you can perform thousands to tens
+of thousands of primitive reads per second.  However, if you're
+concerned, cache large values in memory and avoid writing them back to
+disk as long as you can.
 
 @node Persistent collections
 @comment node-name, next, previous, up
 @section Persistent collections
 
-The remaining problem outlined in @ref{Serialization} is that
-operations which mutate aggregate objects are not persistent.  While
-we solved this problem for objects, there is no collection type such
-as arrays, hashes or lists which provide this ability.  Elephant
-provides two primary types of collections, a @code{btree} and a
- at code{indexed-btree}.
-
-We will focus on the core concepts of BTrees in this section, for a
-detailed review including the behavior of indexed BTrees, @pxref{Using
-BTrees}, @ref{Secondary Indices} and @ref{Using Cursors} in the
- at ref{User Guide}.
-
-Elephant provides a rich data structure called a BTree for storing
-large sets of key-value pairs.  Every key-value pair is stored
-independantly in Elephant just like persistent object slots.
-Therefore they inherit all the nice properties of persistent objects:
-identity, fast serialization / deserialization, no merge conflicts,
-etc.  
+The remaining problem outlined in the section on @ref{Serialization}
+is that operations which mutate collection types do not have
+persistent side effects.  We have solved this problem for objects, but
+not for collections such as as arrays, hashes or lists.  Elephant's
+solution to this problem is the @code{btree} class which provides
+persistent addition, deletion and mutation of elements.
+
+The BTree stores arbitrarily sized sets of key-value pairs ordered by
+key.  Every key-value pair is stored independantly in Elephant just
+like persistent object slots.  They inherit all the important
+properties of persistent objects: btree identity and fast
+serialization / deserialization.  They also resolve the mutated
+substructure and nested aggregates problem for collections.  Every
+mutating write to a btree is an independent and persistent operation
+and you can serialize or deserialize a btree without serializing any
+of it's key-value pairs.
 
 The primary interface to @code{btree} objects is through
- at code{get-value}.  You can also @code{setf} @code{get-value} to store
-key-value pairs.
+ at code{get-value}.  You use @code{setf} @code{get-value} to store
+key-value pairs.  This interface is very similar to @code{gethash}.
+
+The following example creates a btree called
+ at code{*friends-birthdays*} and adds it to the root so we can retrieve
+it during a later sessions.  We then will add two key-value pairs
+consisting of the name of a friend and a universal time encoding their
+birthday.
 
 @lisp
 (defvar *friends-birthdays* (make-btree))
 => *FRIENDS-BIRTHDAYS*
      
-(add-to-root "friends-birthdays" *friends-birthdays*)
+(add-to-root 'friends-birthdays *friends-birthdays*)
 => #<BTREE @{4951CF6D@}>
      
 (setf (get-value "Ben" *friends-birthdays*)
@@ -445,8 +496,8 @@
 due to serialization semantics may be strange for other values like
 arrays, lists, standard-objects, etc.  
 
-Because elements are sorted by value, we should be able to iterate
-over all the elements of the BTree in order.  We entered the data in
+Because elements are sorted by value, we can iterate over all the
+elements of the BTree in order.  Notice that we entered the data in
 reverse alphabetic order, but will read it out in alphabetical order.
 
 @lisp
@@ -459,16 +510,21 @@
 => NIL
 @end lisp
 
-But what if we want to read out our friends from oldest to youngest,
-or youngest to oldest?  In the @ref{User Guide}, specifically the
-section on @ref{Secondary indices} you will discover ways to sort
-according to the order defined by a lisp function of the key-value pair.
+But what if we want to read out our friends from oldest to youngest?
+One way is to employ another btree that maps birthdays to names, but
+this will require storing values multiple times for each update and
+increases the burden on the programmer.  Elephant provides a better
+way.
+
+The next section @ref{Indexing Persistent Classes} shows you how to
+order and retrieve persistent classes by one or more slot values.  
+
 
 @node Indexing Persistent Classes
 @comment node-name, next, previous, up
 @section Indexing Persistent Classes
 
-Class indices simplify the recording and retrieving of persistent
+Class indexing simplifies the storing and retrieval of persistent
 objects.  An indexed class stores every instance of the class that is
 created, ensuring that every object is automatically persisted between
 sessions.
@@ -571,16 +627,20 @@
 increase the cost of writes and disk storage, each entry is only
 slightly larger than the size of the slot value.  Numbers, small
 strings and symbols are good candidate types for indexed slots, but
-any value may be used, even different types.
+any value may be used, even different types.  Once a slot is indexed,
+we can use the index to retrieve objects by slot values.
 
-Once we've indexed a slot, we can use another set of
- at code{get-instances} and @code{map} functions to access objects
-in-order and by their slot value.
+ at code{get-instances-by-value} will retrieve all instances that are
+equal to the value argument.
 
 @lisp
 (get-instances-by-value 'friends 'name "Carlos")
 => (#<Carlos>)
+ at end lisp
 
+But more interestingly, we can retrieve objects for a range of values.
+
+ at lisp
 (get-instances-by-range 'friends 'name "Adam" "Devin")
 => (#<Adriana> #<Carlos>)
 
@@ -591,78 +651,67 @@
  name: Zaid birthdate: (14 8 1976)
  name: Adriana birthdate: (24 4 1980)
 => (#<Zaid> #<Adriana>)
+ at end lisp
+
+To retrieve all instances of a class in the order of the index instead
+of the arbitrary order returned by @code{get-instances-by-class} you
+can use nil in the place of the start and end values to indicate the
+first or last element.  (Note: to retrieve instances null values, use
+ at code{get-instances-by-value} with nil as the argument).
 
-(map-class-index #'print-friend 'friend 'name "Carlos" "Carlos")
+ at lisp
+(get-instances-by-range 'friend 'name nil "Sandra")
+=> (#<Adriana> #<Carlos>)
+
+(get-instances-by-range 'friend 'name nil nil)
+=> (#<Adriana> #<Carlos> #<Zaid>)
+ at end lisp
+
+There are also functions for mapping over instances of a slot index.
+To map over values, use the :value keyword argument.  To map by range,
+use the :start and :end arguments.
+
+ at lisp
+(map-class-index #'print-friend 'friend 'name :value "Carlos")
  name: Carlos birthdate: (1 1 1972)
 => NIL
 
-(map-class-index #'print-friend 'friend 'name "Adam" "Devin")
+(map-class-index #'print-friend 'friend 'name :start "Adam" :end "Devin")
  name: Adriana birthdate: (24 4 1980)
  name: Carlos birthdate: (1 1 1972)
 => NIL
 
 (map-class-index #'print-friend 'friend 'birthday
-                 (encode-birthday '(1 1 1974)) 
-                 (encode-birthday '(31 12 1984)))
+                 :start (encode-birthday '(1 1 1974)) 
+                 :end (encode-birthday '(31 12 1984)))
  name: Zaid birthdate: (14 8 1976)
  name: Adriana birthdate: (24 4 1980)
 => NIL
 
-(map-class-index #'print-friend 'friend 'birthday nil (encode-birthday '(10 10 1978)))
+(map-class-index #'print-friend 'friend 'birthday 
+                 :start nil 
+                 :end (encode-birthday '(10 10 1978)))
  name: Carlos birthdate: (1 1 1972)
  name: Zaid birthdate: (14 8 1976)
 => NIL
 
 (map-class-index #'print-friend 'friend 'birthday
-                 (encode-birthday '(10 10 1975))
-                 nil)
+                 :start (encode-birthday '(10 10 1975))
+                 :end nil)
  name: Zaid birthdate: (14 8 1976)
  name: Adriana birthdate: (24 4 1980)
 => NIL
 @end lisp
 
-You can enable/disable class indexing for an entire class.  When you disable
-indexing all references to instances of that class are lost.  If you re-enable
-class indexing only newly created classes will be stored in the class index.
-You can manually restore them by using @code{find-class-index} to get the 
-clas index BTree if you have an alternate in-memory index.
-
-You can add/remove a secondary index for a slot.  So long as the class index
-remains, this can be done multiple times without losing any data.
-
-There is also a facility for defining 'derived slots'.  These can be non-slot
-parameters which are a function of the class's persistent slot values.  For
-example you can use an index to keep an alternate representation available
-for fast indexing.  If an object has an x,y coordinate, you could define a
-derived index for r,theta which stored references in polar coordinates.
-These would be ordered so you could iterate over a class-index to get objects
-in order of increasing radius from the origin or over a range of theta.
-
-Beware, however, that derived indices have to compute their result every
-time you update any persistent instance's slot.  This is because there is 
-no way to know which persistent slots the derived index value(s) depends
-on.  Thus there is a fairly significant computational cost to objects
-with frequent updates having derived indices.  The storage cost, however,
-may be less as all that is added is the index value and an OID reference
-into the class index.  To add a slot value you add a serialized 
-OID+class-ref+slotname to index value which can be much larger if you
-use long slotnames and package names and unicode.
-
-Thus, the question of if and how a given class should be indexed is 
-very flexible and dynamic, and does not need to be determined at the 
-beginning of your development.  This represents the ability to ``late bind''
-the decision of what to index.  
-
-In general, there is always a tradeoff: an indexed slot increases storage
-associated with that slot and slows down write operations.  Reads however remain
-as fast as for unindexed persistent slots.  The Elephant system
-makes it simple to choose where and when one wants to utilize this tradeoff.
-
-Finally, that file @file{src/elephant/classindex-utils.lisp} documents 
-tools for handling class redefinitions and the policy that should be 
-used for synchronizing the classes with the database.  This process is
-somewhat user customizable; documentation for this exists in the source
-file referenced above.
+The @ref{User Guide} contains a descriptions of the advanced features
+of @ref{Class indices} such as ``derived indicies'' that allow you to
+order classes according to an arbitrary function, a dynamic API for
+adding and removing slots and how to set a policy for resolving
+conflicts between the code image and a database where the indexing
+specification differs.  
+
+This same facility is also available for your own use.  For more
+information @pxref{Using Indexed BTrees}.
 
 
 @node Using Transactions
@@ -670,24 +719,24 @@
 @section Using Transactions
 
 One of the most important features of a database is that operations
-satisfy the ACID properties: Atomic, Consistent, Isolated, and
+enforce the ACID properties: Atomic, Consistent, Isolated, and
 Durable.  In plainspeak, this means that a set of changes is made all
 at once, that the database is never partially updated, that each set
 of changes happens sequentially and that a change, once made, is not
 lost.
 
 Elephant provides this protection for all primitive operations.  For
-example, when you write a value to an indexed BTree, the update to the
-BTree and all of its indices is protected by a transaction that
-peforms atomic updates to all the BTrees, thus maintaining their
-consistency.
-
-Most real applications will need to have explicit transactions because
-you will want one or more read-modify-update operations to happen as
-an atomic unit.  A common motivating example for this is a banking
-system.  If a thread is going to modify a balance, we don't want
-another thread modifying it in the middle of the operation or one of
-the modifications may be lost.
+example, when you write a value to an indexed slot, the update to the
+persistent slot record as well as the slot index is protected by a
+transaction that performs all the updates atomically and thus
+enforcing consistency.
+
+Most real applications will need to use explicit transactions rather
+than relying on the primitives alone because you will want multiple
+read-modify-update operations act as an atomic unit.  A good example
+for this is a banking system.  If a thread is going to modify a
+balance, we don't want another thread modifying it in the middle of
+the operation or one of the modifications may be lost.
 
 @lisp
 (defvar *accounts* (make-btree))
--- /project/elephant/cvsroot/elephant/doc/user-guide.texinfo	2007/03/25 11:04:38	1.2
+++ /project/elephant/cvsroot/elephant/doc/user-guide.texinfo	2007/03/26 03:37:27	1.3
@@ -34,6 +34,12 @@
 @code{initforms} are always evaluated, so beware.
 (What is the current model here?)
 
+Readers, writers, accessors, and @code{slot-value-using-class} are
+employed in redirecting slot accesses to the database, so override
+these with care.  Because @code{slot-value, slot-boundp,
+slot-makunbound} are not generic functions, they are not guaranteed by
+the specification to work properly with persistent slots.  However the
+proper behavior has been verified on SBCL, Allegro and Lispworks.  
 
 @node The Store Controller
 @comment node-name, next, previous, up



From ieslick at common-lisp.net  Fri Mar 30 14:34:34 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 09:34:34 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070330143434.B9E801E090@common-lisp.net>

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

Modified Files:
	TODO elephant.asd 
Log Message:
Significant documentation string and documentation edits towards 0.6.1 manual.  Clean up packages so elephant exports user visible symbols and backend exports backend-relevant symbols.  Change required fix in serializer packages also.  Added :elephant-user package.

--- /project/elephant/cvsroot/elephant/TODO	2007/03/24 12:16:02	1.75
+++ /project/elephant/cvsroot/elephant/TODO	2007/03/30 14:34:34	1.76
@@ -18,7 +18,7 @@
 - Verify db_deadlock for other lisps (launch and kill background program I/F)
 
 Bugs:
-- Fix any bugs found during BETA
+- Support for asdf-install?
 
 Test coverage:
 - Clean up interface to tests
@@ -47,6 +47,20 @@
 0.6.1 - Features COMPLETED to date
 ----------------------------------
 
+POST BETA CHECKINS:
+
+Bugs:
+x Fix duplicate opening of CLSQL db bug that caused errors in SQLite
+x Fix for persistent-object inheritance calculation when inheriting from standard classes
+x Remove problematic asserts in lisp-compare-eq make equal for strings instead of eq
+x Fix map over nils bug in map-index and get-instances-by-value; clarify map-index interface
+
+Tweaks:
+x Add bounds to map-btree
+x Change wipe-class-indexing so it can be called without the class object being created
+x add-to-root, etc now uses :sc instead of :store-controller for brevity
+x Remove hard coded paths in ele-clsql
+
 POST ALPHA CHECKINS:
 
 Major Bugs:
--- /project/elephant/cvsroot/elephant/elephant.asd	2007/03/19 20:35:30	1.38
+++ /project/elephant/cvsroot/elephant/elephant.asd	2007/03/30 14:34:34	1.39
@@ -294,11 +294,11 @@
 		       (:file "transactions")
 		       (:file "metaclasses")
 		       (:file "classes")
+		       (:file "cache")
 		       (:file "serializer")
 		       (:file "serializer1") ;; 0.6.0 db's
 		       (:file "serializer2") ;; 0.6.1 db's
 		       (:file "unicode2")
-		       (:file "cache")
 		       (:file "controller")
 		       (:file "collections")
 		       (:file "classindex-utils")
@@ -309,4 +309,3 @@
 		      :depends-on (memutil utils)))))
   :serial t
   :depends-on (:uffi :cl-base64))
-



From ieslick at common-lisp.net  Fri Mar 30 14:34:35 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 09:34:35 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/doc
Message-ID: <20070330143435.199F81F009@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/doc
In directory clnet:/tmp/cvs-serv31032/doc

Modified Files:
	copying.texinfo data-store-reference.texinfo 
	elephant-design.texinfo elephant.texinfo installation.texinfo 
	make-ref.lisp reference.texinfo tutorial.texinfo 
	user-guide.texinfo 
Log Message:
Significant documentation string and documentation edits towards 0.6.1 manual.  Clean up packages so elephant exports user visible symbols and backend exports backend-relevant symbols.  Change required fix in serializer packages also.  Added :elephant-user package.

--- /project/elephant/cvsroot/elephant/doc/copying.texinfo	2007/03/24 12:16:02	1.3
+++ /project/elephant/cvsroot/elephant/doc/copying.texinfo	2007/03/30 14:34:34	1.4
@@ -1,38 +1,39 @@
 @c -*-texinfo-*-
 
- at node Copying
+ at node Copyright and License
 @comment node-name, next, previous, up
- at chapter Copying
- at cindex Copying
+ at chapter Copyright and License
+ at cindex Copyright and License
 @cindex License
 
- at quotation
- at b{Elephant}: an object-oriented database for Common Lisp.
+ at section Elephant Licensing
+
+ at b{Elephant}: a persistent metaprotocol and object-oriented database
+for Common Lisp.
 
 Homepage: @uref{http://www.common-lisp.net/project/elephant}
 
+ at quotation
 Elephant users are granted the rights to distribute and use this software
 as governed by the terms of the Lisp Lesser GNU Public License
 @uref{http://opensource.franz.com/preamble.html}, also known as the LLGPL.
+ at end quotation
 
 Copyrights include: 
 
+ at quotation
 Copyright (c) 2004 by Andrew Blumberg and Ben Lee
 
-Copyright (c) 2006-2007 by Ian Eslick
-
 Copyright (c) 2005-2007 by Robert L. Read
 
+Copyright (c) 2006-2007 by Ian Eslick
+ at end quotation
 
-Portions of this program (namely the C unicode string
-sorter) are derived from IBM's @b{ICU}:
-
- at uref{http://oss.software.ibm.com/icu/}
-
-whose copyright and license follows the GPL below.
-
-
+Portions of this program (namely the C unicode string sorter) are
+derived from IBM's @b{ICU}: @uref{http://oss.software.ibm.com/icu/,
+ICU Website} whose copyright and license follows below.
 
+ at quotation
 ICU License - ICU 1.8.1 and later
 COPYRIGHT AND PERMISSION NOTICE
 
@@ -72,5 +73,32 @@
 
 All trademarks and registered trademarks mentioned herein
 are the property of their respective owners.
-
 @end quotation
+
+ at section Data Store Licensing Considerations
+
+The Berkeley DB data store is based on the Berkeley DB C library, now
+owned by Oracle, but available as GPL'ed software.  It is important to
+understand that applications using Berkeley DB must also be GPL'ed
+unless you negotiate a commercial license from Oracle.  In most
+interpretations of the license, this includes a requirement to make
+code available for the entirety of any publicly visible website that
+is based on Berkeley DB.  See 
+
+ at uref{http://www.oracle.com/@/technology/@/software/@/products/@/berkeley-db/@/htdocs/bdboslicense.html}.
+
+The CL-SQL backend, depending on which SQL engine you use, may not
+carry this restriction and you can easily migrate data between the
+two.  Since the Berkeley DB store is 4-5x faster than SQL, it may make
+sense to develop under BDB and transition to SQL after you've tuned
+the performance of the application.  Licenses for various SQL engines
+can be found at:
+
+ at itemize
+ at item SQLite: Public Domain, see @uref{http://www.sqlite.org/copyright.html, the SQLite license page}
+ at item Postgresql: BSD License, see @uref{http://www.postgresql.org/about/licence, the Postgresql license page}
+ at item MySQL: Dual licensing (similar to BDB), see @uref{http://www.mysql.com/company/legal/licensing/, the MySQL license page}
+ at end itemize
+
+
+
--- /project/elephant/cvsroot/elephant/doc/data-store-reference.texinfo	2007/03/24 13:55:15	1.1
+++ /project/elephant/cvsroot/elephant/doc/data-store-reference.texinfo	2007/03/30 14:34:34	1.2
@@ -7,24 +7,34 @@
 @cindex Data Store
 @cindex API Reference
 
-These are the functions that need to be overridden to implement
-support for a data store backend.  Included are the exported elephant
-functions that need methods defined on them.  Some functions here are
-utilities from the main elephant package that support store
-implementations.  Migration, class indices and query interfaces are
+This reference includes functions that need to be overridden, classes
+inherited from or other action taken to implement support for a new
+data store backend.  Included are the exported elephant functions that
+need methods defined on them as well as the backend-only functions
+exported in backends.lisp.  Some functions here are utilities from the
+main elephant package that support store implementations, but are not
+required.  Migration, class indices and query interfaces are
 implemented on top of the store API and require no special support by
 implementors.
 
+Because the number of backend implementors is small, this is a minimal
+documentation set intended to serve as an initial guide and a
+reference.  However, it is anticipated that some interaction will be
+needed with the developers to properly harden a datastore for release.
+
+The sections each contain a short guide and a list of functions
+relevant to them.
+
 @menu
-* Registration:: Register the backend to parse controller specifications
+* Registration:: Register the backend to parse controller specifications.
 * Store Controllers:: Subclassing the store controller.
+* Handling Serialization:: Available facilities for serializing objects.
+* C Utilities:: Writing primitive C types.
 * Slot access:: Support for metaprotocol slot access.
 * Collections:: BTrees and indices.
 * Cursors:: Traversing BTrees.
 * Transactions:: Transaction implementation.
 * Multithreading:: Multithreading considerations.
-* Serialization:: Facilities for serializing objects.
-* C Utilities:: Writing primitive C types.
 * Foreign libraries:: Using UFFI and ASDF to build or link foreign libraries
 @end menu
 
@@ -33,8 +43,17 @@
 @section Registration
 @cindex Registration
 
- at include includes/fun-elephant-register-backend-con-init.texinfo
- at include includes/fun-elephant-lookup-backend-con-init.texinfo
+Elephant looks at the first element of the specification list to
+determine which backend code base to use.  The master table for this
+information is @code{*elephant-backends*} in elephant/controller.lisp.
+This will need to be augmented for every backend with the
+specification keyword tag to be used (such as @code{:BDB} or
+ at code{:CLSQL}) and the required asdf dependencies.
+
+In addition, the backend source should use an eval-when statement to
+call the following function:
+
+ at include includes/fun-elephant-backend-register-backend-con-init.texinfo
 
 @node Store Controllers
 @comment node-name, next, previous, up
@@ -44,25 +63,22 @@
 Subclass store-controller and implement store and close controller
 which are called by open-store and close-store respectively.
 
- at include includes/fun-elephant-store-controller.texinfo
+ at include includes/class-elephant-backend-store-controller.texinfo
 @include includes/fun-elephant-backend-open-controller.texinfo
 @include includes/fun-elephant-backend-close-controller.texinfo
 
-The slots for these accessors must be initialized.
+
 
 @include includes/fun-elephant-backend-database-version.texinfo
- at include includes/fun-elephant-backend-controller-serialize.texinfo
- at include includes/fun-elephant-backend-controller-deserialize.texinfo
- at include includes/fun-elephant-backend-root.texinfo
- at include includes/fun-elephant-backend-class-root.texinfo
 
 These functions are important utilities for implementing
 store-controllers.
 
- at include includes/fun-elephant-backend-oid.texinfo
 @include includes/fun-elephant-backend-get-con.texinfo
+ at include includes/fun-elephant-backend-oid.texinfo
 @include includes/fun-elephant-backend-next-oid.texinfo
 @include includes/fun-elephant-backend-connection-is-indeed-open.texinfo
+ at include includes/fun-elephant-get-user-configuration-parameter.texinfo
 
 @node Slot Access
 @comment node-name, next, previous, up
@@ -82,17 +98,37 @@
 @section Collections
 @cindex Collections
 
- at c		#:btree #:btree-index #:indexed-btree
- at c              #:build-indexed-btree #:build-btree #:existsp
- at c		#:map-indices 
+To support collections, the data store must subclass the following
+classes.
 
+ at include includes/class-elephant-btree.texinfo.texinfo
+ at include includes/class-elephant-btree-index.texinfo
+ at include includes/class-elephant-indexed-btree.texinfo
+
+To create the backend-appropriate type of btree, the backend
+implements these methods aginst their store-controller.
+
+ at include includes/fun-elephant-build-btree.texinfo
+ at include includes/fun-elephant-build-indexed-btree.texinfo 
+
+And every btree needs accessors, these must be implemented for btree,
+indexed-btree and btree-index.
+
+ at include includes/fun-elephant-get-value.texinfo
+ at include includes/fun-elephant-setf-get-value.texinfo
+ at include includes/fun-elephant-existsp.texinfo
+ at include includes/fun-elephant-remove-kv.texinfo
+
+ at include includes/fun-elephant-map-indices.texinfo
+ at include includes/fun-elephant-get-index.texinfo
+ at include includes/fun-elephant-remove-index.texinfo
 
 @node Cursors
 @comment node-name, next, previous, up
 @section Cursors
 @cindex Cursors
 
- at c		#:cursor
+ at include includes/class-cursor.texinfo
 @c		#:cursor-btree
 @c		#:cursor-oid
 @c		#:cursor-initialized-p
@@ -106,19 +142,23 @@
 @c		#:make-transaction-record
 @c		#:transaction-store
 @c		#:transaction-object
+
 @c              #:execute-transaction
 @c		#:controller-start-transaction
 @c		#:controller-commit-transaction
 @c		#:controller-abort-transaction
 
- at node Multithreading
+ at node Multithreading Considerations
 @comment node-name, next, previous, up
- at section Multithreading
+ at section Multithreading Considerations
 @cindex Multithreading
 
- at node Serialization
+ at c utils locks
+ at c utils thread-vars
+
+ at node Handling Serialization
 @comment node-name, next, previous, up
- at section Serialization
+ at section Handling Serialization
 @cindex Serialization
 
 @c		#:deserialize #:serialize 
--- /project/elephant/cvsroot/elephant/doc/elephant-design.texinfo	2007/03/24 13:55:15	1.1
+++ /project/elephant/cvsroot/elephant/doc/elephant-design.texinfo	2007/03/30 14:34:34	1.2
@@ -1,5 +1,16 @@
-Debugger entered--Lisp error: (void-variable Design)
-  eval(Design)
-  eval-last-sexp-1(nil)
-  eval-last-sexp(nil)
-  call-interactively(eval-last-sexp)
+
+ at node Elephant Design
+ at comment node-name, next, previous, up
+ at section Elephant Design
+ at cindex design
+
+When the main elephant @code{open-store} function is called, it calls
+ at code{get-controller} which grabs an existing store controller if the
+spec is identical, or builds a new controller.  Building the
+controller requires loading any dependencies via asdf, calling a
+backend initialization function (if it is the first instance of that
+backend being created), and then calling an initialization function
+that returns a @code{store-controller} subclass instance specific to
+that backend. 
+
+Elephant than calls open-controller
--- /project/elephant/cvsroot/elephant/doc/elephant.texinfo	2007/03/24 12:16:02	1.5
+++ /project/elephant/cvsroot/elephant/doc/elephant.texinfo	2007/03/30 14:34:34	1.6
@@ -5,8 +5,9 @@
 @c %**end of header
      
 @copying
-Copyright @copyright{} 2004 Ben Lee and Andrew Blumberg.
-Copyright @copyright{} 2006-2007 Robert L. Read and Ian Eslick
+Original Version, Copyright @copyright{} 2004 Ben Lee and Andrew Blumberg.
+2006 SQL Backend, Copyright @copyright{} 2006 Robert L. Read.
+2007 Rewrite, Copyright @copyright{} 2007 Ian Eslick.
 
 @quotation
 Permission is granted to copy, distribute and/or modify this document
@@ -52,7 +53,7 @@
 * User API Reference:: Function and class documentation of the user API.
 * Elephant Design::    An overview of elephant's internal architecture.
 * Data Store API Reference::  Function level documentation for data store implementors.
-* Copying::        Your rights and freedoms.
+* Copyright and License::     Your rights and freedoms.
 @end menu
 
 @chapheading Appendices
@@ -66,6 +67,7 @@
 @end menu
 
 @node Table of Contents
+ at unnumbered
 @comment  node-name,  next,  previous,  up
 @contents 
      
--- /project/elephant/cvsroot/elephant/doc/installation.texinfo	2007/03/24 12:16:02	1.4
+++ /project/elephant/cvsroot/elephant/doc/installation.texinfo	2007/03/30 14:34:34	1.5
@@ -6,157 +6,232 @@
 @cindex Installation
 
 @menu
-* Installation Basics:: Basic installation
-* Test-Suites:: Running the test suites
-* Berkeley DB Introduction:: The Berkeley DB backend
-* SQL Data Store:: The design and status of the SQL back-end extension.
-* Lisp Data Store:: A native lisp-based repository.
-* Multi-repository Operation:: Specifying repositories.
-* Setting up PostGres:: An example.
+* Requirements:: Supported lisps and required libraries.
+* Configuring Elephant:: Setting up Elephant and the configuration file.
+* Loading Elephant:: Loading Elephant and the data store loading protocol.
+* Berkeley DB Data Store:: Installing support for the Berkeley DB data store
+* Berkeley DB Examples:: An example of installing and running the Berkeley DB data store.
+* CL-SQL Data Store:: Install and connecting to the CL-SQL data store
+* CL-SQL Examples:: An example of using the CL-SQL data store.
+* Elephant on Windows:: More details about running Elephant on Windows
+* Test Suites:: How to run and interpret the output of the regression test suite
+* Documentation:: Building documentation from texinfo sources.
 @end menu
 
- at node Installation Basics 
+ at node Requirements
 @comment node-name, next, previous, up
- at section Installation
+ at section Requirements
 
-Please see the file ``INSTALL'' in the source distribution for 
-more precise information; this is an overview.
+Elephant is a multi-platform, multi-lisp and multi-backend system.  As
+such there is a great deal of complexity in testing.  The system has
+tried to minimize external dependencies as much as possible to ease
+installation, but it still requires some patience and care to bring
+Elephant up on any given platform.  This section attempts to simplify
+this for new users as much as possible.  Patches and suggestions will
+be gladly accepted.
+
+ at subsection Supported Lisp, Platform and Data store combinations
+
+Elephant supports SBCL, Allegro, Lispworks, OpenMCL and CMUCL.  Each
+lisp is supported on each of the platforms it runs on: Mac OS X, Linux
+and Windows.  As of release 0.6.1, both 32-bit and 64-bit systems
+should be supported.  Elephant has a small developer base and as of
+the writing of this manual, there are:
 
-Installation of Elephant itself is easy because of the asdf system.
-Just execute:
- at lisp
-(asdf:operate 'asdf:load-op :elephant)
- at end lisp
+ at enumerate
+ at item Five lisp environments
+ at item Three Operating System platforms
+ at item 32-bit or 64-bit OS/compilation configuration
+ at item Three data store configurations: Berkeley DB, SQLite3 and Postgresql
+ at end enumerate
 
-However, Elephant cannot function without a back-end repository.
-Elephant presents exactly the same API no matter what you choose
-as a repository.  In most cases Elephant will automatically load
-the backend you refer to with your controller spec when you call
-open store.  However, you may have to use asdf to load the 
-code that interfaces to particular repository system.
+This means that the total number of combinations that should be tested
+comes to:
 
-The basic choices are to use the BerkeleyDB system or 
-a SQL based system.  You must perform one of these:
- at lisp
-(asdf:operate 'asdf:load-op :ele-clsql)
-(asdf:operate 'asdf:load-op :ele-bdb)
- at end lisp
+ at math{lisps * os * radix * dstore = 5 * 3 * 2 * 3 = 90 configurations}
 
-If you choose a SQL based system, you may have to 
-load a specific package for that system, such as:
+Of course not all of these combinations are valid, but the
+implications of these combinatorics is that not every combination will
+be tested in any given release.  The developers and active user base
+currently cover all three data store configurations on the following
+platforms:
+
+ at itemize
+ at item 32/64-bit SBCL on Linux and Mac OS X
+ at item 32-bit Lispworks on Windows and Mac OS X 
+ at item 32-bit Allegro on Mac OS X  
+ at end itemize
+
+The developers will do their best to accomodate users who are keen to
+test other combinations, but practically these configurations will be
+the most stable and reliable.  Elephant is becoming quite stable in
+general, so don't be afriad to try an unemphasized combination -
+chances are it is just a little more work to bring it up.
 
- at lisp
-(asdf:operate 'asdf:load-op :ele-sqlite3)
- at end lisp
-or, for Postgres, 
- at lisp
-(asdf:oos 'asdf:load-op :clsql-postgresql-socket)
- at end lisp
+ at subsection Library dependencies
 
-You will have to have the CL-SQL package installed.  Following the 
-documentation for CL-SQL under the section ``How CLSQL finds and loads foreign
-libraries'' you may need to do something like:
- at lisp
-(clsql:push-library-path "/usr/lib/")
- at end lisp
+The Elephant core system requires:
 
-before doing
- at lisp
-(asdf:oos 'asdf:load-op :clsql-postgresql-socket)
- at end lisp
+ at enumerate
+ at item asdf -- @uref{http://www.cliki.net/asdf}
+ at item uffi -- version 1.5.17 or later, @uref{http://uffi.b9.com/} or @uref{http://www.cliki.net/UFFI}
+ at item cl-base64 -- @uref{http://www.cliki.net/cl-base64}
+ at item gcc -- Your system needs GCC (or Cygwin) to build the Elephant C-based serializer library.  (Precompiled DLL's are available for Windows platforms on the @uref{http://www.common-lisp.net/project/elephant/downloads.html, download page}.
+ at item rt -- The RT regression test sytem is required to run the test suite: @uref{http://www.cliki.net/RT}
+ at end enumerate
+
+Follow the instructions at these URLs to download and setup the
+libraries.  (Note: uffi and cl-base64 are
+ at uref{http://www.cliki.net/ASDF-Install, asdf-installable} for those
+of you with asdf-install on your system)
+
+In addition to these libraries, each data store has their own
+dependencies as discussed in @ref{Berkeley DB Data Store} and
+ at ref{CL-SQL Data Store}.
+
+ at node Configuring Elephant
+ at comment node-name, next, previous, up
+ at section Configuring Elephant
 
-in order for clsql to find the PostGres library libpq.so, for example.
+Before you can load the elephant packages into your running lisp, you
+need to setup the configuration file.  First, copy the reference file
+config.sexp from the root directory to my-config.sexp.  my-config.sexp
+contains a lisp reader-formatted list of key-value pairs that tells
+elephant where to find various libraries, how to build libraries, etc.
+
+For example:
 
-Without modifcation, Elephant uses this as it's lib path:
 @lisp
-/usr/local/share/common-lisp/elephant-0.3/
- at end lisp
+#+(and (or sbcl allegro) macosx)
+((:berkeley-db-include-dir . "/opt/local/include/db45/")
+ (:berkeley-db-lib-dir . "/opt/local/lib/db45/")
+ (:berkeley-db-lib . "/opt/local/lib/db45/libdb-4.5.dylib")
+ (:berkeley-db-deadlock . "/opt/local/bin/db45_deadlock")
+ (:pthread-lib . nil)
+ (:clsql-lib . nil)
+ (:compiler . :gcc))
+ at end lisp
+
+The following is a guide to the various parameters.  For simplicity,
+we include all the parameters here, although we will go into more
+detail in each of the data store sections.
+
+ at itemize
+ at item @strong{:compiler} -- This tells Elephant which compiler to use to build any C libraries.  The only options currently are :gcc on Unix platforms and :cygwin for the Windows platform.
+ at item @strong{:berkeley-db-include-dir} -- The pathname for the Berkeley DB include files (db.h)
+ at item @strong{:berkeley-db-lib-dir} -- The pathname for all the Berkeley DB library files 
+ at item @strong{:berkeley-db-lib} -- The full pathname for the specific Berkeley DB library (libdb45.so)
+ at item @strong{:berkeley-db-deadlock} -- The full pathname to the BDB utility function db_deadlock
+ at item @strong{:pthread-lib} -- Not needed for SBCL 9.17+
+ at item @strong{:clsql-lib} -- Currently unused, adds paths to the CL-SQL library search function
+ at end itemize
+
+The config.sexp file contains a set of example configurations to start
+from, but you will most likely need to modify it for your system.
+
+Elephant has one small C library that it uses for binary serialization
+which means that you need to have gcc in your path (@pxref{Elephant on
+Windows} for exceptions on the Windows platform).  
+
+ at node Loading Elephant
+ at comment node-name, next, previous, up
+ at section Loading Elephant
 
-So you could put a symbolic link to libpq.so there, where libmemutil.so and 
-libsleepycat.so will also reside.
+ at subsection Loading Elephant via ASDF
 
-Elephant is designed to allow multi-repository operation; 
-so you could concievably use two or more repositories at the 
-same time.  More particularly, you can seamlessly migrate your
-data from one repository to a different one at a later date.
-In a long duration project, this might occur because of a licensing
-or performance issue with a particular respository.  Migrating to
-a new repository of the same type is a cheap form of GC although
-migration is limited to the total size of main memory to store
-a hash table that tracks all copied object ID's.
-
- at node Test-Suites
- at comment node-name, next, previous, up
- at section Test-Suites
-
-Elephant is moderately mature.  Hopefully, it will work out-of-the-box
-for you.
-
-However, if you are using an LISP implementation different than the ones
-on which it is developed and maintained (currently OpenMCL, SBCL, and ACL),
-or as the repositories evolve, or just because of mistakes, you may need
-to run the test suites.  If you report a bug, we will ask you 
-to run these tests and report the output.  Running them when you 
-first install things may give you a sense of confidence and understanding
-that makes it worth the trouble.
+Now that you have loaded all the dependencies and created your
+configuration file you can load the Elephant packages and
+definitions:
 
-There are three files that execute the tests.  You should choose
-one as a starting point based on what backend(s) you are using.
-If using BerekleyDB, use 
 @lisp
-BerkeleyDB-tests.lisp
+(asdf:operate 'asdf:load-op :elephant)
 @end lisp
 
-If using both, use both of the above and also use:
+This will load the cl-base64 and uffi libraries.  It will also
+automatically compile and load the C library.  The build process no
+longer depends on a Makefile.  This build process has been verified on
+most platforms, but if you have a problem please report it, and any
+output you can capture, to the developers at
+ at email{elephant-devel@@common-lisp.net}.  We will update the FAQ at
+ at uref{http://trac.common-lisp.net/elephant} with common problems users
+run into.
+
+ at subsection Two-Phase Load Process
+
+Elephant uses a two-phase load process.  The core code is loaded and
+the code for a given data store is loaded on demand when you call
+ at code{open-store} with a specification referencing that data store.
+The second phase of the load process requires ASDF to be installed on
+your system.
+
+(NOTE: There are some good reasons and not so good reasons for this
+process.  One reason you cannot load ele-bdb.asd directly as it
+depends on lisp code defined in elephant.asd.  We decided not to fix
+this in this release although later releases may avoid the oddity of
+the two phase loading)
+
+ at subsection Packages
+
+Now that Elephant has been loaded, you can call @code{use-package} in
+the cl-user package or create a new package that imports the symbols
+exported from package :elephant.
+
 @lisp
-MigrationTests.lisp
+CL-USER> (use-package :elephant)
+=> T
+
+OR
+
+(defpackage :elephant-user 
+  (:use :common-lisp :elephant))
 @end lisp
 
-The text of this file is included here to give the
-casual reader an idea of how elepant test can be run in general:
- at lisp
-;; This file is an example of how to perform the 
-;; migration tests.  You will have to modify it 
-;; slightly depending on the systems that want to test...
-;; You can test migration even between two BDB respositories if you wish
-(asdf:operate 'asdf:load-op :elephant)
-(asdf:operate 'asdf:load-op :ele-clsql)
-(asdf:operate 'asdf:load-op :clsql-postgresql-socket)
-(asdf:operate 'asdf:load-op :ele-bdb)
-(asdf:operate 'asdf:load-op :elephant-tests)
-;; For sqlite-3..
-;; (asdf:operate 'asdf:load-op :ele-sqlite3)
+Beginners can skip to the end of this section.  
 
-(in-package "ELEPHANT-TESTS")
+Elephant has a common package called elephant that exports a set of
+generic functions.  It also contains a dispatcher based on the first
+element of a specification list that calls the relevant backend
+version of @code{open-controller}, the internal method that creates a
+ at code{store-controller}.  Each backend has it's own subclass
+implementing the abstract interface of @code{store-controller}.
 
-;; The primary and secondary test-paths are 
-;; use for the migration tests.
+ at subsection Opening a Store
 
-;; This this configuration for testing between BDB and SQL....
-(setq *test-path-primary* *testpg-path*)
-;; (setq *test-path-primary* *testsqlite3-path*)
-(setq *test-path-secondary* *testdb-path*)
+As discussed in the tutoral, you can now open a store to begin using
+Elephant:
 
-;; This this configuration for testing from one BDB repository to another...
-(setq *test-path-primary* *testdb-path*)
-;; (setq *test-path-primary* *testsqlite3-path*)
-(setq *test-path-secondary* *testdb-path2*)
+ at lisp
+(open-store '(:BDB "/Users/owner/db/my-bdb/"))
+...
+ASDF loading messages
+...
+=> #<BDB-STORE-CONTROLLER>
 
-(do-migrate-test-spec *test-path-primary*)
+(open-store '(:CLSQL (:POSTGRESQL "localhost.localdomain" "mydb" "myuser" ""))))
+...
+ASDF loading messages
+...
+=> #<SQL-STORE-CONTROLLER>
 @end lisp
 
-The appropriate test should execute for you with no errors.
-If you get errors, you may wish to report it the 
- at code{ elephant-devel at common-lisp.net} email list.
+The first time you load a specific data store, Elephant will call ASDF
+to load all the specified data store's dependencies, connect to a
+database and return the @code{store-controller} subclass instance for
+that backend.
 
- at node Berkeley DB Repository
+ at node Berkeley DB Data Store
 @comment node-name, next, previous, up
- at section Berkeley DB Repository
+ at section Berkeley DB Data Store
+
 
 
- at node SQL Repository
+ at node Berkeley DB Example
+ at comment node-name, next, previous, up
+ at section Setting up Berkeley DB
+
+ at node CL-SQL Data Store
 @comment node-name, next, previous, up
- at section SQL Repository
+ at section CL-SQL Data Store
 
 Although originally designed as an interface to the BerkeleyDB system,
 the original Elephant system has been experimenetally extended to 
@@ -227,44 +302,14 @@
 the multi-repository version somewhat complicates the underlying 
 persistent object management. 
 
- at node Multi-repository Operation
+ at node PostGres Examples
 @comment node-name, next, previous, up
- at section Multi-repository Operation
-
-Elephant now keeps a small hashtables that maps ``database specifications'' into
-actual database connections.
-
-If a database spec is a string, it is assumed to be a BerkeleyDB path.
-If it is a list, it is a assumed to be a CL-SQL connection specification.
-For example:
- at lisp
-ELE-TESTS> *testdb-path*
-"/home/read/projects/elephant/elephant/tests/testdb/"
-ELE-TESTS> *testpg-path*
-(:postgresql "localhost.localdomain" "test" "postgres" "")
-ELE-TESTS> 
- at end lisp
-
-The tests now have a function @code{do-all-tests-spec} that take a spec and 
-based on its type attempt to open the correct kind of store controller and 
-perform the tests.
-
-The routine @code{get-controller} takes this specifiation.
-
-The basic strategy is that the ``database specification'' object is stored in
-every persistent object and collection so that the repository can be found.
-
-In this way, objects that reside in different repositories can coexist within
-the LISP object space, allowing data migration.
-
-
-
+ at section Setting up PostGres
 
 @node Setting up PostGres
 @comment node-name, next, previous, up
 @section Setting up PostGres
 
-
 To set up a PostGres based back end, you should:
 
 @enumerate
@@ -294,7 +339,6 @@
 Before you attempt to connect with Elephant.

[114 lines skipped]
--- /project/elephant/cvsroot/elephant/doc/make-ref.lisp	2007/03/24 13:55:15	1.4
+++ /project/elephant/cvsroot/elephant/doc/make-ref.lisp	2007/03/30 14:34:34	1.5
@@ -16,11 +16,14 @@
 (load docstrings-path)
 
 (defun make-docs ()
-  (when t
-    (elephant:open-store elephant-tests::*testbdb-spec*)
-    (make-instance 'elephant::persistent-collection)
-    (make-instance 'elephant::secondary-cursor)
-    (make-instance 'elephant::indexed-btree)
-    (sb-texinfo:generate-includes #p"/Users/eslick/Work/fsrc/elephant-cvs/doc/includes/" (find-package :elephant) (find-package :elephant-backend) (find-package 'elephant-memutil) (find-package 'elephant-system))))
+  (elephant:open-store elephant-tests::*testbdb-spec*)
+  (make-instance 'elephant::persistent-collection)
+  (make-instance 'elephant::secondary-cursor)
+  (make-instance 'elephant::indexed-btree)
+  (sb-texinfo:generate-includes #p"/Users/eslick/Work/fsrc/elephant-cvs/doc/includes/" 
+				(find-package :elephant)
+				(find-package :elephant-backend)
+				(find-package :elephant-memutil) 
+				(find-package :elephant-system)))
 
 (make-docs)
--- /project/elephant/cvsroot/elephant/doc/reference.texinfo	2007/03/24 12:16:02	1.6
+++ /project/elephant/cvsroot/elephant/doc/reference.texinfo	2007/03/30 14:34:34	1.7
@@ -14,7 +14,6 @@
 * Collections:: BTrees and indices.
 * Cursors:: Traversing BTrees.
 * Transactions:: Transactions.
-* Multithreading:: Multithreading.
 * Migration and Upgrading:: Migration and upgrading.
 @end menu
 
@@ -56,23 +55,48 @@
 @section Persistent Object Indexing
 @cindex Persistent Object Indexing
 
- at include includes/fun-get-instances-by-class.texinfo
- at include includes/fun-get-instance-by-value.texinfo
- at include includes/fun-get-instances-by-value.texinfo
- at include includes/fun-get-instances-by-range.texinfo
+ at subsection Indexed Object Accessors
+
+ at include includes/fun-elephant-map-class.texinfo
+ at include includes/fun-elephant-map-class-index.texinfo
+
+ at include includes/fun-elephant-get-instances-by-class.texinfo
+ at include includes/fun-elephant-get-instance-by-value.texinfo
+ at include includes/fun-elephant-get-instances-by-value.texinfo
+ at include includes/fun-elephant-get-instances-by-range.texinfo
+
+ at include includes/fun-elephant-drop-instances.texinfo
+
+ at subsection Direct Class Index Manipulation
+
+ at include includes/fun-elephant-find-class-index.texinfo
+ at include includes/fun-elephant-find-inverted-index.texinfo
+ at include includes/fun-elephant-make-class-cursor.texinfo
+ at include includes/macro-elephant-with-class-cursor.texinfo
+ at include includes/fun-elephant-make-inverted-cursor.texinfo
+ at include includes/macro-elephant-with-inverted-cursor.texinfo
+
+ at subsection Dynamic Indexing API
 
 @include includes/fun-elephant-enable-class-indexing.texinfo
 @include includes/fun-elephant-disable-class-indexing.texinfo
- at include includes/fun-add-class-slot-index.texinfo
- at include includes/fun-remove-class-slot-index.texinfo
- at include includes/fun-add-class-derived-index.texinfo
- at include includes/fun-remove-class-derived-index.texinfo
+ at include includes/fun-elephant-add-class-slot-index.texinfo
+ at include includes/fun-elephant-remove-class-slot-index.texinfo
+ at include includes/fun-elephant-add-class-derived-index.texinfo
+ at include includes/fun-elephant-remove-class-derived-index.texinfo
 
 @node Query Interfaces
 @comment node-name, next, previous, up
 @section Query Interfaces
 @cindex Query Interfaces
 
+Query interfaces are currently unimplemented.  An example query
+interface is provided for reference only, a new system is under
+development for the 0.7 release.
+
+ at include includes/fun-elephant-get-query-results.texinfo
+ at include includes/fun-elephant-map-class-query.texinfo
+
 @node Collections
 @comment node-name, next, previous, up
 @section Collections
@@ -145,12 +169,9 @@
 @include includes/fun-elephant-commit-transaction.texinfo
 @include includes/fun-elephant-abort-transaction.texinfo
 
- at node Multithreading
- at comment node-name, next, previous, up
- at section Multithreading
- at cindex Multithreading
-
 @node Migration and Upgrading
 @comment node-name, next, previous, up
 @section Migration and Upgrading
 @cindex Migration and Upgrading
+
+ at include includes/fun-elephant-migrate.texinfo
--- /project/elephant/cvsroot/elephant/doc/tutorial.texinfo	2007/03/26 03:37:27	1.9
+++ /project/elephant/cvsroot/elephant/doc/tutorial.texinfo	2007/03/30 14:34:34	1.10
@@ -914,8 +914,8 @@
 complicated.  The best strategy at the beginning is a conservative
 one, break things up into the smallest logical sets of primitive
 operations and only wrap higher level functions in transactions when
-they absolutely have to commit together.  @xref{Transaction details}
-for all the gory detail of transactions and @pxref{Usage scenarios}
-for more examples of how systems can be designed using transactions.
+they absolutely have to commit together. See @ref{Transaction details}
+for the full details and @pxref{Usage scenarios} for more examples of
+how systems can be designed and tuned using transactions.
 
 
--- /project/elephant/cvsroot/elephant/doc/user-guide.texinfo	2007/03/26 03:37:27	1.3
+++ /project/elephant/cvsroot/elephant/doc/user-guide.texinfo	2007/03/30 14:34:34	1.4
@@ -16,6 +16,7 @@
 * Secondary Indices:: Alternative ways to index collections.
 * Using Cursors:: Low-level access to BTrees.
 * Transaction details:: Develop a deeper understanding of transactions and avoid the pitfalls.
+* Multi-repository Operation:: Specifying repositories.
 * Repository Migration and Upgrade:: How to move objects from one repository to another.
 * Garbage collection:: How to recover storage and OIDs in long-lived repositories.
 * Performance tuning:: How to get the most from Elephant.
@@ -82,10 +83,9 @@
 @code{with-open-controller} macro.  Opening and closing a controller
 is very expensive.
 
-
- at node{Class indices}
+ at node Class Indices
 @comment node-name, next, previous, up
- at section Class indicies
+ at section Class Indicies
 
 You can enable/disable class indexing for an entire class.  When you disable
 indexing all references to instances of that class are lost.  If you re-enable
@@ -130,7 +130,7 @@
 somewhat user customizable; documentation for this exists in the source
 file referenced above.
 
- at node{Using BTrees}
+ at node Using BTrees
 @comment node-name, next, previous, up
 @section Using BTrees
 
@@ -225,7 +225,7 @@
 to the target repository which you can then overwrite.  To avoid the
 default persistent slot copying, bind the dynamic variable 
 @code{*inhibit-slot-writes*} in your user method using 
- at code(with-inhibited-slot-copy () ...)} a convenience macro.
+ at code{with-inhibited-slot-copy} a convenience macro.
 
 
 @node Threading
@@ -318,3 +318,33 @@
 ensure that multiple threads do not interleave access so single user
 mode is not suitable for use in web servers or other typically
 multi-threaded applications.
+
+ at node Multi-repository Operation
+ at comment node-name, next, previous, up
+ at section Multi-repository Operation
+
+Elephant now keeps a small hashtables that maps ``database specifications'' into
+actual database connections.
+
+If a database spec is a string, it is assumed to be a BerkeleyDB path.
+If it is a list, it is a assumed to be a CL-SQL connection specification.
+For example:
+ at lisp
+ELE-TESTS> *testdb-path*
+"/home/read/projects/elephant/elephant/tests/testdb/"
+ELE-TESTS> *testpg-path*
+(:postgresql "localhost.localdomain" "test" "postgres" "")
+ELE-TESTS> 
+ at end lisp
+
+The tests now have a function @code{do-all-tests-spec} that take a spec and 
+based on its type attempt to open the correct kind of store controller and 
+perform the tests.
+
+The routine @code{get-controller} takes this specifiation.
+
+The basic strategy is that the ``database specification'' object is stored in
+every persistent object and collection so that the repository can be found.
+
+In this way, objects that reside in different repositories can coexist within
+the LISP object space, allowing data migration.



From ieslick at common-lisp.net  Fri Mar 30 14:34:35 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 09:34:35 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/db-bdb
Message-ID: <20070330143435.4EB101F009@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src/db-bdb
In directory clnet:/tmp/cvs-serv31032/src/db-bdb

Modified Files:
	bdb-controller.lisp 
Log Message:
Significant documentation string and documentation edits towards 0.6.1 manual.  Clean up packages so elephant exports user visible symbols and backend exports backend-relevant symbols.  Change required fix in serializer packages also.  Added :elephant-user package.

--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp	2007/03/16 14:44:44	1.31
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp	2007/03/30 14:34:35	1.32
@@ -135,7 +135,7 @@
 	(db-open db :file "%ELEPHANTOID" :database "%ELEPHANTOID" 
 		 :auto-commit t :type DB-BTREE :create t :thread thread)
 	(let ((oid-seq (db-sequence-create db)))
-	  (db-sequence-set-cachesize oid-seq *cachesize*)
+	  (db-sequence-set-cachesize oid-seq 100)
 	  (db-sequence-set-flags oid-seq :seq-inc t :seq-wrap t)
 	  (db-sequence-set-range oid-seq 0 most-positive-fixnum)
 	  (db-sequence-initial-value oid-seq 0)



From ieslick at common-lisp.net  Fri Mar 30 14:34:35 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 09:34:35 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070330143435.C8A5C20003@common-lisp.net>

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

Modified Files:
	backend.lisp classindex.lisp controller.lisp package.lisp 
	query.lisp serializer.lisp serializer1.lisp serializer2.lisp 
	variables.lisp 
Log Message:
Significant documentation string and documentation edits towards 0.6.1 manual.  Clean up packages so elephant exports user visible symbols and backend exports backend-relevant symbols.  Change required fix in serializer packages also.  Added :elephant-user package.

--- /project/elephant/cvsroot/elephant/src/elephant/backend.lisp	2007/02/16 23:02:53	1.11
+++ /project/elephant/cvsroot/elephant/src/elephant/backend.lisp	2007/03/30 14:34:35	1.12
@@ -23,108 +23,33 @@
   (:documentation "Backends should use this to get access to internal symbols
    of elephant that importers of elephant shouldn't see.  Backends should also
    import elephant to get use-api generic function symbols, classes and globals")
+  (:use #:elephant)
   (:import-from #:elephant
 		;; Variables
-		#:*cachesize*
-		#:*dbconnection-spec* ;; shouldn't need this
+		#:*dbconnection-spec* 
 		#:connection-is-indeed-open
-		;; Persistent objects
-		#:oid #:get-con
-		#:next-oid 
-		#:persistent-slot-writer
-		#:persistent-slot-reader
-		#:persistent-slot-boundp
-		#:persistent-slot-makunbound
-		;; Controllers
-		#:*elephant-code-version*
-		#:store-controller
-		#:open-controller
-		#:database-version
-		#:close-controller
-		#:controller-serialize
-		#:controller-deserialize
-		#:controller-spec
-		#:controller-root
-		#:controller-version
-		#:controller-class-root
-		#:root #:spec #:class-root
-		#:flush-instance-cache
-		#:controller-symbol-cache #:controller-symbol-id-cache
-		;; Collection generic functions
-		#:btree #:btree-index #:indexed-btree
-		#:build-indexed-btree #:build-btree #:existsp
-		#:map-indices
-		;; Serialization
-		#:deserialize #:serialize 
-		#:deserialize-from-base64-string
-		#:serialize-to-base64-string
-		;; Serialization callbacks
-		#:lookup-persistent-symbol
-		#:lookup-persistent-symbol-id
-		;; Cursor accessors
-		#:cursor
-		#:cursor-btree
-		#:cursor-oid
-		#:cursor-initialized-p
-		;; Transactions
-		#:*current-transaction*
-		#:make-transaction-record
-		#:transaction-store
-		#:transaction-object
-		#:execute-transaction
-		#:controller-start-transaction
-		#:controller-commit-transaction
-		#:controller-abort-transaction
-		;; Misc
-		#:slot-definition-name
-		#:remove-indexed-element-and-adjust
-		#:register-backend-con-init
-		#:lookup-backend-con-init
 
-		;; Lisp specific
-		#+(or sbcl cmu) #:%bignum-ref
-		)
-  (:export 
-		;; Variables
-		#:*cachesize*
-		#:*dbconnection-spec* ;; shouldn't need this
-		#:connection-is-indeed-open
 		;; Persistent objects
 		#:oid #:get-con 
-		#:next-oid 
+		#:next-oid
 		#:persistent-slot-writer
 		#:persistent-slot-reader
 		#:persistent-slot-boundp
 		#:persistent-slot-makunbound
+
 		;; Controllers
 		#:*elephant-code-version*
-		#:store-controller
 		#:open-controller
-		#:database-version
 		#:close-controller
+		#:database-version
+		#:controller-spec
 		#:controller-serialize
 		#:controller-deserialize
-		#:controller-spec
-		#:controller-root
-		#:controller-class-root
-		#:controller-version
 		#:root #:spec #:class-root
-		#:flush-instance-cache
-		#:controller-symbol-cache #:controller-symbol-id-cache
-		;; Collection generic functions
-		#:btree #:btree-index #:indexed-btree
-		#:build-indexed-btree #:build-btree #:existsp
-		#:map-indices 
 		;; Serialization
-		#:deserialize #:serialize 
-		#:serialize-symbol-complete
 		#:deserialize-from-base64-string
 		#:serialize-to-base64-string
-		;; Serialization callbacks
-		#:lookup-persistent-symbol
-		#:lookup-persistent-symbol-id
 		;; Cursor accessors
-		#:cursor
 		#:cursor-btree
 		#:cursor-oid
 		#:cursor-initialized-p
@@ -133,14 +58,58 @@
 		#:make-transaction-record
 		#:transaction-store
 		#:transaction-object
-		#:execute-transaction
-		#:controller-start-transaction
-		#:controller-commit-transaction
-		#:controller-abort-transaction
+		;; Registration
+		#:register-backend-con-init
+		#:lookup-backend-con-init
 		;; Misc
 		#:slot-definition-name
+		#:slots-and-values
+		#:struct-slots-and-values
 		#:remove-indexed-element-and-adjust
-		#:register-backend-con-init
-		#:lookup-backend-con-init
-		))
+		)
+  (:export 
+   ;; Variables
+   #:*cachesize*
+   #:*dbconnection-spec* 
+   #:connection-is-indeed-open
+
+   ;; Persistent objects
+   #:oid #:get-con 
+   #:next-oid 
+   #:persistent-slot-writer
+   #:persistent-slot-reader
+   #:persistent-slot-boundp
+   #:persistent-slot-makunbound
+
+   ;; Controllers
+   #:*elephant-code-version*
+   #:open-controller
+   #:close-controller
+   #:database-version
+   #:controller-spec
+   #:controller-version
+   #:controller-serialize
+   #:controller-deserialize
+   #:root #:spec #:class-root
+   ;; Serialization
+   #:deserialize-from-base64-string
+   #:serialize-to-base64-string
+   ;; Cursor accessors
+   #:cursor-btree
+   #:cursor-oid
+   #:cursor-initialized-p
+   ;; Transactions
+   #:*current-transaction*
+   #:make-transaction-record
+   #:transaction-store
+   #:transaction-object
+   ;; Registration
+   #:register-backend-con-init
+   #:lookup-backend-con-init
+   ;; Misc
+   #:slot-definition-name
+   #:slots-and-values
+   #:struct-slots-and-values
+   #:remove-indexed-element-and-adjust
+   ))
 		
--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/25 14:57:49	1.33
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/30 14:34:35	1.34
@@ -141,7 +141,7 @@
 	  (map-btree (lambda (class-name index)
 		       (declare (ignore index))
 		       (let ((class (find-class class-name nil)))
-			 (when class
+			 (when (and class (subtypep class 'persistent-metaclass))
 			   (setf (%index-cache class) nil))))
 		     (controller-class-root sc)))
       (t (e) (warn "Unable to clear class index caches ~A" e)))))
@@ -333,16 +333,22 @@
 ;;   USER CURSOR API
 ;; ===================
 
-(defgeneric make-inverted-cursor (persistent-metaclass name)
+(defgeneric make-inverted-cursor (class name)
   (:documentation "Define a cursor on the inverted (slot or derived) index"))
 
-(defgeneric make-class-cursor (persistent-metaclass)
+(defgeneric make-class-cursor (class)
   (:documentation "Define a cursor over all class instances"))
 
+
 (defmethod make-inverted-cursor ((class persistent-metaclass) name)
   (make-cursor (find-inverted-index class name)))
 
+(defmethod make-inverted-cursor ((class symbol) name)
+  (make-cursor (find-inverted-index class name)))
+
 (defmacro with-inverted-cursor ((var class name) &body body)
+  "Bind the var argument to an inverted cursor on the index
+   specified the provided class and index name"
   `(let ((,var (make-inverted-cursor ,class ,name)))
      (unwind-protect (progn , at body)
        (cursor-close ,var))))
@@ -350,7 +356,12 @@
 (defmethod make-class-cursor ((class persistent-metaclass))
   (make-cursor (find-class-index class)))
 
+(defmethod make-class-cursor ((class symbol))
+  (make-cursor (find-class-index class)))
+
 (defmacro with-class-cursor ((var class) &body body)
+  "Bind the var argument in the body to a class cursor on the
+   index specified the provided class or class name"
   `(let ((,var (make-class-cursor ,class)))
      (unwind-protect (progn , at body)
        (cursor-close ,var))))
@@ -361,8 +372,8 @@
 ;; ======================
 
 (defun map-class (fn class)
-  "Perform a map operation across all instances of class.  Takes a
-   function of one argument, the class instance"
+  "Perform a map operation over all instances of class.  Takes a
+   function of one argument, a class instance"
   (let* ((class (if (symbolp class)
 		    (find-class class)
 		    class))
@@ -374,9 +385,22 @@
       (map-btree #'map-fn class-idx))))
 
 (defun map-class-index (fn class index &rest args &key start end value)
-  "To map over a subset of instances, pick an index by slot name
-   or derived index name and specify the bounds for the traversal.
-   Otherwise use map-class for all instances.  "
+  "This function maps over a subset of class instances in the
+   order defined by the index.  Specify the class and index by
+   quoted name.  The index may be a slot index or a derived
+   index.  
+
+   To map only a subset of key-value pairs, specify the range
+   using the :start and :end keywords; all elements greater than
+   or equal to :start and less than or equal to :end will be
+   traversed regardless of whether the start or end value is in
+   the index.  
+
+   Use nil in the place of start or end to specify the first
+   element or last element, respectively.  
+
+   To map a single value, iff it exists, use the :value keyword.
+   This is the only way to travers all nil values."
   (declare (dynamic-extent args)
 	   (ignorable args))
   (let* ((index (if (symbolp index)
@@ -395,11 +419,14 @@
 
 (defgeneric get-instances-by-class (persistent-metaclass)
   (:documentation "Retrieve all instances from the class index as a list of objects"))
+
 (defgeneric get-instance-by-value (persistent-metaclass slot-name value)
   (:documentation "Retrieve instances from a slot index by value.  Will return only the first
                   instance if there are duplicates."))
+
 (defgeneric get-instances-by-value (persistent-metaclass slot-name value)
   (:documentation "Returns a list of all instances where the slot value is equal to value."))
+
 (defgeneric get-instances-by-range (persistent-metaclass slot-name start end)
   (:documentation "Returns a list of all instances that match
                    values between start and end.  An argument of
@@ -458,6 +485,8 @@
     (nreverse instances)))
 
 (defun drop-instances (instances &key (sc *store-controller*))
+  "Removes a list of persistent objects from all class indices
+   and unbinds any slot values"
   (when instances
     (assert (consp instances))
     (do-subsets (subset 500 instances)
--- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp	2007/03/24 03:03:00	1.41
+++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp	2007/03/30 14:34:35	1.42
@@ -23,16 +23,23 @@
 ;; TRACKING OBJECT STORES
 ;;
 
-(defparameter *elephant-backends*
+(defvar *elephant-backends*
   '((:bdb (:ele-bdb))
     (:clsql (:ele-clsql))
     )
-  "Entries have the form of (backend-type asdf-depends-list")
+  "Tells the main elephant code the tag used in a store spec to
+   refer to a given backend.  The second argument is an asdf
+   dependency list.  Entries have the form of (backend-type
+   asdf-depends-list")
 
 (defvar *elephant-controller-init* (make-hash-table))
 
 (defun register-backend-con-init (name controller-init-fn)
-  "Backends call this during evalution to register their init function's name"
+  "Backends must call this function during the
+   loading/compilation process to register their initialization
+   function for the tag name in *elephant-backends*.  The
+   initialization function returns a fresh instance of the
+   backends store-controller subclass"
   (setf (gethash name *elephant-controller-init*) controller-init-fn))
 
 (defun lookup-backend-con-init (name)
@@ -102,6 +109,9 @@
 ;;
 
 (defun get-user-configuration-parameter (name)
+  "This function pulls a value from the key-value pairs stored in
+   my-config.sexp so backends can have their own pairs for appropriate
+   customization after loading."
   (elephant-system::get-config-option
    name
    (asdf:find-system :elephant)))
@@ -114,26 +124,51 @@
   ((spec :type list
 	 :accessor controller-spec
 	 :initarg :spec
-	 :documentation "Backend create functions should pass in :spec during make-instance")
+	 :documentation "Backend initialization functions are
+	 expected to initialize :spec on the call to
+	 make-instance")
    ;; Generic support for the object, indexing and root protocols
    (root :reader controller-root 
-	 :documentation "This should be a persistent btree instantiated by the backend")
+	 :documentation "This is an instance of the backend
+	 persistent btree.  It should have an OID that is fixed in
+	 the code and does not change between sessions.  Usually
+	 it this is something like 0, 1 or -1")
    (class-root :reader controller-class-root
-	       :documentation "This should be a persistent indexed btree instantiated by the backend")
+	       :documentation 
+	       "This is another root for class indexing that is
+	       also a backend specific persistent btree instance
+	       with a unique OID that persists between sessions.")
    (instance-cache :accessor instance-cache :initform (make-cache-table :test 'eql)
-		   :documentation "This is an instance cache and part of the metaclass
-                                   protocol.  Backends should not override")
+		   :documentation 
+		   "This is an instance cache and part of the
+                    metaclass protocol.  Backends should not
+                    override the default behavior.")
    (instance-cache-lock :accessor instance-cache-lock :initform (ele-make-lock)
-			:documentation "Protection for updates to the cache from multiple threads")
+			:documentation "Protection for updates to
+			the cache from multiple threads.  Do not
+			override.")
    ;; Upgradable serializer strategy
-   (serializer-version :accessor controller-serializer-version :initform nil)
-   (serialize :accessor controller-serialize :initform nil)
-   (deserialize :accessor controller-deserialize :initform nil)
-   )
+   (serializer-version :accessor controller-serializer-version :initform nil
+		       :documentation "Governs the default
+		       behavior regarding which serializer
+		       version the current elephant core is
+		       using.  Backends can override by creating
+		       a method on initialize-serializer.")
+   (serialize :accessor controller-serialize :initform nil
+	      :documentation "Accessed by elephant::serialize to
+	      get the entry point to the default serializer or to
+	      a backend-specific serializer")
+   (deserialize :accessor controller-deserialize :initform nil
+		:documentation "Contains the entry point for the
+		specific serializer to be called by
+		elephant::deserialize"))
   (:documentation 
-   "Class of objects responsible for the book-keeping of holding DB 
-    handles, the cache, table creation, counters, locks, the root 
-    (for garbage collection,) et cetera."))
+   "Superclass for the data store controller, the main interface
+    to any book-keeping, references to DB handles, the instance
+    cache, btree table creation, counters, locks, the roots (for
+    garbage collection,) et cetera.  Behavior is shared between
+    the superclass and subclasses.  See slot documentation for
+    details."))
 
 ;;
 ;; Per-controller instance caching
@@ -324,12 +359,22 @@
 (defgeneric open-controller (sc &key recover recover-fatal thread &allow-other-keys)
   (:documentation 
    "Opens the underlying environment and all the necessary
-database tables."))
+database tables.  Different backends may use different keys so
+all methods should &allow-other-keys.  There are three standard
+keywords: :recover, :recover-fatal and :thread.  Recover means
+that recovery should be checked for or performed on startup.
+Recover fatal means a full rebuild from log files is requested.
+Thread merely indicates to the backend that it is a threaded
+application and any steps that need to be taken (for example
+transaction implementation) are taken.  :thread is usually
+true."))
 
 (defgeneric close-controller (sc)
   (:documentation 
-   "Close the db handles and environment.  Tries to wipe out
-references to the db handles."))
+   "Close the db handles and environment.  Should be in a state
+   where lisp could be shut down without causing an inconsistent
+   state in the db.  Also, the object could be used by
+   open-controller to reopen the database"))
 
 (defmethod close-controller :after ((sc store-controller))
   "Delete connection spec so store-controller operations on cached 
@@ -422,42 +467,53 @@
 
 (defun add-to-root (key value &key (sc *store-controller*))
   "Add an arbitrary persistent thing to the root, so you can
-retrieve it in a later session.  N.B. this means it (and
-everything it points to) won't get gc'd."
+   retrieve it in a later session.  Anything referenced by an
+   object added to the root is considered reachable and thus live"
   (declare (type store-controller store-controller))
   (assert (not (eq key *elephant-properties-label*)))
   (setf (get-value key (controller-root sc)) value))
 
 (defun get-from-root (key &key (sc *store-controller*))
-  "Get a something from the root."
+  "Get the value associated with key from the root.  Returns two
+   values, the value, or nil, and a boolean indicating whether a
+   value was found or not (so you know if nil is a value or an
+   indication of non-presence)"
   (declare (type store-controller sc))
   (get-value key (controller-root sc)))
 
 (defun root-existsp (key &key (sc *store-controller*))
-  "Test whether a key exists in the root"
+  "Test whether a given key is instantiated in the root"
   (declare (type store-controller sc))
   (if (existsp key (controller-root sc))
       t 
       nil))
 
 (defun remove-from-root (key &key (sc *store-controller*))
-  "Remove something from the root."
+  "Remove something from the root by the key value"
   (declare (type store-controller sc))
   (remove-kv key (controller-root sc)))
 
 (defun map-root (fn &key (sc *store-controller*))
-  "Map over all key-value pairs in the root"
+  "Takes a function of two arguments, key and value, to map over
+   all key-value pairs in the root"
   (map-btree fn (controller-root sc)))
 
 ;;
 ;; Explicit storage reclamation
 ;;
 
+(defgeneric drop-pobject (persistent-object)
+  (:documentation   "drop-pobject reclaims persistent object storage by unbinding
+   all persistent slot values.  It can also helps catch errors
+   where an object should be unreachable, but a reference still
+   exists elsewhere in the DB.  On access, the unbound slots
+   should flag an error in the application program.  IMPORTANT:
+   this function does not clear the cached object instance or any
+   serialized references still in the db.  Need a migration or GC
+   for that!  drop-instances is preferred as it implements the proper
+   behavior for indexed classes"))
+
 (defmethod drop-pobject ((inst persistent-object))
-  "Reclaim persistent object storage by unbinding slot values.
-   This does not delete the cached object instance or any 
-   serialized references still in the db. 
-   Need a migration or GC for that!"
   (let ((pslots (persistent-slots (class-of inst))))
     (dolist (slot pslots)
       (slot-makunbound inst slot))))
--- /project/elephant/cvsroot/elephant/src/elephant/package.lisp	2007/03/23 16:08:10	1.25
+++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp	2007/03/30 14:34:35	1.26
@@ -25,107 +25,6 @@
   (:documentation 
    "Elephant: an object-oriented database for Common Lisp with
     multiple backends for Berkeley DB, SQL and others.")
-  (:export #:*store-controller* #:*current-transaction*
-	   #:*elephant-lib-path* #:*elephant-code-version*
-	   #:with-elephant-variables
-
-	   #:store-controller #:controller-root #:controller-class-root
-	   #:open-store #:close-store #:with-open-store
-	   #:add-to-root #:get-from-root #:remove-from-root #:root-existsp
-	   #:map-root #:get-cached-instance #:flush-instance-cache
-	   #:controller-symbol-cache #:controller-symbol-id-cache
-	   #:controller-fast-symbols-p
-	   #:optimize-layout #:drop-pobject
-	   #:get-user-configuration-parameter
-	   #:database-version
-
-	   #:upgrade
-
-	   #:controller-version #:controller-serializer-version 
-	   #:controller-serialize #:controller-deserialize
-	   #:serialize-database-version-key
-	   #:serialize-database-version-value 
-	   #:deserialize-database-version-value
-	   #:serialize-database-serializer-version-value
-	   #:deserialize-database-serializer-version-value
-	   #:initialize-serializer
-
-	   #:with-transaction #:ensure-transaction
- 	   #:start-ele-transaction #:commit-transaction #:abort-transaction
-
- 	   #:persistent #:persistent-object #:persistent-metaclass
-	   #:persistent-collection #:defpclass
-
- 	   #:btree #:make-btree #:get-value #:remove-kv #:existp
-	   #:indexed-btree #:make-indexed-btree
-	   #:add-index #:get-index #:remove-index #:map-indices
-	   #:btree-index #:get-primary-key
-	   #:primary #:key-form #:key-fn
-
-	   #:struct-constructor
-
- 	   #:migrate #:set-oid-spec #:*inhibit-slot-copy* 
-	   #:add-symbol-conversion #:add-package-conversion
-	   #:*always-convert*
-
-	   #:translate-and-intern-symbol
-	   #:lookup-persistent-symbol
-	   #:lookup-persistent-symbol-id
-	   #:int-byte-spec
-
-	   #:cursor #:secondary-cursor #:make-cursor #:make-simple-cursor
-	   #:cursor-close #:cursor-init
-	   #:cursor-duplicate #:cursor-current #:cursor-first
-	   #:cursor-last #:cursor-next #:cursor-next-dup
-	   #:cursor-next-nodup #:cursor-prev #:cursor-prev-nodup
-	   #:cursor-set #:cursor-set-range #:cursor-get-both
-	   #:cursor-get-both-range #:cursor-delete #:cursor-put
-	   #:cursor-pcurrent #:cursor-pfirst #:cursor-plast
-	   #:cursor-pnext #:cursor-pnext-dup #:cursor-pnext-nodup
-	   #:cursor-pprev #:cursor-pprev-nodup #:cursor-pset
-	   #:cursor-pset-range #:cursor-pget-both
-	   #:cursor-pget-both-range
-
-	   ;; 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
-	   #:report-indexed-classes
-	   #:class-indexedp-by-name
-
-	   ;; Low level cursor API
-	   #:make-inverted-cursor #:make-class-cursor
-	   #:with-inverted-cursor #:with-class-cursor
-
-	   ;; Primitive mapping API
-	   #:with-btree-cursor 
-	   #:map-btree 
-	   #:map-index
-
-	   ;; BTREE Utilities
-	   #:empty-btree-p
-	   #:dump-btree
-	   #:btree-keys
-	   #:btree-differ-p
-
-	   ;; Class mapping API
-	   #:map-class
-	   #:map-class-index
-
-	   ;; Instance query API
-	   #:get-instances-by-class 
-	   #:get-instance-by-value
-	   #:get-instances-by-value
-	   #:get-instances-by-range
-	   #:drop-instances
-
-	   ;; Utilities
-	   #:slots-and-values
-	   #:struct-slots-and-values
-	   )
   #+cmu  
   (:import-from :pcl
 		compute-class-precedence-list
@@ -296,7 +195,71 @@
 		slot-definition-allocation
 		slot-definition-initargs
 		compute-slots)
+  (:export 
+   #:*store-controller* 
+   #:store-controller #:controller-root #:controller-class-root 
+   #:open-store #:close-store #:with-open-store
+   #:add-to-root #:get-from-root #:remove-from-root #:root-existsp #:map-root
+   #:flush-instance-cache
+   #:optimize-layout 
+
+   #:persistent #:persistent-object #:persistent-metaclass #:defpclass
+   #:persistent-collection #:drop-pobject
+
+   #:btree #:make-btree 
+   #:get-value #:remove-kv #:existp
+   #:indexed-btree #:make-indexed-btree 
+   #:add-index #:get-index #:remove-index #:map-indices
+   #:get-primary-key #:primary #:key-form #:key-fn
+   #:with-btree-cursor #:map-btree #:map-index
+   #:empty-btree-p #:dump-btree #:btree-keys #:btree-differ-p
+
+   #:cursor #:secondary-cursor #:make-cursor #:make-simple-cursor
+   #:cursor-close #:cursor-init
+   #:cursor-duplicate #:cursor-current #:cursor-first
+   #:cursor-last #:cursor-next #:cursor-next-dup
+   #:cursor-next-nodup #:cursor-prev #:cursor-prev-nodup
+   #:cursor-set #:cursor-set-range #:cursor-get-both
+   #:cursor-get-both-range #:cursor-delete #:cursor-put
+   #:cursor-pcurrent #:cursor-pfirst #:cursor-plast
+   #:cursor-pnext #:cursor-pnext-dup #:cursor-pnext-nodup
+   #:cursor-pprev #:cursor-pprev-nodup #:cursor-pset
+   #:cursor-pset-range #:cursor-pget-both
+   #:cursor-pget-both-range
+
+   #: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
+   #:report-indexed-classes
+   #:class-indexedp-by-name
+
+   #:map-class #:map-class-index
+   #:get-instances-by-class 
+   #:get-instance-by-value
+   #:get-instances-by-value
+   #:get-instances-by-range
+   #:drop-instances
+   #:make-inverted-cursor #:make-class-cursor
+   #:with-inverted-cursor #:with-class-cursor
+   #:*default-indexed-class-synch-policy*
+
+   #:with-transaction #:ensure-transaction
+   #:controller-start-transaction
+   #:controller-abort-transaction
+   #:controller-commit-transaction
+
+   #:upgrade #:migrate
+   #:set-oid-spec #:*inhibit-slot-copy* 
+   #:add-symbol-conversion #:add-package-conversion
+   #:*always-convert*
+   #:translate-and-intern-symbol
+   #:lookup-persistent-symbol
+   #:lookup-persistent-symbol-id
 
+   #:struct-constructor
+   )
   )
 
 (in-package "ELE")
@@ -304,3 +267,10 @@
 #+cmu
 (eval-when (:compile-toplevel)
   (proclaim '(optimize (ext:inhibit-warnings 3))))
+
+(defpackage :elephant-user
+  (:use :common-lisp :elephant)
+  (:nicknames :ele-user)
+  (:documentation
+   "A user package for experimenting with Elephant"))
+  
\ No newline at end of file
--- /project/elephant/cvsroot/elephant/src/elephant/query.lisp	2007/03/01 02:45:45	1.1
+++ /project/elephant/cvsroot/elephant/src/elephant/query.lisp	2007/03/30 14:34:35	1.2
@@ -40,6 +40,7 @@
     (number (funcall (relation-number-function rel) ival (first tvals)))))
       
 (defun get-query-instances (constraints)
+  "Get a list of instances according to the query constraints"
   (let ((list nil))
     (flet ((collect (inst)
 	     (push inst list)))
@@ -48,7 +49,9 @@
 
 (defun map-class-query (fn constraints)
   "Map instances using the query constaints to filter objects, exploiting
-   slot indices (for last query) and stack allocated test closures"
+   slot indices (for last query) and stack allocated test closures.  This is
+   a minimally optimizing version that uses the first index it finds, and 
+   then does a nested loop join on the rest of the parameters."
   (assert (not (null constraints)))
   (destructuring-bind (class slot relation &rest values) (first constraints)
     (flet ((filter-by-relation (inst)
--- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp	2007/03/03 17:24:59	1.25
+++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp	2007/03/30 14:34:35	1.26
@@ -92,18 +92,21 @@
 ;; Database Version (a list of integers = [version major minor])
 
 (defun serialize-database-version-key (bs)
+  "Given a buffer-stream, encode a key indicating the version using
+   the constant +elephant-version+"
   (serialize-reserved-tag bs)
   (serialize-system-tag +elephant-version+ bs))
 
 (defun serialize-database-version-value (version bs)
-  "Simple serializes a list containing three integers"
-  (assert (consp version))
+  "Serializes a list containing three integers to the buffer stream bs"
+  (assert (and (= (length version) 3)))
   (destructuring-bind (version major minor) version
     (serialize-system-integer version bs)
     (serialize-system-integer major bs)
     (serialize-system-integer minor bs)))
 
 (defun deserialize-database-version-value (bs)
+  "Deserializes the 3 integer list from buffer stream bs"
   (let ((version (deserialize-system-integer bs))
 	(major (deserialize-system-integer bs))
 	(minor (deserialize-system-integer bs)))
--- /project/elephant/cvsroot/elephant/src/elephant/serializer1.lisp	2007/02/26 19:12:18	1.12
+++ /project/elephant/cvsroot/elephant/src/elephant/serializer1.lisp	2007/03/30 14:34:35	1.13
@@ -24,11 +24,12 @@
   #+sbcl
   (:import-from :sb-bignum
 		%bignum-ref)
-  (:import-from :elephant 
+  (:import-from #:elephant 
 		get-cached-instance
 		slot-definition-allocation
 		slot-definition-name
 		compute-slots
+		slots-and-values
 		oid
 		int-byte-spec
 		array-type-from-byte
--- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp	2007/03/21 14:29:31	1.33
+++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp	2007/03/30 14:34:35	1.34
@@ -29,6 +29,8 @@
 		slot-definition-allocation
 		slot-definition-name
 		compute-slots
+		slots-and-values
+		struct-slots-and-values
 		oid
 		int-byte-spec
 		array-type-from-byte
--- /project/elephant/cvsroot/elephant/src/elephant/variables.lisp	2007/02/02 23:51:58	1.10
+++ /project/elephant/cvsroot/elephant/src/elephant/variables.lisp	2007/03/30 14:34:35	1.11
@@ -38,9 +38,6 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; Optimization parameters
 
-(defvar *cachesize* 100
-  "Size of the OID sequence cache.")
-
 (defvar *circularity-initial-hash-size* 50
   "This is the default size of the circularity cache used in the serializer")
 



From ieslick at common-lisp.net  Fri Mar 30 14:34:40 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 09:34:40 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20070330143440.4086F38085@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv31032/tests

Modified Files:
	elephant-tests.lisp 
Log Message:
Significant documentation string and documentation edits towards 0.6.1 manual.  Clean up packages so elephant exports user visible symbols and backend exports backend-relevant symbols.  Change required fix in serializer packages also.  Added :elephant-user package.

--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2007/03/12 01:32:06	1.30
+++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2007/03/30 14:34:35	1.31
@@ -19,7 +19,7 @@
 (defpackage elephant-tests
   (:nicknames :ele-tests)
   (:use :common-lisp :elephant :regression-test)
-  (:import-from :ele 
+  (:import-from :elephant
 		with-buffer-streams
 		serialize
 		deserialize)



From ieslick at common-lisp.net  Fri Mar 30 14:55:54 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 09:55:54 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/db-bdb
Message-ID: <20070330145554.8B03D19008@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src/db-bdb
In directory clnet:/tmp/cvs-serv4653/src/db-bdb

Modified Files:
	package.lisp 
Log Message:
Add exported symbols that were missing from backend.lisp

--- /project/elephant/cvsroot/elephant/src/db-bdb/package.lisp	2007/02/18 10:58:58	1.7
+++ /project/elephant/cvsroot/elephant/src/db-bdb/package.lisp	2007/03/30 14:55:54	1.8
@@ -30,7 +30,7 @@
    Elephant, but with some magic for Elephant.  In general there
    is a 1-1 mapping from functions here and functions in
    Berkeley DB, so refer to their documentation for details.")
-  (:use common-lisp uffi elephant-memutil elephant-backend elephant-utils elephant)
+  (:use common-lisp uffi elephant-memutil elephant elephant-backend elephant-utils)
   #+cmu
   (:use alien)
   #+sbcl



From ieslick at common-lisp.net  Fri Mar 30 14:55:55 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 09:55:55 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070330145555.3E49519008@common-lisp.net>

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

Modified Files:
	backend.lisp package.lisp 
Log Message:
Add exported symbols that were missing from backend.lisp

--- /project/elephant/cvsroot/elephant/src/elephant/backend.lisp	2007/03/30 14:34:35	1.12
+++ /project/elephant/cvsroot/elephant/src/elephant/backend.lisp	2007/03/30 14:55:54	1.13
@@ -19,57 +19,21 @@
 
 (in-package :cl-user)
 
-(defpackage :elephant-backend
+(defmacro defpackage-import-exported (name source-package &rest args)
+  "Define an export list, a source package and this macro will automatically
+   import from that package the exported symbol names."
+  (let* ((exports (find :export args :key #'car))
+	 (imports `(:import-from ,source-package ,@(cdr exports))))
+    `(defpackage ,name
+       ,@(append args (list imports)))))
+
+(defpackage-import-exported :elephant-backend :elephant
   (:documentation "Backends should use this to get access to internal symbols
    of elephant that importers of elephant shouldn't see.  Backends should also
    import elephant to get use-api generic function symbols, classes and globals")
   (:use #:elephant)
-  (:import-from #:elephant
-		;; Variables
-		#:*dbconnection-spec* 
-		#:connection-is-indeed-open
-
-		;; Persistent objects
-		#:oid #:get-con 
-		#:next-oid
-		#:persistent-slot-writer
-		#:persistent-slot-reader
-		#:persistent-slot-boundp
-		#:persistent-slot-makunbound
-
-		;; Controllers
-		#:*elephant-code-version*
-		#:open-controller
-		#:close-controller
-		#:database-version
-		#:controller-spec
-		#:controller-serialize
-		#:controller-deserialize
-		#:root #:spec #:class-root
-		;; Serialization
-		#:deserialize-from-base64-string
-		#:serialize-to-base64-string
-		;; Cursor accessors
-		#:cursor-btree
-		#:cursor-oid
-		#:cursor-initialized-p
-		;; Transactions
-		#:*current-transaction*
-		#:make-transaction-record
-		#:transaction-store
-		#:transaction-object
-		;; Registration
-		#:register-backend-con-init
-		#:lookup-backend-con-init
-		;; Misc
-		#:slot-definition-name
-		#:slots-and-values
-		#:struct-slots-and-values
-		#:remove-indexed-element-and-adjust
-		)
   (:export 
    ;; Variables
-   #:*cachesize*
    #:*dbconnection-spec* 
    #:connection-is-indeed-open
 
@@ -87,25 +51,37 @@
    #:close-controller
    #:database-version
    #:controller-spec
-   #:controller-version
+   #:controller-serializer-version
    #:controller-serialize
    #:controller-deserialize
    #:root #:spec #:class-root
-   ;; Serialization
+
+   ;; Serializer tools/api's
+   #:serialize #:deserialize
    #:deserialize-from-base64-string
    #:serialize-to-base64-string
+   #:initialize-serializer
+   #:serialize-database-version-key
+   #:serialize-database-version-value
+   #:deserialize-database-version-value
+
    ;; Cursor accessors
    #:cursor-btree
    #:cursor-oid
    #:cursor-initialized-p
+
    ;; Transactions
    #:*current-transaction*
    #:make-transaction-record
    #:transaction-store
    #:transaction-object
+   #:execute-transaction
+
    ;; Registration
    #:register-backend-con-init
    #:lookup-backend-con-init
+   #:get-user-configuration-parameter
+
    ;; Misc
    #:slot-definition-name
    #:slots-and-values
--- /project/elephant/cvsroot/elephant/src/elephant/package.lisp	2007/03/30 14:34:35	1.26
+++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp	2007/03/30 14:55:54	1.27
@@ -206,9 +206,10 @@
    #:persistent #:persistent-object #:persistent-metaclass #:defpclass
    #:persistent-collection #:drop-pobject
 
-   #:btree #:make-btree 
-   #:get-value #:remove-kv #:existp
-   #:indexed-btree #:make-indexed-btree 
+   #:btree #:build-btree
+   #:get-value #:remove-kv #:existsp
+   #:indexed-btree #:build-indexed-btree 
+   #:btree-index
    #:add-index #:get-index #:remove-index #:map-indices
    #:get-primary-key #:primary #:key-form #:key-fn
    #:with-btree-cursor #:map-btree #:map-index



From ieslick at common-lisp.net  Fri Mar 30 15:03:46 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 10:03:46 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/contrib/eslick/db-lisp
Message-ID: <20070330150346.876DB2F10A@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp
In directory clnet:/tmp/cvs-serv7809/src/contrib/eslick/db-lisp

Added Files:
	transactions.lisp 
Log Message:
Some working files that were missing


--- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/transactions.lisp	2007/03/30 15:03:46	NONE
+++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/transactions.lisp	2007/03/30 15:03:46	1.1

(in-package :db-lisp)

;;
;; Btree Locks and transaction log
;;

(defclass mt-btree (btree)
  ((log :accessor btree-log :initarg :log
	:documentation "The transaction log")))



From ieslick at common-lisp.net  Fri Mar 30 15:03:46 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 10:03:46 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20070330150346.CE30A3800E@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv7809/tests

Added Files:
	stress-test.lisp 
Log Message:
Some working files that were missing


--- /project/elephant/cvsroot/elephant/tests/stress-test.lisp	2007/03/30 15:03:46	NONE
+++ /project/elephant/cvsroot/elephant/tests/stress-test.lisp	2007/03/30 15:03:46	1.1

(in-package :elephant-tests)

(defparameter *spec* '(:bdb "/Users/eslick/Work/db/test"))

(defparameter *names* '("David" "Jim" "Peter" "Thomas"
                        "Arthur" "Jans" "Klaus" "James" "Martin"))

(defclass person ()
  ((name :initform (elt *names* (random (length *names*)))
         :accessor name
         :index t) 
;; Actually the index t shouldn't be needed, but since elephant
;; sometimes complained that "person is not an index class", I try if this fixes it.
   (age :initform (random 100) :accessor age :index t)
;;   (made-by :initform (elephant-utils::ele-thread-hash-key))
   (updated-by :initform nil :accessor updated-by))
  (:metaclass elephant:persistent-metaclass))

(defparameter *nr-persons* 10000)  ;; Should be 10000, but for me elephant can't allocate memory after 3000.
;; I think the problem it is becuase the number of locks (999) is = max 1000. see db_stat -e

(defparameter +age+ 50)

;; I have tried different places for with-transaction below
(defun make-persons (nr-objects &optional (batch-size 500))
  (loop for i from 1 to (/ nr-objects batch-size) do
       (elephant:with-transaction () 
	 (loop for j from 1 to batch-size do
	      (let ((person (make-instance 'person)))
		(when (zerop (mod (+ (* i batch-size) j) 1000))
		  (format t "~D ~a " (+ (* i batch-size) j) (name person))))))))

(defun ensure-clean-store ()
  t)
;;  (let ((dir (cl-fad:pathname-as-directory (second *spec*))))
;;    (when (cl-fad:directory-exists-p dir)
;;      (cl-fad:delete-directory-and-files dir))
;;    (ensure-directories-exist dir)))

(defun my-test-create ()
  (ensure-clean-store)
  (elephant:with-open-store (*spec*)
    (make-persons *nr-persons*)))

(defun subsets (size list)
  (let ((subsets nil))
    (loop for elt in list 
	  for i from 0 do
       (when (= 0 (mod i size))
	 (setf (car subsets) (nreverse (car subsets)))
	 (push nil subsets))
       (push elt (car subsets)))
    (setf (car subsets) (nreverse (car subsets)))
    (nreverse subsets)))

(defmacro do-subsets ((subset subset-size list) &body body)
  `(loop for ,subset in (subsets ,subset-size ,list) do
	, at body))

(defun my-test-update (&key (new-age 27))
  "Test updating all persons by changing their age."
  (elephant:with-open-store (*spec*)
      (do-subsets (subset 500 (elephant:get-instances-by-class 'person))
	(format t "Doing subset~%")
	(elephant:with-transaction ()
	  (mapcar #'(lambda (person)
		      (setf (age person) new-age))
		  subset)))))

(defun my-test-load ()
  "Test loading all persons by computing their average age."
  (let ((nr-persons 0)
        (total-age 0)
        (show-first nil))
    (elephant:with-open-store (*spec*)
      (elephant:with-transaction ()
        (mapcar #'(lambda (person)
                    (incf nr-persons)
                    (print nr-persons)
                    (when (and show-first (> show-first))
                      (format t "Sample person ~a~%F" show-first)
                      (describe person)
                      (decf show-first))
                    (incf total-age (age person)))
                (elephant:get-instances-by-class 'person))))
    (values (coerce (/ total-age nr-persons) 'float)
            nr-persons
            total-age)))

(defun check-basic-setup ()
  (my-test-update :new-age +age+)
  (multiple-value-bind (average nr-persons)
      (my-test-load)
    (assert (= +age+ average))
    (assert (= nr-persons *nr-persons*))))



From ieslick at common-lisp.net  Fri Mar 30 17:28:50 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 12:28:50 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/doc
Message-ID: <20070330172850.22B0A3A040@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/doc
In directory clnet:/tmp/cvs-serv13013/doc

Modified Files:
	data-store-reference.texinfo 
Log Message:
Fixed circular name dependency due to new asdf load order

--- /project/elephant/cvsroot/elephant/doc/data-store-reference.texinfo	2007/03/30 14:34:34	1.2
+++ /project/elephant/cvsroot/elephant/doc/data-store-reference.texinfo	2007/03/30 17:28:50	1.3
@@ -67,11 +67,21 @@
 @include includes/fun-elephant-backend-open-controller.texinfo
 @include includes/fun-elephant-backend-close-controller.texinfo
 
-
+For upgrading and opening legacy databases it is important that a
+store be able to indicate which version of elephant was used to create
+it.  This governs the chosen serializer, mappings between elephant
+symbols used in an old vs. new version, etc.  Because this is called
+to initialize the serializer, it must directly implemented by the
+backend without using the serializer.
 
 @include includes/fun-elephant-backend-database-version.texinfo
 
-These functions are important utilities for implementing
+There are some utilities for serializing simple data without a
+serializer using the memutil package.
+
+ at include 
+
+These functions are useful utilities for implementing
 store-controllers.
 
 @include includes/fun-elephant-backend-get-con.texinfo



From ieslick at common-lisp.net  Fri Mar 30 17:28:50 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 12:28:50 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070330172850.59BA53F003@common-lisp.net>

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

Modified Files:
	variables.lisp 
Log Message:
Fixed circular name dependency due to new asdf load order

--- /project/elephant/cvsroot/elephant/src/elephant/variables.lisp	2007/03/30 14:34:35	1.11
+++ /project/elephant/cvsroot/elephant/src/elephant/variables.lisp	2007/03/30 17:28:50	1.12
@@ -58,6 +58,18 @@
   "The transaction which is currently in effect.")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Forward references
+;;
+;; Elephant needs to export these symbols in order to 
+;; properly load in asdf due to some circular dependencies
+;; between lisp files 
+
+(eval-when (load-toplevel compile-toplevel)
+  (mapcar (lambda (symbol)
+	    (intern symbol :elephant))
+	  '(get-cached-instance)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Utilities
 
 ;; get rid of spot idx and adjust the arrray



From ieslick at common-lisp.net  Fri Mar 30 17:45:41 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 12:45:41 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070330174541.EDDFD59098@common-lisp.net>

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

Modified Files:
	classindex.lisp variables.lisp 
Log Message:
Move utility to utilities, fix warning

--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/30 14:34:35	1.34
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/30 17:45:41	1.35
@@ -71,6 +71,7 @@
   (find-class-index (find-class class-name) :sc sc :errorp errorp))
 
 (defmethod class-indexedp-by-name ((class-name symbol) &key (sc *store-controller*))
+  (declare (ignore sc))
   (let ((class (find-class class-name nil)))
     (when class (indexed class))))
 
--- /project/elephant/cvsroot/elephant/src/elephant/variables.lisp	2007/03/30 17:28:50	1.12
+++ /project/elephant/cvsroot/elephant/src/elephant/variables.lisp	2007/03/30 17:45:41	1.13
@@ -69,17 +69,6 @@
 	    (intern symbol :elephant))
 	  '(get-cached-instance)))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Utilities
-
-;; get rid of spot idx and adjust the arrray
-(defun remove-indexed-element-and-adjust (idx array)
-  (let ((last (- (length array) 1)))
-    (do ((i idx (1+ i)))
-	((= i last) nil)
-      (progn
-	(setf (aref array i) (aref array (+ 1 i)))))
-    (adjust-array array last)))
 
 
 



From ieslick at common-lisp.net  Fri Mar 30 17:45:42 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 12:45:42 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/utils
Message-ID: <20070330174542.6CBD75B068@common-lisp.net>

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

Modified Files:
	convenience.lisp package.lisp 
Log Message:
Move utility to utilities, fix warning

--- /project/elephant/cvsroot/elephant/src/utils/convenience.lisp	2007/03/06 04:15:27	1.5
+++ /project/elephant/cvsroot/elephant/src/utils/convenience.lisp	2007/03/30 17:45:42	1.6
@@ -69,3 +69,12 @@
    make it a list if it's an atom"
   (if (listp elts) elts (list elts)))
 
+(defun remove-indexed-element-and-adjust (idx array)
+  "Remove element at idx and adjust the array to
+   reduce array length by one"
+  (let ((last (- (length array) 1)))
+    (do ((i idx (1+ i)))
+	((= i last) nil)
+      (progn
+	(setf (aref array i) (aref array (+ 1 i)))))
+    (adjust-array array last)))
--- /project/elephant/cvsroot/elephant/src/utils/package.lisp	2007/03/06 04:15:27	1.5
+++ /project/elephant/cvsroot/elephant/src/utils/package.lisp	2007/03/30 17:45:42	1.6
@@ -37,4 +37,5 @@
    #:aif
    #:awhen
    #:mklist
-   #:it))
+   #:it
+   #:remove-indexed-element-and-adjust))



From ieslick at common-lisp.net  Fri Mar 30 17:46:14 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 12:46:14 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070330174614.626DF7080@common-lisp.net>

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

Modified Files:
	backend.lisp 
Log Message:
Move utility to utilities, fix warning

--- /project/elephant/cvsroot/elephant/src/elephant/backend.lisp	2007/03/30 14:55:54	1.13
+++ /project/elephant/cvsroot/elephant/src/elephant/backend.lisp	2007/03/30 17:46:14	1.14
@@ -86,6 +86,5 @@
    #:slot-definition-name
    #:slots-and-values
    #:struct-slots-and-values
-   #:remove-indexed-element-and-adjust
    ))
 		



From ieslick at common-lisp.net  Fri Mar 30 23:36:52 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 18:36:52 -0500 (EST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20070330233652.D6D901E017@common-lisp.net>

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

Modified Files:
	elephant.asd 
Log Message:
Sanitize class indexing option; more documentation stuff

--- /project/elephant/cvsroot/elephant/elephant.asd	2007/03/30 14:34:34	1.39
+++ /project/elephant/cvsroot/elephant/elephant.asd	2007/03/30 23:36:52	1.40
@@ -296,13 +296,13 @@
 		       (:file "classes")
 		       (:file "cache")
 		       (:file "serializer")
-		       (:file "serializer1") ;; 0.6.0 db's
-		       (:file "serializer2") ;; 0.6.1 db's
-		       (:file "unicode2")
 		       (:file "controller")
 		       (:file "collections")
 		       (:file "classindex-utils")
 		       (:file "classindex")
+		       (:file "serializer1") ;; 0.6.0 db's
+		       (:file "serializer2") ;; 0.6.1 db's
+		       (:file "unicode2")
 		       (:file "migrate")
 		       (:file "backend"))
 		      :serial t



From ieslick at common-lisp.net  Fri Mar 30 23:36:53 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 18:36:53 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/doc
Message-ID: <20070330233653.62F4720000@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/doc
In directory clnet:/tmp/cvs-serv15195/doc

Modified Files:
	Makefile data-store-reference.texinfo make-ref.lisp 
	reference.texinfo 
Log Message:
Sanitize class indexing option; more documentation stuff

--- /project/elephant/cvsroot/elephant/doc/Makefile	2007/03/24 13:55:15	1.4
+++ /project/elephant/cvsroot/elephant/doc/Makefile	2007/03/30 23:36:52	1.5
@@ -8,3 +8,5 @@
 	makeinfo -v --html --css-include=style.css --force elephant.texinfo
 	makeinfo -v --html --css-include=style.css --force --no-split elephant.texinfo
 
+pdf: includes-stuff
+	texi2dvi --pdf elphant.texinfo
--- /project/elephant/cvsroot/elephant/doc/data-store-reference.texinfo	2007/03/30 17:28:50	1.3
+++ /project/elephant/cvsroot/elephant/doc/data-store-reference.texinfo	2007/03/30 23:36:52	1.4
@@ -38,10 +38,10 @@
 * Foreign libraries:: Using UFFI and ASDF to build or link foreign libraries
 @end menu
 
- at node Registration
+ at node DSR Registration
 @comment node-name, next, previous, up
 @section Registration
- at cindex Registration
+ at cindex Registration and Initialization
 
 Elephant looks at the first element of the specification list to
 determine which backend code base to use.  The master table for this
@@ -55,7 +55,13 @@
 
 @include includes/fun-elephant-backend-register-backend-con-init.texinfo
 
- at node Store Controllers
+If the backend requires any special user-specified configuration,
+augment the key types in config.sexp with what you need and use the
+following function to access.
+
+ at include includes/fun-elephant-backend-get-user-configuration-parameter.texinfo
+
+ at node DSR Store Controllers
 @comment node-name, next, previous, up
 @section Store Controllers
 @cindex Store Controllers
@@ -63,9 +69,10 @@
 Subclass store-controller and implement store and close controller
 which are called by open-store and close-store respectively.
 
- at include includes/class-elephant-backend-store-controller.texinfo
+ at include includes/class-elephant-store-controller.texinfo
 @include includes/fun-elephant-backend-open-controller.texinfo
 @include includes/fun-elephant-backend-close-controller.texinfo
+ at include includes/fun-elephant-backend-connection-is-indeed-open.texinfo
 
 For upgrading and opening legacy databases it is important that a
 store be able to indicate which version of elephant was used to create
@@ -79,21 +86,24 @@
 There are some utilities for serializing simple data without a
 serializer using the memutil package.
 
- at include 
-
-These functions are useful utilities for implementing
-store-controllers.
+ at include includes/fun-elephant-backend-serialize-database-version-key.texinfo
+ at include includes/fun-elephant-backend-serialize-database-version-value.texinfo
+ at include includes/fun-elephant-backend-deserialize-database-version-value.texinfo
 
- at include includes/fun-elephant-backend-get-con.texinfo
- at include includes/fun-elephant-backend-oid.texinfo
- at include includes/fun-elephant-backend-next-oid.texinfo
- at include includes/fun-elephant-backend-connection-is-indeed-open.texinfo
- at include includes/fun-elephant-get-user-configuration-parameter.texinfo
 
- at node Slot Access
+ at node DSR Persistent Objects and Slot Access
 @comment node-name, next, previous, up
 @section Slot Access
- at cindex Slot Access
+ at cindex Persistent Objects and Slot Access
+
+ at include includes/class-elephant-persistent.texinfo
+ at include includes/fun-elephant-backend-get-con.texinfo
+ at c @include includes/fun-elephant-backend-oid.texinfo
+
+All objects require a unique id.  During new object creation the
+backend is asked to produce a unique id.
+
+ at include includes/fun-elephant-backend-next-oid.texinfo
 
 These functions are called by the metaclass protocol to support
 operations on persistent class slots.
@@ -103,7 +113,7 @@
 @include includes/fun-elephant-backend-persistent-slot-boundp.texinfo
 @include includes/fun-elephant-backend-persistent-slot-makunbound.texinfo
 
- at node Collections
+ at node DSR Collections
 @comment node-name, next, previous, up
 @section Collections
 @cindex Collections
@@ -133,7 +143,12 @@
 @include includes/fun-elephant-get-index.texinfo
 @include includes/fun-elephant-remove-index.texinfo
 
- at node Cursors
+Critical to indexing and queries are the map operators for collections
+
+ at include includes/fun-elephant-map-btree.texinfo
+ at include includes/fun-elephant-map-index.texinfo
+
+ at node DSR Cursors
 @comment node-name, next, previous, up
 @section Cursors
 @cindex Cursors
@@ -143,22 +158,28 @@
 @c		#:cursor-oid
 @c		#:cursor-initialized-p
 
- at node Transactions
+ at node DSR Transactions
 @comment node-name, next, previous, up
 @section Transactions
 @cindex Transactions
 
- at c		#:*current-transaction*
- at c		#:make-transaction-record
- at c		#:transaction-store
- at c		#:transaction-object
-
- at c              #:execute-transaction
- at c		#:controller-start-transaction
- at c		#:controller-commit-transaction
- at c		#:controller-abort-transaction
+These functions must be implemented or stubbed in any
+backend.
+
+ at include includes/fun-elephant-backend-execute-transaction.texinfo
+ at include includes/fun-elephant-backend-controller-start-transaction.texinfo
+ at include includes/fun-elephant-backend-controller-commit-transaction.texinfo
+ at include includes/fun-elephant-backend-controller-abort-transaction.texinfo
+
+These are supporting functions and variables for implementing
+transactions.
+
+ at include includes/var-elephant-backend-star-current-transaction-star.texinfo
+ at include includes/fun-elephant-backend-make-transaction-record.texinfo
+ at include includes/fun-elephant-backend-transaction-store.texinfo
+ at include includes/fun-elephant-backend-transaction-object.texinfo
 
- at node Multithreading Considerations
+ at node DSR Multithreading Considerations
 @comment node-name, next, previous, up
 @section Multithreading Considerations
 @cindex Multithreading
@@ -166,7 +187,7 @@
 @c utils locks
 @c utils thread-vars
 
- at node Handling Serialization
+ at node DSR Handling Serialization
 @comment node-name, next, previous, up
 @section Handling Serialization
 @cindex Serialization
@@ -176,12 +197,12 @@
 @c		#:deserialize-from-base64-string
 @c		#:serialize-to-base64-string
 
- at node Memory utilities
+ at node DSR Memory utilities
 @comment node-name, next, previous, up
 @section Memory utilities
 @cindex Memory utilities
 
- at node Foreign libraries
+ at node DSR Foreign libraries
 @comment node-name, next, previous, up
 @section Foreign libraries
 @cindex Foreign libraries
--- /project/elephant/cvsroot/elephant/doc/make-ref.lisp	2007/03/30 14:34:34	1.5
+++ /project/elephant/cvsroot/elephant/doc/make-ref.lisp	2007/03/30 23:36:52	1.6
@@ -1,29 +1,39 @@
 (require 'asdf)
-(asdf:operate 'asdf:load-op 'elephant-tests)
+(asdf:operate 'asdf:load-op 'elephant)
+(load (merge-pathnames 
+       #p"src/elephant/query"
+       (asdf:component-pathname (asdf:find-system 'elephant))))
+
 (defparameter include-dir-path 
   (namestring 
    (merge-pathnames 
     #p"doc/includes/"
-    (asdf:component-pathname (asdf:find-system 'elephant-tests)))))
+    (asdf:component-pathname (asdf:find-system 'elephant)))))
 
 (defparameter docstrings-path
   (namestring 
    (merge-pathnames 
     #p"doc/docstrings.lisp"
-    (asdf:component-pathname (asdf:find-system 'elephant-tests)))))
+    (asdf:component-pathname (asdf:find-system 'elephant)))))
 
 (sb-posix:chdir include-dir-path)
 (load docstrings-path)
 
+(in-package :elephant)
+
+(defclass simple-store-controller (store-controller)
+  ())
+
 (defun make-docs ()
-  (elephant:open-store elephant-tests::*testbdb-spec*)
-  (make-instance 'elephant::persistent-collection)
-  (make-instance 'elephant::secondary-cursor)
-  (make-instance 'elephant::indexed-btree)
-  (sb-texinfo:generate-includes #p"/Users/eslick/Work/fsrc/elephant-cvs/doc/includes/" 
-				(find-package :elephant)
-				(find-package :elephant-backend)
-				(find-package :elephant-memutil) 
-				(find-package :elephant-system)))
+  (let ((sc (make-instance 'simple-store-controller)))
+    (setf (controller-spec sc) nil)
+    (make-instance 'elephant::persistent-collection :sc sc :from-oid 10)
+    (make-instance 'elephant::secondary-cursor)
+    (make-instance 'elephant::indexed-btree :sc sc :from-oid 10)
+    (sb-texinfo:generate-includes #p"/Users/eslick/Work/fsrc/elephant-cvs/doc/includes/" 
+				  (find-package :elephant)
+				  (find-package :elephant-backend)
+				  (find-package :elephant-memutil) 
+				  (find-package :elephant-system))))
 
 (make-docs)
--- /project/elephant/cvsroot/elephant/doc/reference.texinfo	2007/03/30 14:34:34	1.7
+++ /project/elephant/cvsroot/elephant/doc/reference.texinfo	2007/03/30 23:36:52	1.8
@@ -110,12 +110,15 @@
 @include includes/fun-elephant-get-value.texinfo
 @include includes/fun-elephant-setf-get-value.texinfo
 @include includes/fun-elephant-remove-kv.texinfo
+ at include includes/fun-elephant-map-btree.texinfo
+ at include includes/fun-elephant-map-index.texinfo
 
 @include includes/fun-elephant-add-index.texinfo
 @include includes/fun-elephant-get-index.texinfo
 @include includes/fun-elephant-get-primary-key.texinfo
 @include includes/fun-elephant-remove-index.texinfo
 
+
 @node Cursors
 @comment node-name, next, previous, up
 @section Cursors
@@ -125,7 +128,6 @@
 @include includes/class-elephant-secondary-cursor.texinfo
 @include includes/fun-elephant-make-cursor.texinfo
 @include includes/fun-elephant-cursor-close.texinfo
- at include includes/fun-elephant-map-btree.texinfo
 @include includes/macro-elephant-with-btree-cursor.texinfo
 
 @include includes/fun-elephant-cursor-current.texinfo
@@ -163,15 +165,10 @@
 
 @include includes/macro-elephant-with-transaction.texinfo
 
- at include includes/var-elephant-star-auto-commit-star.texinfo
- at include includes/var-elephant-star-current-transaction-star.texinfo
- at include includes/fun-elephant-start-ele-transaction.texinfo
- at include includes/fun-elephant-commit-transaction.texinfo
- at include includes/fun-elephant-abort-transaction.texinfo
-
 @node Migration and Upgrading
 @comment node-name, next, previous, up
 @section Migration and Upgrading
 @cindex Migration and Upgrading
 
 @include includes/fun-elephant-migrate.texinfo
+ at include includes/fun-elephant-upgrade.texinfo



From ieslick at common-lisp.net  Fri Mar 30 23:36:54 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 18:36:54 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070330233654.274C57B019@common-lisp.net>

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

Modified Files:
	backend.lisp classes.lisp collections.lisp controller.lisp 
	metaclasses.lisp serializer2.lisp variables.lisp 
Log Message:
Sanitize class indexing option; more documentation stuff

--- /project/elephant/cvsroot/elephant/src/elephant/backend.lisp	2007/03/30 17:46:14	1.14
+++ /project/elephant/cvsroot/elephant/src/elephant/backend.lisp	2007/03/30 23:36:53	1.15
@@ -76,6 +76,9 @@
    #:transaction-store
    #:transaction-object
    #:execute-transaction
+   #:controller-start-transaction
+   #:controller-abort-transaction
+   #:controller-commit-transaction
 
    ;; Registration
    #:register-backend-con-init
--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/24 12:16:03	1.24
+++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/30 23:36:53	1.25
@@ -47,30 +47,16 @@
 ;; METACLASS INITIALIZATION AND CHANGES
 ;; ================================================
 
-(defmethod ensure-class-using-class :around ((class null) name &rest args &key index)
-  "Support the :index class option"
-  (let ((result (apply #'call-next-method class name (remove-keywords '(:index) args))))
-    (when (and index (subtypep (type-of result) 'persistent-metaclass))
-      (update-indexed-record result nil :class-indexed t))
-    result))
-
-(defmethod ensure-class-using-class ((class persistent-metaclass) name &rest args &key index)
-  "Support the :index class option on redefinition"
-  (let ((result (apply #'call-next-method class name (remove-keywords '(:index) args))))
-    (when index
-      (update-indexed-record result nil :class-indexed t))
-    result))
-				     
-(defmethod shared-initialize :around ((class persistent-metaclass) slot-names &rest args &key direct-superclasses)
+(defmethod shared-initialize :around ((class persistent-metaclass) slot-names &rest args &key direct-superclasses index)
   "Ensures we inherit from persistent-object."
   (let* ((persistent-metaclass (find-class 'persistent-metaclass))
 	 (persistent-object (find-class 'persistent-object))
 	 (not-already-persistent (loop for superclass in direct-superclasses
 				       never (eq (class-of superclass) persistent-metaclass))))
+    (when index
+      (update-indexed-record class nil :class-indexed t))
     (if (and (not (eq class persistent-object)) not-already-persistent)
 	(apply #'call-next-method class slot-names
-;;	       :direct-superclasses (cons persistent-object
-;;					  direct-superclasses) args)
 	       :direct-superclasses (append direct-superclasses (list persistent-object)) args)
 	(call-next-method))))
 
--- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/25 14:57:49	1.19
+++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/03/30 23:36:53	1.20
@@ -339,15 +339,18 @@
 (defun lisp-compare-equal (a b)
   (equal a b))
 
+(defgeneric map-btree (fn btree &rest args &key start end value)
+  (:documentation   "Map btree maps over a btree from the value start to the value of end.
+   If values are not provided, then it maps over all values.  BTrees 
+   do not have duplicates, but map-btree can also be used with indices
+   in the case where you don't want access to the primary key so we 
+   require a value argument as well for mapping duplicate value sets."))
+
 ;; NOTE: the use of nil for the last element in a btree only works because the C comparison
 ;; function orders by type tag and nil is the highest valued type tag so nils are the last
 ;; possible element in a btree ordered by value.
+
 (defmethod map-btree (fn (btree btree) &rest args &key start end (value nil value-set-p))
-  "Map btree maps over a btree from the value start to the value of end.
-   If values are not provided, then it maps over all values.  BTrees 
-   do not have duplicates, but map-btree can also be used with indices
-   in the case where you don't want access to the primary key so we 
-   require a value argument as well for mapping duplicate value sets."
   (let ((end (if value-set-p value end)))
     (ensure-transaction (:store-controller (get-con btree))
       (with-btree-cursor (curs btree)
@@ -368,8 +371,8 @@
 		   (funcall fn k v)
 		   (return nil)))))))))
 
-(defmethod map-index (fn (index btree-index) &rest args &key start end (value nil value-set-p))
-  "Map-index is like map-btree but for secondary indices, it
+(defgeneric map-index (fn btree &rest args &key start end value)
+  (:documentation "Map-index is like map-btree but for secondary indices, it
    takes a function of three arguments: key, value and primary
    key.  As with map-btree the keyword arguments start and end
    determine the starting element and ending element, inclusive.
@@ -377,7 +380,9 @@
    the last element in the index.  If you want to traverse only a
    set of identical key values, for example all nil values, then
    use the value keyword which will override any values of start
-   and end."
+   and end."))
+
+(defmethod map-index (fn (index btree-index) &rest args &key start end (value nil value-set-p))
   (declare (dynamic-extent args)
 	   (ignorable args))
   (let ((sc (get-con index))
--- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp	2007/03/30 14:34:35	1.42
+++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp	2007/03/30 23:36:53	1.43
@@ -250,6 +250,12 @@
 	 (when (member ver (rest row) :test #'equal)) t)
     nil))
 
+(defgeneric upgrade (sc spec)
+  (:documentation "Given an open store controller from a prior version, 
+                   open a new store specified by spec and migrate the
+                   data from the original store to the new one, upgrading
+                   it to the latest version"))
+
 (defmethod upgrade ((sc store-controller) target-spec)
   (unless (upgradable-p sc)
     (error "Cannot upgrade ~A from version ~A to version ~A~%Valid upgrades are:~%~A" 
@@ -275,12 +281,16 @@
    associated with the database version that is opened."
   (cond ((prior-version-p (database-version sc) '(0 6 0))
 	 (setf (controller-serializer-version sc) 1)
-	 (setf (controller-serialize sc) 'elephant-serializer1::serialize)
-	 (setf (controller-deserialize sc) 'elephant-serializer1::deserialize))
+	 (setf (controller-serialize sc) 
+	       (intern "SERIALIZE" (find-package :ELEPHANT-SERIALIZER1)))
+	 (setf (controller-deserialize sc)
+	       (intern "DESERIALIZE" (find-package :ELEPHANT-SERIALIZER1))))
 	(t 
 	 (setf (controller-serializer-version sc) 2)
-	 (setf (controller-serialize sc) 'elephant-serializer2::serialize)
-	 (setf (controller-deserialize sc) 'elephant-serializer2::deserialize))))
+	 (setf (controller-serialize sc) 
+	       (intern "SERIALIZE" (find-package :ELEPHANT-SERIALIZER2)))
+	 (setf (controller-deserialize sc) 
+	       (intern "SERIALIZE" (find-package :ELEPHANT-SERIALIZER2))))))
 
 ;;
 ;; Handling package changes in legacy databases 
--- /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp	2007/03/23 16:08:10	1.13
+++ /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp	2007/03/30 23:36:53	1.14
@@ -23,8 +23,11 @@
 (declaim #-elephant-without-optimize (optimize (speed 3) (safety 1)))
 
 (defclass persistent ()
-  ((%oid :accessor oid :initarg :from-oid)
-   (dbconnection-spec-pst :type (or list string) :accessor dbcn-spc-pst :initarg :dbconnection-spec-pst))
+  ((%oid :accessor oid :initarg :from-oid
+	 :documentation "All persistent objects have an oid")
+   (dbconnection-spec-pst :type (or list string) :accessor dbcn-spc-pst :initarg :dbconnection-spec-pst
+			  :documentation "Persistent objects use a spec pointer to identify which store
+                                          they are connected to"))
   (:documentation "Abstract superclass for all persistent classes (common
     to user-defined classes and collections.)"))
 
--- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp	2007/03/30 14:34:35	1.34
+++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp	2007/03/30 23:36:53	1.35
@@ -24,8 +24,6 @@
   (:import-from :elephant 
 		*circularity-initial-hash-size*
 		get-cached-instance
-		controller-symbol-cache 
-		controller-symbol-id-cache
 		slot-definition-allocation
 		slot-definition-name
 		compute-slots
--- /project/elephant/cvsroot/elephant/src/elephant/variables.lisp	2007/03/30 17:45:41	1.13
+++ /project/elephant/cvsroot/elephant/src/elephant/variables.lisp	2007/03/30 23:36:53	1.14
@@ -64,10 +64,11 @@
 ;; properly load in asdf due to some circular dependencies
 ;; between lisp files 
 
-(eval-when (load-toplevel compile-toplevel)
+(eval-when (:compile-toplevel :load-toplevel)
   (mapcar (lambda (symbol)
 	    (intern symbol :elephant))
-	  '(get-cached-instance)))
+	  '("GET-CACHED-INSTANCE"
+	    "SET-DB-SYNCH")))
 
 
 



From ieslick at common-lisp.net  Fri Mar 30 23:42:35 2007
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 30 Mar 2007 18:42:35 -0500 (EST)
Subject: [elephant-cvs] CVS elephant/src/elephant
Message-ID: <20070330234235.4A753620C5@common-lisp.net>

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

Modified Files:
	controller.lisp 
Log Message:
Fixed symbol mgmt bug in serializer2 init

--- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp	2007/03/30 23:36:53	1.43
+++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp	2007/03/30 23:42:35	1.44
@@ -290,7 +290,7 @@
 	 (setf (controller-serialize sc) 
 	       (intern "SERIALIZE" (find-package :ELEPHANT-SERIALIZER2)))
 	 (setf (controller-deserialize sc) 
-	       (intern "SERIALIZE" (find-package :ELEPHANT-SERIALIZER2))))))
+	       (intern "DESERIALIZE" (find-package :ELEPHANT-SERIALIZER2))))))
 
 ;;
 ;; Handling package changes in legacy databases