From bab5e8056e3850cd9fb0582f73955aee5abf010b Mon Sep 17 00:00:00 2001
From: Nathan Bird <nathan@acceleration.net>
Date: Mon, 4 Jul 2011 15:40:44 -0400
Subject: [PATCH] Adding to utils make-weak-hash-table for use in caches.

Currently used for
 * *output-hash*: caching generated SQL strings
 * oodml records cache
---
 sql/expressions.lisp |  8 +++-----
 sql/oodml.lisp       |  7 ++-----
 sql/utils.lisp       | 19 +++++++++++++++++++
 3 files changed, 24 insertions(+), 10 deletions(-)

diff --git a/sql/expressions.lisp b/sql/expressions.lisp
index bee6faf..4a6eb63 100644
--- a/sql/expressions.lisp
+++ b/sql/expressions.lisp
@@ -139,11 +139,9 @@
 
 
 (defvar *output-hash*
-  #+sbcl
-  (make-hash-table :test #'equal :synchronized T :weakness :key-and-value)
-  #-sbcl
-  (make-hash-table :test #'equal )
-  "For caching generated SQL strings.")
+      (make-weak-hash-table :test #'equal)
+  "For caching generated SQL strings, set to NIL to disable."
+  )
 
 (defmethod output-sql :around ((sql t) database)
   (if (null *output-hash*)
diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index 6397fa8..d38d3b9 100644
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -1344,11 +1344,8 @@ as elements of a list."
 (defun (setf records-cache-results) (results targets qualifiers database)
   (unless (record-caches database)
     (setf (record-caches database)
-          (make-hash-table :test 'equal
-                           #+allegro   :values    #+allegro :weak
-                           #+clisp     :weak      #+clisp :value
-                           #+lispworks :weak-kind #+lispworks :value)))
-  (setf (gethash (compute-records-cache-key targets qualifiers)
+          (make-weak-hash-table :test 'equal)))
+  (setf (gethash (compute-records-cache-key (copy-list targets) qualifiers)
                  (record-caches database)) results)
   results)
 
diff --git a/sql/utils.lisp b/sql/utils.lisp
index 60fedc3..6e4230d 100644
--- a/sql/utils.lisp
+++ b/sql/utils.lisp
@@ -405,3 +405,22 @@ removed. keys are searched with #'MEMBER"
           unless (member k keys-to-remove)
             collect k and collect v
           while rest)))
+
+(defmacro make-weak-hash-table (&rest args)
+  "Creates a weak hash table for use in a cache."
+  `(progn
+
+    ;;NB: These are generally used for caches that may not have an alternate
+    ;;clearing mechanism. If you are on an implementation that doesn't support
+    ;;weak hash tables then you're memory may accumulate.
+
+    #-(or sbcl allegro clisp lispworks)
+    (warn "UNSAFE! use of weak hash on implementation without support. (see clsql/sql/utils.lisp to add)")
+
+    (make-hash-table
+      #+allegro   :values    #+allegro :weak
+      #+clisp     :weak      #+clisp :value
+      #+lispworks :weak-kind #+lispworks :value
+      #+sbcl :weakness #+sbcl :value
+      ,@args)
+    ))
-- 
2.34.1