[rucksack-cvs] CVS rucksack
alemmens
alemmens at common-lisp.net
Fri Sep 1 13:57:08 UTC 2006
Update of /project/rucksack/cvsroot/rucksack
In directory clnet:/tmp/cvs-serv5855
Modified Files:
cache.lisp do.txt done.txt mop.lisp notes.txt objects.lisp
test-index-1a.lisp test-index-1b.lisp
test-schema-update-1a.lisp test-schema-update-1b.lisp
test-schema-update-1c.lisp
Log Message:
Get rid of the Lispworks specific PROCESS-A-SLOT-OPTION stuff and handle
the slot options in a way that's compatible with AMOP.
Remove INITARGS argument for UPDATE-PERSISTENT-INSTANCE-FOR-REDEFINED-CLASS,
because it turns out to be unnecessary (see details in notes.txt)
Add explanation to test-index-1a.lisp about the use of
(eval-when (:compile-toplevel :load-toplevel :execute) ...)
Replace *RUCKSACK* by RS in the test-*.lisp files.
--- /project/rucksack/cvsroot/rucksack/cache.lisp 2006/08/24 15:21:25 1.10
+++ /project/rucksack/cvsroot/rucksack/cache.lisp 2006/09/01 13:57:06 1.11
@@ -1,4 +1,4 @@
-;; $Id: cache.lisp,v 1.10 2006/08/24 15:21:25 alemmens Exp $
+;; $Id: cache.lisp,v 1.11 2006/09/01 13:57:06 alemmens Exp $
(in-package :rucksack)
@@ -249,8 +249,8 @@
"Checks for transaction conflicts and signals a transaction conflict
if necessary. Change the object's status to dirty. If the object is
already dirty, nothing happens."
- ;; This function is called by (setf slot-value-using-class),
- ;; slot-makunbound-using-class and p-data-write.
+ ;; This function is called by (SETF SLOT-VALUE-USING-CLASS),
+ ;; SLOT-MAKUNBOUND-USING-CLASS and P-DATA-WRITE.
(let ((object-id (object-id object))
(transaction (current-transaction)))
;; Check for transaction conflict.
--- /project/rucksack/cvsroot/rucksack/do.txt 2006/08/31 20:09:17 1.2
+++ /project/rucksack/cvsroot/rucksack/do.txt 2006/09/01 13:57:07 1.3
@@ -1,20 +1,8 @@
DO:
-- Handle initargs in LOAD-OBJECT and UPDATE-PERSISTENT-...
-
-- Initialize non-persistent slots during LOAD-OBJECT.
-
-- Figure out if there's a better way than
- (eval-when (:compile-toplevel :load-toplevel :execute) ...)
- to make sure that class definitions within a WITH-RUCKSACK are treated
- as top level definitions.
-
-- Maybe signal a continuable error when the in-memory class definition does
- not correspond to the most recent schema. If the user decides to
- continue, UPDATE-PERSISTENT-INSTANCE-... will be called when necessary.
-
- What about in-memory persistent instances when the class definition
- changes? We should make sure that those are updated too. There seem
+ changes? We should make sure that those are updated too. Some possible
+ strategies:
to be three strategies:
1. Rely on Lisp's normal UPDATE-INSTANCE-FOR-REDEFINED-CLASS mechanism.
Then the programmer must write methods for both UPDATE-INSTANCE-...
@@ -22,16 +10,17 @@
2. Remove all instances of the redefined class from the cache.
Then the objects will be loaded from disk again, and U-P-I-F-R-C will
be called automatically. This has the disadvantage that all values
- of transient slots will be gone.
+ of transient slots will be gone; then again, I'm not sure if transient
+ slots make much sense anyway for persistent objects.
+ CLHS says:
+ "Updating such an instance occurs at an implementation-dependent time,
+ but no later than the next time a slot of that instance is read or
+ written."
+ Maybe we can also hook into SLOT-VALUE-USING-CLASS and (SETF S-V-U-C)
+ to automatically reload the object. Or maybe write an after method on
+ Lisp's UPDATE-INSTANCE-FOR-REDEFINED-CLASS that calls UPDATE-PERSISTENT-...
3. Forbid it and signal some kind of error.
-- I'm not sure that :INCLUDE-SUBCLASSES NIL makes sense for
- RUCKSACK-MAP-SLOT. Think about this.
-
-- Does indexing in example-1 work correctly if we don't use
- *RUCKSACK* in WITH-RUCKSACK? Maybe WITH-RUCKSACK should always
- bind *RUCKSACK*?
-
- There's still a btree bug that's uncovered by the stress test.
Fix it.
@@ -47,7 +36,20 @@
from the transaction id). That's one step towards avoiding locks
on transaction commit.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+* MAYBE LATER
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+- Maybe signal a continuable error when the in-memory class definition does
+ not correspond to the most recent schema. If the user decides to
+ continue, UPDATE-PERSISTENT-INSTANCE-... will be called when necessary.
+
+- Think about non-persistent slots. Should we initialize them during
+ LOAD-OBJECT?
+
+- I'm not sure that :INCLUDE-SUBCLASSES NIL makes sense for
+ RUCKSACK-MAP-SLOT. Think about this.
+
- Deal with CHANGE-CLASS: call UPDATE-PERSISTENT-INSTANCE-FOR-DIFFERENT-CLASS
when necessary. (Maybe it's never necessary and we can just use the
existing UPDATE-INSTANCE-FOR-DIFFERENT-CLASS mechanism?)
-
--- /project/rucksack/cvsroot/rucksack/done.txt 2006/08/31 20:09:17 1.2
+++ /project/rucksack/cvsroot/rucksack/done.txt 2006/09/01 13:57:07 1.3
@@ -1,3 +1,17 @@
+* 2006-09-01
+
+- Get rid of the Lispworks-specific PROCESS-A-SLOT-OPTION stuff and handle
+ the slot options in a way that's compatible with AMOP.
+
+- Removed INITARGS argument for UPDATE-PERSISTENT-INSTANCE-FOR-REDEFINED-CLASS,
+ because it turns out not to be necessary (see details in notes.txt).
+
+- Add explanation to test-index-1a.lisp about the use of
+ (eval-when (:compile-toplevel :load-toplevel :execute) ...)
+
+- Replace *RUCKSACK* by RS in test-*.lisp.
+
+
* 2006-08-31
- Get rid of the Lispworks-specific PROCESS-A-CLASS-OPTION stuff and handle
--- /project/rucksack/cvsroot/rucksack/mop.lisp 2006/08/31 20:09:17 1.9
+++ /project/rucksack/cvsroot/rucksack/mop.lisp 2006/09/01 13:57:07 1.10
@@ -1,4 +1,4 @@
-;; $Id: mop.lisp,v 1.9 2006/08/31 20:09:17 alemmens Exp $
+;; $Id: mop.lisp,v 1.10 2006/09/01 13:57:07 alemmens Exp $
(in-package :rucksack)
@@ -110,20 +110,6 @@
(superclass standard-class))
t)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Processing class and slot options for objects of metaclass
-;;; PERSISTENT-CLASS.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-#+lispworks
-(defmethod clos:process-a-slot-option ((class persistent-class)
- option
- value
- already-processed-options
- slot)
- (if (member option '(:index :persistence :unique))
- (list* option value already-processed-options)
- (call-next-method)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Initializing the persistent-class metaobjects
--- /project/rucksack/cvsroot/rucksack/notes.txt 2006/08/31 15:53:57 1.1
+++ /project/rucksack/cvsroot/rucksack/notes.txt 2006/09/01 13:57:07 1.2
@@ -1,9 +1,10 @@
-;; $Id: notes.txt,v 1.1 2006/08/31 15:53:57 alemmens Exp $
+;; $Id: notes.txt,v 1.2 2006/09/01 13:57:07 alemmens Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Some random notes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
* UPDATE-PERSISTENT-INSTANCE-FOR-REDEFINED-CLASS & friends.
What should we do when the class has been redefined more than once
@@ -36,3 +37,23 @@
the names of the slots that were added and the slots that were discarded
(by the most recent version, compared to this version).
+
+* Handling initargs in LOAD-OBJECT and UPDATE-PERSISTENT-INSTANCE-...
+
+Actually, initargs are only relevant for slots that have been added by
+a class redefinition, so they're only relevant for
+UPDATE-PERSISTENT-INSTANCE-... (This is because objects created by
+LOAD-OBJECT are disk versions of object that have once been
+initialized by Lisp's normal INITIALIZE-INSTANCE methods, which
+already took care of the initargs when the object was created for the
+first time.)
+
+Looking at the CLHS description of
+UPDATE-INSTANCE-FOR-REDEFINED-CLASS, I think that
+UPDATE-PERSISTENT-INSTANCE-... doesn't need to handle initargs at all:
+
+ "The generic function update-instance-for-redefined-class also takes
+ any number of initialization arguments. When it is called by the system
+ to update an instance whose class has been redefined, no initialization
+ arguments are provided."
+
--- /project/rucksack/cvsroot/rucksack/objects.lisp 2006/08/31 15:47:58 1.14
+++ /project/rucksack/cvsroot/rucksack/objects.lisp 2006/09/01 13:57:07 1.15
@@ -1,4 +1,4 @@
-;; $Id: objects.lisp,v 1.14 2006/08/31 15:47:58 alemmens Exp $
+;; $Id: objects.lisp,v 1.15 2006/09/01 13:57:07 alemmens Exp $
(in-package :rucksack)
@@ -771,18 +771,21 @@
;; the slot names and values for slots that were discarded and had values.
(defgeneric update-persistent-instance-for-redefined-class
- (instance added-slots discarded-slots property-list
- &rest initargs &key &allow-other-keys)
+ (instance added-slots discarded-slots property-list &key)
(:method ((instance persistent-object) added-slots discarded-slots property-list
- &rest initargs &key &allow-other-keys)
+ &key)
;; Default method: ignore the discarded slots and initialize added slots
- ;; according to their initargs or initforms.
+ ;; according to their initfunctions.
(let ((slots (class-slots (class-of instance))))
(loop for slot-name in added-slots
for slot = (find slot-name slots :key #'slot-definition-name)
for initfunction = (and slot
(slot-definition-initfunction slot))
when initfunction
- ;; DO: Handle initargs!
+ ;; NOTE: We don't handle initargs, and I think we don't need to.
+ ;; We follow the CLHS description of UPDATE-INSTANCE-FOR-REDEFINED-CLASS,
+ ;; which says: "When it is called by the system to update an
+ ;; instance whose class has been redefined, no initialization
+ ;; arguments are provided."
do (setf (slot-value instance slot-name) (funcall initfunction))))))
--- /project/rucksack/cvsroot/rucksack/test-index-1a.lisp 2006/08/31 20:09:18 1.2
+++ /project/rucksack/cvsroot/rucksack/test-index-1a.lisp 2006/09/01 13:57:07 1.3
@@ -1,4 +1,4 @@
-;; $Id: test-index-1a.lisp,v 1.2 2006/08/31 20:09:18 alemmens Exp $
+;; $Id: test-index-1a.lisp,v 1.3 2006/09/01 13:57:07 alemmens Exp $
(in-package :rucksack-test)
@@ -20,10 +20,16 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
+ ;; NOTE: The EVAL-WHEN above is necessary to ensure that the compiler
+ ;; 'knows about' the HACKER class when it compiles the PRINT-OBJECT method
+ ;; for HACKER. We could avoid this by splitting this file into two:
+ ;; the first one would contain the class definitions, and the second
+ ;; would contain everything else (especially methods that specialize on one
+ ;; of the classes defined in the first one).
(defparameter *hacker-rucksack* #p"/tmp/rucksack/hackers/")
- (with-rucksack (*rucksack* *hacker-rucksack* :if-exists :supersede)
+ (with-rucksack (rs *hacker-rucksack* :if-exists :supersede)
(with-transaction ()
;; We define some persistent classes with indexed slots.
@@ -54,31 +60,31 @@
(name hacker))))
(defun create-hackers ()
- (with-rucksack (*rucksack* *hacker-rucksack*)
+ (with-rucksack (rs *hacker-rucksack*)
;; Fill the rucksack with some hackers.
(with-transaction ()
(loop repeat 20
do (make-instance 'hacker))
(loop repeat 10
do (make-instance 'lisp-hacker))
- (rucksack-map-class *rucksack* 'hacker #'print))))
+ (rucksack-map-class rs 'hacker #'print))))
(defun show-hackers ()
- (with-rucksack (*rucksack* *hacker-rucksack*)
+ (with-rucksack (rs *hacker-rucksack*)
(with-transaction ()
(print "Hackers indexed by object id.")
- (rucksack-map-class *rucksack* 'hacker #'print)
+ (rucksack-map-class rs 'hacker #'print)
(print "Hackers indexed by name.")
- (rucksack-map-slot *rucksack* 'hacker 'name #'print)
+ (rucksack-map-slot rs 'hacker 'name #'print)
(print "Hackers indexed by hacker-id.")
- (rucksack-map-slot *rucksack* 'hacker 'id #'print)
+ (rucksack-map-slot rs 'hacker 'id #'print)
(print "Lisp hackers.")
- (rucksack-map-class *rucksack* 'lisp-hacker #'print)
+ (rucksack-map-class rs 'lisp-hacker #'print)
(print "Non-lisp hackers.")
- (rucksack-map-class *rucksack* 'hacker #'print
+ (rucksack-map-class rs 'hacker #'print
:include-subclasses nil)
(print "Hacker object ids.")
- (rucksack-map-class *rucksack* 'hacker #'print
+ (rucksack-map-class rs 'hacker #'print
:id-only t))))
--- /project/rucksack/cvsroot/rucksack/test-index-1b.lisp 2006/08/31 15:50:27 1.1
+++ /project/rucksack/cvsroot/rucksack/test-index-1b.lisp 2006/09/01 13:57:07 1.2
@@ -1,4 +1,4 @@
-;; $Id: test-index-1b.lisp,v 1.1 2006/08/31 15:50:27 alemmens Exp $
+;; $Id: test-index-1b.lisp,v 1.2 2006/09/01 13:57:07 alemmens Exp $
(in-package :rs-test)
@@ -23,7 +23,7 @@
;;; (3) the index has been filled with the new values for the age slot.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(with-rucksack (*rucksack* *hacker-rucksack*)
+(with-rucksack (rs *hacker-rucksack*)
(with-transaction ()
;; For classes that may change during program development, you should
@@ -46,10 +46,10 @@
(:index t))))
(defun show-hackers-by-age ()
- (with-rucksack (*rucksack* *hacker-rucksack*)
+ (with-rucksack (rs *hacker-rucksack*)
(with-transaction ()
(print "Hackers by age.")
- (rucksack-map-slot *rucksack* 'hacker 'age
+ (rucksack-map-slot rs 'hacker 'age
(lambda (hacker)
(format t "~&~A has age ~D.~%"
(name hacker)
--- /project/rucksack/cvsroot/rucksack/test-schema-update-1a.lisp 2006/08/31 15:47:58 1.1
+++ /project/rucksack/cvsroot/rucksack/test-schema-update-1a.lisp 2006/09/01 13:57:07 1.2
@@ -1,4 +1,4 @@
-;; $Id: test-schema-update-1a.lisp,v 1.1 2006/08/31 15:47:58 alemmens Exp $
+;; $Id: test-schema-update-1a.lisp,v 1.2 2006/09/01 13:57:07 alemmens Exp $
(in-package :rucksack-test-schema-update)
@@ -19,7 +19,7 @@
(defparameter *dir* #P"/tmp/rucksack/schema-update/")
- (with-rucksack (*rucksack* *dir* :if-exists :supersede)
+ (with-rucksack (rs *dir* :if-exists :supersede)
(with-transaction ()
(defclass person ()
@@ -41,16 +41,16 @@
(age person))))
;; Create some persons.
-(with-rucksack (*rucksack* *dir*)
+(with-rucksack (rs *dir*)
(with-transaction ()
(loop repeat 10
do (make-instance 'person))))
;; Show them.
-(with-rucksack (*rucksack* *dir*)
+(with-rucksack (rs *dir*)
(with-transaction ()
- (rucksack-map-class *rucksack* 'person #'print)))
+ (rucksack-map-class rs 'person #'print)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sample output
--- /project/rucksack/cvsroot/rucksack/test-schema-update-1b.lisp 2006/08/31 15:47:58 1.1
+++ /project/rucksack/cvsroot/rucksack/test-schema-update-1b.lisp 2006/09/01 13:57:07 1.2
@@ -1,4 +1,4 @@
-;; $Id: test-schema-update-1b.lisp,v 1.1 2006/08/31 15:47:58 alemmens Exp $
+;; $Id: test-schema-update-1b.lisp,v 1.2 2006/09/01 13:57:07 alemmens Exp $
(in-package :rucksack-test-schema-update)
@@ -15,7 +15,7 @@
;;
(eval-when (:compile-toplevel :load-toplevel :execute)
- (with-rucksack (*rucksack* *dir*)
+ (with-rucksack (rs *dir*)
(with-transaction ()
(defclass person ()
@@ -50,7 +50,7 @@
;; Create some persons with the new class definition.
-(with-rucksack (*rucksack* *dir*)
+(with-rucksack (rs *dir*)
(with-transaction ()
(loop repeat 10
do (make-instance 'person))))
@@ -60,11 +60,11 @@
;; update them and we want to keep a few old instances for the next
;; part of the test).
-(with-rucksack (*rucksack* *dir*)
+(with-rucksack (rs *dir*)
(with-transaction ()
- (let ((cache (rucksack-cache *rucksack*))
+ (let ((cache (rucksack-cache rs))
(count 0))
- (rucksack-map-class *rucksack* 'person
+ (rucksack-map-class rs 'person
(lambda (id)
(when (evenp count)
(print (cache-get-object id cache)))
--- /project/rucksack/cvsroot/rucksack/test-schema-update-1c.lisp 2006/08/31 15:47:58 1.1
+++ /project/rucksack/cvsroot/rucksack/test-schema-update-1c.lisp 2006/09/01 13:57:07 1.2
@@ -1,4 +1,4 @@
-;; $Id: test-schema-update-1c.lisp,v 1.1 2006/08/31 15:47:58 alemmens Exp $
+;; $Id: test-schema-update-1c.lisp,v 1.2 2006/09/01 13:57:07 alemmens Exp $
(in-package :rucksack-test-schema-update)
@@ -14,7 +14,7 @@
;;
(eval-when (:compile-toplevel :load-toplevel :execute)
- (with-rucksack (*rucksack* *dir*)
+ (with-rucksack (rs *dir*)
(with-transaction ()
(defclass person ()
@@ -73,15 +73,15 @@
;; Create some persons with the second version of the class definition.
-(with-rucksack (*rucksack* *dir*)
+(with-rucksack (rs *dir*)
(with-transaction ()
(loop repeat 10
do (make-instance 'person))))
;; Show all persons (for three versions of the class definition).
-(with-rucksack (*rucksack* *dir*)
+(with-rucksack (rs *dir*)
(with-transaction ()
- (rucksack-map-class *rucksack* 'person #'print)))
+ (rucksack-map-class rs 'person #'print)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sample output
More information about the rucksack-cvs
mailing list