cl-2sql

Lisp to SQL compiler for Common Lisp
git clone https://logand.com/git/cl-2sql.git/
Log | Files | Refs | README | LICENSE

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:
Morm.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