optimization of queries that select slot values only
Mon Oct 19 06:33:08 PDT 2009 tomi.borbely@gmail.com
* optimization of queries that select slot values only
(select ((a-of instance))
(from (instance class))
selected each prefetched slot, if the 'a was not mapped by the identity-mapper (e.g. (or null ...)).
Now it selects only the queried slots (except if it is set-valued or executed in lisp).
Warning: CRC errors found. These are probably harmless but should be repaired.
See 'darcs gzcrcs --help' for more information.
diff -rN -u old-cl-perec/dimensional/store.lisp new-cl-perec/dimensional/store.lisp
--- old-cl-perec/dimensional/store.lisp 2014-07-13 10:30:59.000000000 -0700
+++ new-cl-perec/dimensional/store.lisp 2014-07-13 10:31:00.000000000 -0700
@@ -350,9 +350,10 @@
;;(if (slot-boundp h-instance ',h-slot-name) KLUDGE fix query compiler
;; (slot-value h-instance ',h-slot-name)
;; ,+unbound-slot-marker+)
- (or (and (not (slot-boundp h-instance ',h-slot-name))
- ,+unbound-slot-marker+)
- (slot-value h-instance ',h-slot-name)))
+ (identity ;; this is not mapped to sql
+ (or (and (not (slot-boundp h-instance ',h-slot-name))
+ ,+unbound-slot-marker+)
+ (slot-value h-instance ',h-slot-name))))
(from (h-instance ,h-class-name))
(where (and (eq (d-instance-of h-instance) d-instance)
(or
diff -rN -u old-cl-perec/query/plan.lisp new-cl-perec/query/plan.lisp
--- old-cl-perec/query/plan.lisp 2014-07-13 10:30:59.000000000 -0700
+++ new-cl-perec/query/plan.lisp 2014-07-13 10:31:00.000000000 -0700
@@ -389,13 +389,20 @@
(query (query-of projection))
(collects (collects-of query))
((:values sql-exprs lisp-exprs) (to-sql* collects)))
- (if (and (null lisp-exprs)
- (or (typep query 'subselect)
- (every [or (sql-text-p !1) (has-identity-reader-p (persistent-type-of !1))] collects)))
- (progn
- (setf (binder-of sql-query) (field-binder collects)
- (columns-of sql-query) sql-exprs)
- sql-query)
+ (if (null lisp-exprs)
+ (cond
+ ((or (typep query 'subselect)
+ (every [or (sql-text-p !1) (has-identity-reader-p (persistent-type-of !1))] collects))
+ (setf (binder-of sql-query) (field-binder collects)
+ (columns-of sql-query) sql-exprs)
+ sql-query)
+ ((every [not (set-type-p* (persistent-type-of !1))] collects)
+ (setf (binder-of sql-query) (field-binder collects)
+ (columns-of sql-query) sql-exprs
+ (binder-of projection) (identity-binder collects))
+ projection)
+ (t
+ projection))
projection))) ;; all needed table is joined?
(t
projection)))
@@ -764,13 +771,25 @@
`((,index 0) ,@bindings)
exprs)))
+(defun generate-lexical-variable-name (expr)
+ (if (function-call-p expr)
+ (gensym (symbol-name (fn-of expr)))
+ (gensym "VAR")))
+
+(defun generate-lexical-variable-names (exprs)
+ (mapcar #'generate-lexical-variable-name exprs))
+
+(defun identity-binder (exprs)
+ (lambda (row i referenced-by)
+ (bind ((names (generate-lexical-variable-names exprs)))
+ (values
+ (mapcar (lambda (name) `(,name (prog1 (elt ,row ,i) (incf ,i))))
+ names)
+ referenced-by))))
+
(defun field-binder (exprs)
(lambda (row i referenced-by)
- (bind ((names (mapcar (lambda (expr)
- (if (function-call-p expr)
- (gensym (symbol-name (fn-of expr)))
- (gensym "VAR")))
- exprs))
+ (bind ((names (generate-lexical-variable-names exprs))
(substitutions (mapcar #'cons exprs names)))
(values
(iter (for name in names) ;; TODO generate binding for referenced exprs only
@@ -789,7 +808,7 @@
1))
((contains-syntax-p type)
(values ;; TODO optimize: do not call compute-column-reader-form twice
- `(nth-value 0 (compute-column-reader-form ,(backquote-type-syntax type)))
+ `(nth-value 0 (eval (compute-column-reader-form ,(backquote-type-syntax type))))
`(nth-value 1 (compute-column-reader-form ,(backquote-type-syntax type)))))
((~persistent-class-type-p type)
(values