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

[blee at common-lisp.net]

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

Modified Files:
	utils.lisp 
Log Message:
fixed macro arg (dynamic, not lexical) / typo
fixed finalizer in allegro (don't close over the value or it
will never be collected)

Date: Sat Sep  4 10:23:30 2004
Author: blee

Index: elephant/src/utils.lisp
diff -u elephant/src/utils.lisp:1.4 elephant/src/utils.lisp:1.5
--- elephant/src/utils.lisp:1.4	Thu Sep  2 16:47:31 2004
+++ elephant/src/utils.lisp	Sat Sep  4 10:23:30 2004
@@ -121,8 +121,8 @@
 
 ;; Good defaults for elephant
 (defmacro with-transaction ((&key transaction 
-				  (environment (controller-environment
-						*store-controller*))
+				  (environment '(controller-environment
+						 *store-controller*))
 				  (parent '*current-transaction*)
 				  dirty-read txn-nosync
 				  txn-nowait txn-sync
@@ -135,7 +135,7 @@
 				:txn-nosync ,txn-nosync
 				:txn-nowait ,txn-nowait
 				:txn-sync ,txn-sync
-				:retries ,100)
+				:retries ,retries)
     , at body))
 
 
@@ -165,15 +165,22 @@
   (gethash key cache)
   )
 
+(defun make-finalizer (key cache)
+  #+(or cmu sbcl)
+  (lambda () (remhash key cache))
+  #+allegro
+  (lambda (obj) (declare (ignore obj)) (remhash key cache))
+  )
+
 (defun setf-cache (key cache value)
   #+(or cmu sbcl)
   (let ((w (make-weak-pointer value)))
-    (finalize value #'(lambda () (remhash key cache)))
+    (finalize value (make-finalizer key cache))
     (setf (gethash key cache) w)
     value)
   #+allegro
   (progn
-    (excl:schedule-finalization value #'(lambda () (remhash key cache)))
+    (excl:schedule-finalization value (make-finalizer key cache))
     (setf (gethash key cache) value))
   #-(or cmu sbcl scl allegro)
   (setf (gethash key cache) value)