commit 09212af02b098c1d067065c645c43bc0a4b72954
parent 8e206af9049496c9c07b904693c551b7b63f7f5b
Author: Tomas Hlavaty <tom@logand.com>
Date: Mon, 8 Aug 2011 00:53:05 +0200
*instance-collector-cache* added so that repeated x-select works with cached query compilation
Diffstat:
| M | orm.lisp | | | 55 | ++++++++++++++++++++++++++++++++++++------------------- |
1 file changed, 36 insertions(+), 19 deletions(-)
diff --git a/orm.lisp b/orm.lisp
@@ -93,24 +93,34 @@
(trace 2sql:execute)
+(defparameter *instance-collector-cache* nil) ;; equal form->fn
+
+(defmacro with-instance-collector-cache (args &body body)
+ (declare (ignore args))
+ `(let ((*instance-collector-cache* (make-hash-table :test #'equal)))
+ ,@body))
+
(2sql-backend:with-postgresql-connection ("pokus" "tomas" "test123" "localhost")
- (2sql:query () '(q:drop-sequence oid-seq t))
- (2sql:query () '(q:create-sequence oid-seq))
- (with-tables (t1 t2)
- (make-pinstance 't1 :c1 1 :c2 2 :c3 3)
- (make-pinstance 't1 :c1 1 :c2 2)
- (2sql:query () '(q:select :* (q:from t1)))
-
- #+nil
- (x-query ()
- '(q:select ((x-instance t1 x) (q:sum x.c1))
- (q:from (q:as t1 x))))
- ;;(x-query () '(q:select ((x-instance t1)) (q:from t1)))
- (x-query ()
- '(q:select ((x-instance t1 a) (x-instance t2 b) a.c2)
- (q:from (q:left-join (q:as t1 a) (q:as t2 b) (q:= a.c1 b.d1)))))
- ;;(x-query () '(q:select ((x-instance t1)) (q:from t1))) ;; doesnt work 2nd time
- ))
+ (with-instance-collector-cache ()
+ (2sql:query () '(q:drop-sequence oid-seq t))
+ (2sql:query () '(q:create-sequence oid-seq))
+ (with-tables (t1 t2)
+ (make-pinstance 't1 :c1 1 :c2 2 :c3 3)
+ (make-pinstance 't1 :c1 1 :c2 2)
+ (2sql:query () '(q:select :* (q:from t1)))
+
+ #+nil
+ (x-query ()
+ '(q:select ((x-instance t1 x) (q:sum x.c1))
+ (q:from (q:as t1 x))))
+ ;;(x-query () '(q:select ((x-instance t1)) (q:from t1)))
+ (x-query ()
+ '(q:select ((x-instance t1 a) (x-instance t2 b) a.c2)
+ (q:from (q:left-join (q:as t1 a) (q:as t2 b) (q:= a.c1 b.d1)))))
+ ;; this works 2nd time only with *instance-collector-cache*
+ ;;(x-query () '(q:select ((x-instance t1)) (q:from t1)))
+ ;;(x-query () '(q:select ((x-instance t1)) (q:from t1)))
+ )))
;;(defparameter *x-alias-to-table* nil)
(defparameter *x-instance-collectors* nil) ;; list fn
@@ -124,8 +134,15 @@
(*x-instance-collectors* nil) ;; TODO that's not right is it? need to remember form->collector! for subsequent queries
(rows (2sql:query ,args ,form)))
;;(maphash (lambda (k v) (print (list :@@@ k v))) *x-alias-to-table*)
- (setq *x-instance-collectors* (nreverse *x-instance-collectors*))
- (print *x-instance-collectors*)
+ (multiple-value-bind (value present)
+ (gethash ,form *instance-collector-cache*)
+ (cond
+ (present
+ (assert (not *x-instance-collectors*))
+ (setq *x-instance-collectors* (gethash ,form *instance-collector-cache*)))
+ (t
+ (setq *x-instance-collectors* (nreverse *x-instance-collectors*))
+ (setf (gethash ,form *instance-collector-cache*) *x-instance-collectors*))))
(loop
for row in rows
for tail = row
