cl-2sql

commit 8039911be01ca79fc2c87fc646e276646605ad0c
parent aa3ade3e5295a4464e080d5fcfaaad5a8be824b2
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun,  7 Aug 2011 20:58:11 +0200

cache-delayed-query added

Diffstat:
M
compiler.lisp
 | 
25
++++++++++---------------

1 file changed, 10 insertions(+), 15 deletions(-)
diff --git a/compiler.lisp b/compiler.lisp
@@ -52,16 +52,15 @@
 (defmacro query1 (form &rest qvars)
   `(caar (query ,form ,@qvars)))
 
-#+nil
-(let ((fn '(lambda ,qvars (query ,form))))
-  (print (list :@@@ fn))
-  (or (when *delayed-query-cache*
-        (or (when (gethash fn *delayed-query-cache*)
-              (print (list :@@@-reusing (gethash fn *delayed-query-cache*)))
-              (gethash fn *delayed-query-cache*))
-            (setf (gethash fn *delayed-query-cache*)
-                  (compile nil fn))))
-      (compile nil fn)))
+(defmacro cache-delayed-query (form qvars)
+  `(let ((fn '(lambda ,qvars (query ,form))))
+     (print (list :@@@ fn))
+     (or (when *delayed-query-cache*
+           (or (when (gethash fn *delayed-query-cache*)
+                 (print (list :@@@-reusing (gethash fn *delayed-query-cache*)))
+                 (gethash fn *delayed-query-cache*))
+               (setf (gethash fn *delayed-query-cache*) (compile nil fn))))
+         (compile nil fn))))
 
 (defun when-backend-known (form qvars action env)
   (cond
@@ -73,11 +72,7 @@
      `(funcall
        (lambda ,qvars
          (assert *backend*)
-         ;; TODO caching?
-         (funcall (compile nil '(lambda ,qvars
-                                 (declare (ignorable ,@qvars))
-                                 (,action ,form)))
-                  ,@qvars))
+         (funcall (cache-delayed-query ,form ,qvars) ,@qvars))
        ,@qvars))))
 
 (defmacro execute-action (form)