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)