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

[blee at common-lisp.net]

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

Modified Files:
	elephant.lisp 
Log Message:
weak hashes

Date: Thu Aug 26 19:57:52 2004
Author: blee

Index: elephant/src/elephant.lisp
diff -u elephant/src/elephant.lisp:1.1.1.1 elephant/src/elephant.lisp:1.2
--- elephant/src/elephant.lisp:1.1.1.1	Thu Aug 19 10:05:14 2004
+++ elephant/src/elephant.lisp	Thu Aug 26 19:57:52 2004
@@ -1,10 +1,80 @@
 (defpackage elephant
   (:nicknames ele :ele)
   (:use common-lisp sleepycat)
-  #+cmu
-  (:shadowing-import-from PCL find-class class-name built-in-class class-of)
-  (:export *store-controller* store-controller
-	   open-controller close-controller with-open-controller
-	   persistent persistent-class def-persistent-class
-	   serialize deserialize add-deserializer
-	   *current-transaction* with-transaction with-transaction-retries))
+  (:export *store-controller* *current-transaction* *auto-commit*
+	   store-controller open-controller close-controller 
+	   with-open-controller
+	   persistent persistent-object persistent-metaclass
+	   with-transaction with-transaction-retry)
+  #+cmu  
+  (:import-from :pcl
+		slot-definition-name
+		compute-slots)                                
+  ;; Hopefully SBCL = CMUCL except for package names (both using Gerd's PCL)
+  #+sbcl 
+  (:import-from :sb-mop 
+		slot-definition-name
+		compute-slots)
+  #+openmcl 
+  (:import-from :openmcl-mop
+		slot-definition-name
+		compute-slots)
+  #+allegro
+  (:import-from :clos
+		slot-definition-name
+		compute-slots)
+  #+lispworks  
+  (:import-from :clos
+		slot-definition-name
+		compute-slots)
+
+  )
+
+(in-package "ELEPHANT")
+
+;; Thread-local specials which control Elephant
+
+(defparameter *store-controller* nil 
+  "The store controller which persistent objects talk to.")
+(defvar *auto-commit* nil)
+
+
+;; Portable value-weak hash-tables for the cache: when the
+;; values are collected, the entries (keys) should be
+;; flushed from the table too
+
+(defun make-cache-table (&rest args)
+  #+(or cmu sbcl scl)
+  (apply #'make-hash-table args)
+  #+allegro
+  (apply #'make-hash-table :values :weak args)
+  #+lispworks
+  (apply #'make-hash-table :weak-kind :value args)
+  #-(or cmu sbcl scl allegro lispworks)
+  (apply #'make-hash-table args)
+  )
+
+(defun get-cache (key cache)
+  #+(or cmu sbcl scl)
+  (let ((val (gethash key cache)))
+    (if val (values (weak-pointer-value val) t)
+	(values nil nil)))
+  #-(or cmu sbcl scl)
+  (gethash key cache)
+  )
+
+(defun setf-cache (key cache value)
+  #+(or cmu sbcl scl)
+  (let ((w (make-weak-pointer value)))
+    (finalize value #'(lambda () (remhash key cache)))
+    (setf (gethash key cache) w)
+    value)
+  #+allegro
+  (progn
+    (excl:schedule-finalization value #'(lambda () (remhash key cache)))
+    (setf (gethash key cache) value))
+  #-(or cmu sbcl scl allegro)
+  (setf (gethash key cache) value)
+  )
+
+(defsetf get-cache setf-cache)