perf: Phase 2.2 -- :in input substitution + DISTINCT for non-agg queries
ober
7989cd6873bc585b3e6096656a0c92c65a64245e
--- a/benchmarks/mbrainz-bench.ss +++ b/benchmarks/mbrainz-bench.ss @@ -249,16 +249,21 @@ ;; Q4: Multi-join — tracks with duration above threshold on releases by artist ;; Tests: deep join, 4 data patterns + predicate +(def q4-query + '((find ?track-name ?duration ?release-name) + (in $ ?min-dur) + (where (?t track/duration ?duration) + (?t track/name ?track-name) + (?t track/artists ?a) + (?r release/artists ?a) + (?r release/name ?release-name) + ((> ?duration ?min-dur))))) + (def (q4 db min-duration) - (q '((find ?track-name ?duration ?release-name) - (in $ ?min-dur) - (where (?t track/duration ?duration) - (?t track/name ?track-name) - (?t track/artists ?a) - (?r release/artists ?a) - (?r release/name ?release-name) - ((> ?duration ?min-dur)))) - db min-duration)) + (q q4-query db min-duration)) + +(def (q4-analytics db ae min-duration) + (analytical-query (parse-query q4-query) ae (db-value-schema db) min-duration)) ;; Q5: Aggregation — count releases per country ;; Tests: aggregation + grouping @@ -334,6 +339,8 @@ (lambda () (q3 db 1960))) (bench "Q4" "Tracks > 240s on shared-artist releases" (lambda () (q4 db 240000))) + (bench "Q4*" " via DuckDB fallback" + (lambda () (q4-analytics db ae 240000))) (bench "Q5" "Count releases per country" (lambda () (q5 db))) (bench "Q6" "All releases for one artist (reverse ref)" --- a/lib/jerboa-db/query/sql-translate.ss +++ b/lib/jerboa-db/query/sql-translate.ss @@ -88,16 +88,22 @@ [(max) (string-append "MAX(" col-expr ")")] [else #f])) - (def (translate-query-to-sql parsed-q schema) + (def (translate-query-to-sql parsed-q schema . maybe-inputs) ;; Returns (sql . slots) or #f ;; slots: list of (kind . src) per find-var ;; (agg . agg-name) — column name `agg_N` ;; (grp . column-alias) — column name from GROUP BY ;; (lit . value) — literal echoed in output - (let ([find-vars (parsed-query-find-vars parsed-q)] - [in-vars (parsed-query-in-vars parsed-q)] - [where-cl (parsed-query-where-clauses parsed-q)]) - (and (equal? in-vars '($)) + ;; + ;; Optional inputs follow the parsed-query :in vars (without `$`). + ;; Each input must pair with a scalar logic-var; collection / tuple / + ;; relation bindings are not yet supported. + (let* ([find-vars (parsed-query-find-vars parsed-q)] + [in-vars (parsed-query-in-vars parsed-q)] + [where-cl (parsed-query-where-clauses parsed-q)] + [inputs (if (null? maybe-inputs) '() (car maybe-inputs))] + [in-binds (build-in-bindings in-vars inputs)]) + (and in-binds (pair? where-cl) (for-all (lambda (cl) (or (data-pattern? cl) @@ -106,9 +112,24 @@ (let ([data-clauses (filter data-pattern? where-cl)] [pred-clauses (filter predicate-clause? where-cl)]) (and (pair? data-clauses) - (build-sql find-vars data-clauses pred-clauses schema)))))) + (build-sql find-vars data-clauses pred-clauses + schema in-binds)))))) - (def (build-sql find-vars data-clauses pred-clauses schema) + ;; Build an alist mapping scalar :in vars → their input values. + ;; Returns #f if any in-var is non-scalar (collection/tuple/relation). + (def (build-in-bindings in-vars inputs) + (let loop ([ivs in-vars] [inps inputs] [acc '()]) + (cond + [(null? ivs) (reverse acc)] + [(eq? (car ivs) '$) (loop (cdr ivs) inps acc)] + [(eq? (car ivs) '%) #f] ;; rules input not supported in SQL + [(logic-var? (car ivs)) + (and (pair? inps) + (loop (cdr ivs) (cdr inps) + (cons (cons (car ivs) (car inps)) acc)))] + [else #f]))) ;; tuple/relation/coll: bail out + + (def (build-sql find-vars data-clauses pred-clauses schema in-binds) ;; First pass: assign aliases d1..dN; for each clause record the ;; column expression for its e-spec and v-spec. Then walk find-vars ;; to build SELECT, GROUP BY, and the slot mapping for results. @@ -122,7 +143,7 @@ [(null? clauses) (finalize-sql find-vars (reverse var-cols) (reverse where-parts) (reverse from-parts) - pred-clauses schema)] + pred-clauses schema in-binds)] [else (let* ([cl (car clauses)] [e-spec (car cl)] [a-spec (cadr cl)] [v-spec (caddr cl)] @@ -147,16 +168,25 @@ [extra-where '()] [vc1 (cond [(logic-var? e-spec) - (let ([prev (assq e-spec var-cols)]) - (if prev - (begin + (cond + [(assq e-spec in-binds) + => (lambda (b) (set! extra-where (cons (string-append e-expr " = " - (cdr prev)) + (sql-literal (cdr b))) extra-where)) - var-cols) - (cons (cons e-spec e-expr) - var-cols)))] + var-cols)] + [else + (let ([prev (assq e-spec var-cols)]) + (if prev + (begin + (set! extra-where + (cons (string-append e-expr " = " + (cdr prev)) + extra-where)) + var-cols) + (cons (cons e-spec e-expr) + var-cols)))])] [else (set! extra-where (cons (string-append e-expr " = " @@ -165,16 +195,25 @@ var-cols])] [vc2 (cond [(logic-var? v-spec) - (let ([prev (assq v-spec vc1)]) - (if prev - (begin + (cond + [(assq v-spec in-binds) + => (lambda (b) (set! extra-where (cons (string-append v-expr " = " - (cdr prev)) + (sql-literal (cdr b))) extra-where)) - vc1) - (cons (cons v-spec v-expr) - vc1)))] + vc1)] + [else + (let ([prev (assq v-spec vc1)]) + (if prev + (begin + (set! extra-where + (cons (string-append v-expr " = " + (cdr prev)) + extra-where)) + vc1) + (cons (cons v-spec v-expr) + vc1)))])] [else (set! extra-where (cons (string-append v-expr " = " @@ -188,11 +227,11 @@ where-parts) (cons from-piece from-parts)))))))]))) - (def (finalize-sql find-vars var-cols where-parts from-parts pred-clauses schema) + (def (finalize-sql find-vars var-cols where-parts from-parts pred-clauses schema in-binds) ;; Build SELECT projection + GROUP BY + WHERE for predicates (let* ([find-info (build-find-info find-vars var-cols)]) (and find-info - (let* ([pred-where (build-pred-where pred-clauses var-cols)]) + (let* ([pred-where (build-pred-where pred-clauses var-cols in-binds)]) (and pred-where (build-final-sql find-info from-parts (append pred-where where-parts))))))) @@ -224,7 +263,7 @@ (loop (cdr fvs) (cons (cons 'lit (car fvs)) acc))] [else #f]))) - (def (build-pred-where pred-clauses var-cols) + (def (build-pred-where pred-clauses var-cols in-binds) (let loop ([cs pred-clauses] [acc '()]) (cond [(null? cs) (reverse acc)] @@ -238,8 +277,12 @@ (map (lambda (a) (cond [(logic-var? a) - (let ([col (assq a var-cols)]) - (and col (cdr col)))] + (cond + [(assq a in-binds) + => (lambda (b) (sql-literal (cdr b)))] + [else + (let ([col (assq a var-cols)]) + (and col (cdr col)))])] [else (sql-literal a)])) args)]) (and (for-all (lambda (x) x) sql-args) @@ -286,7 +329,7 @@ (loop (cdr fi) (cons (cdar fi) acc))] [else (loop (cdr fi) acc)])) '())] - [select-clause (string-append "SELECT " + [select-clause (string-append (if has-aggs? "SELECT " "SELECT DISTINCT ") (sql-join select-pieces ", "))] [from-clause (string-append "FROM " (sql-join from-parts ", "))] @@ -309,8 +352,9 @@ [else (string-append (car lst) sep (sql-join (cdr lst) sep))])) ;; Run a translated query and shape rows to match Datalog tuple form. - (def (analytical-query parsed-q ae schema) - (let ([translated (translate-query-to-sql parsed-q schema)]) + ;; Inputs (after `$`) are substituted directly into the generated SQL. + (def (analytical-query parsed-q ae schema . inputs) + (let ([translated (translate-query-to-sql parsed-q schema inputs)]) (and translated (let* ([sql (car translated)] [find-info (cdr translated)]