[bknr-cvs] r2503 - branches/trunk-reorg/bknr/datastore/src/data

[hhubner at common-lisp.net]

Author: hhubner
Date: Fri Feb 15 08:41:20 2008
New Revision: 2503

Modified:
   branches/trunk-reorg/bknr/datastore/src/data/object.lisp
Log:
Rename and document some things.


Modified: branches/trunk-reorg/bknr/datastore/src/data/object.lisp
==============================================================================
--- branches/trunk-reorg/bknr/datastore/src/data/object.lisp	(original)
+++ branches/trunk-reorg/bknr/datastore/src/data/object.lisp	Fri Feb 15 08:41:20 2008
@@ -5,8 +5,9 @@
 (cl-interpol:enable-interpol-syntax)
 
 (defclass store-object-subsystem ()
-  ((id-counter :initform 0
-	       :accessor id-counter)))
+  ((next-object-id :initform 0
+                   :accessor next-object-id
+                   :documentation "Next object ID to assign to a new object")))
 
 (defun store-object-subsystem ()
   (let ((subsystem (find-if (lambda (subsystem)
@@ -163,17 +164,16 @@
 	      (anonymous-transaction-transactions *current-transaction*)))
       (call-next-method)))
 
-(defmethod initialize-instance :after
-    ((object store-object) &key id &allow-other-keys)
+(defmethod initialize-instance :after ((object store-object) &key id &allow-other-keys)
   (let ((subsystem (store-object-subsystem)))
     (cond (id
 	   ;; during restore, use the given ID
-	   (when (>= id (id-counter subsystem))
-	     (setf (id-counter subsystem) (1+ id))))
+	   (when (>= id (next-object-id subsystem))
+	     (setf (next-object-id subsystem) (1+ id))))
 	  (t
 	   ;; normal transaction: assign a new ID
-	   (setf id (id-counter subsystem))
-	   (incf (id-counter subsystem))
+	   (setf id (next-object-id subsystem))
+	   (incf (next-object-id subsystem))
 	   (setf (slot-value object 'id) id)))))
 
 (defmethod print-object ((object store-object) stream)
@@ -476,9 +476,9 @@
 		     id slot-name (type-of container) (store-object-id container))
 	       (warn "Reference to inexistent object with id ~A from unnamed container, returning NIL." id))
 
-	   ;; noch die ID hochzaehlen wenn notwendig
-	   (when (>= id (id-counter (store-object-subsystem)))
-	     (setf (id-counter (store-object-subsystem)) (1+ id)))
+	   ;; Possibly determine new "current object id"
+	   (when (>= id (next-object-id (store-object-subsystem)))
+	     (setf (next-object-id (store-object-subsystem)) (1+ id)))
 	   nil)
 	  
 	  (t (error "Reference to inexistent object with id ~A from slot ~A of object ~A with ID ~A." id slot-name (type-of container)
@@ -512,7 +512,7 @@
     ;;; check on first instatiation of a class?
     (dolist (class-name (cons 'store-object (all-store-classes)))
       (clear-class-indices (find-class class-name)))
-    (setf (id-counter subsystem) 0)
+    (setf (next-object-id subsystem) 0)
     (when (probe-file snapshot)
       (format *trace-output* "loading snapshot file ~A~%" snapshot)
       (with-open-file (s snapshot
@@ -586,7 +586,7 @@
   (execute (make-instance 'transaction
 			  :function-symbol 'tx-make-object
 			  :args (append (list class-name
-					      :id (id-counter (store-object-subsystem)))
+					      :id (next-object-id (store-object-subsystem)))
 					initargs))))
 
 (defun tx-delete-object (id)