[elephant-cvs] CVS update: elephant/src/metaclasses.lisp

[blee at common-lisp.net]

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp.net:/tmp/cvs-serv25836/src

Modified Files:
	metaclasses.lisp 
Log Message:
docstrings
changeover to buffer-streams

Date: Thu Sep 16 06:19:12 2004
Author: blee

Index: elephant/src/metaclasses.lisp
diff -u elephant/src/metaclasses.lisp:1.4 elephant/src/metaclasses.lisp:1.5
--- elephant/src/metaclasses.lisp:1.4	Thu Sep  2 09:15:48 2004
+++ elephant/src/metaclasses.lisp	Thu Sep 16 06:19:12 2004
@@ -49,7 +49,8 @@
 to user-defined classes and collections.)"))
 
 (defclass persistent-metaclass (standard-class)
-  ())
+  ()
+  (:documentation "Metaclass for persistent classes."))
 
 (defclass persistent-slot-definition (standard-slot-definition)
   ())
@@ -81,6 +82,8 @@
   :class)
 
 (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."
   (let ((allocation-key (getf initargs :allocation))
 	(transient-p (getf initargs :transient)))
     (when (consp transient-p) (setq transient-p (car transient-p)))
@@ -94,9 +97,11 @@
 	   (find-class 'persistent-direct-slot-definition)))))
 
 (defmethod validate-superclass ((class persistent-metaclass) (super standard-class))
+  "Persistent classes may inherit from ordinary classes."
   t)
 
 (defmethod validate-superclass ((class standard-class) (super persistent-metaclass))
+  "Ordinary classes may NOT inherit from persistent classes."
   nil)
 
 (defgeneric persistent-p (class))
@@ -111,6 +116,8 @@
   t)
 
 (defmethod effective-slot-definition-class ((class persistent-metaclass) &rest initargs)
+  "Chooses the persistent or transient effective slot
+definition class depending on the keyword."
   (let ((transient-p (getf initargs :transient)))
     (when (consp transient-p) (setq transient-p (car transient-p)))
     (cond (transient-p
@@ -193,17 +200,17 @@
 
 (defmacro persistent-slot-reader (instance name)
   `(progn
-    (buffer-write-int (oid ,instance) *key-buf*)
-    (let* ((key-length (serialize ,name *key-buf*))
-	   (buf (db-get-key-buffered 
-		 (controller-db *store-controller*) 
-		 (buffer-stream-buffer *key-buf*)
-		 key-length)))
-      (if buf (deserialize buf)
-	  #+cmu
-	  (error 'unbound-slot :instance ,instance :slot ,name)
-	  #-cmu
-	  (error 'unbound-slot :instance ,instance :name ,name)))))
+    (with-buffer-streams (key-buf value-buf)
+      (buffer-write-int (oid ,instance) key-buf)
+      (serialize ,name key-buf)
+      (let ((buf (db-get-key-buffered 
+		  (controller-db *store-controller*) 
+		  key-buf value-buf)))
+	(if buf (deserialize buf)
+	    #+cmu
+	    (error 'unbound-slot :instance ,instance :slot ,name)
+	    #-cmu
+	    (error 'unbound-slot :instance ,instance :name ,name))))))
 
 #+(or cmu sbcl)
 (defun make-persistent-reader (name)
@@ -214,14 +221,14 @@
 
 (defmacro persistent-slot-writer (new-value instance name)
   `(progn
-    (buffer-write-int (oid ,instance) *key-buf*)
-    (let ((key-length (serialize ,name *key-buf*))
-	  (val-length (serialize ,new-value *out-buf*)))
+    (with-buffer-streams (key-buf value-buf)
+      (buffer-write-int (oid ,instance) key-buf)
+      (serialize ,name key-buf)
+      (serialize ,new-value value-buf)
       (db-put-buffered (controller-db *store-controller*) 
-		       (buffer-stream-buffer *key-buf*) key-length
-		       (buffer-stream-buffer *out-buf*) val-length
-		       :transaction *current-transaction*
-		       :auto-commit *auto-commit*)
+       key-buf value-buf
+       :transaction *current-transaction*
+       :auto-commit *auto-commit*)
       ,new-value)))
 
 #+(or cmu sbcl)
@@ -233,13 +240,13 @@
 
 (defmacro persistent-slot-boundp (instance name)
   `(progn
-    (buffer-write-int (oid ,instance) *key-buf*)
-    (let* ((key-length (serialize ,name *key-buf*))
-	   (buf (db-get-key-buffered 
-		 (controller-db *store-controller*) 
-		 (buffer-stream-buffer *key-buf*)
-		 key-length)))
-      (if buf T nil))))
+    (with-buffer-streams (key-buf value-buf)
+      (buffer-write-int (oid ,instance) key-buf)
+      (serialize ,name key-buf)
+      (let ((buf (db-get-key-buffered 
+		  (controller-db *store-controller*) 
+		  key-buf value-buf)))
+	(if buf T nil)))))
 
 #+(or cmu sbcl)
 (defun make-persistent-slot-boundp (name)