From e1e0e168b6cec7cc9f7ad9649f445176534e5859 Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Sun, 27 Mar 2022 00:10:37 -0400 Subject: [PATCH] implement inference rules --- waltz/macros.fnl | 17 ++++++++--- waltz/sqlog.fnl | 76 ++++++++++++++++++++++++++++++++++++++++++++--- waltz/sqltest.fnl | 10 +++++++ 3 files changed, 95 insertions(+), 8 deletions(-) create mode 100644 waltz/sqltest.fnl diff --git a/waltz/macros.fnl b/waltz/macros.fnl index 2580104..3849302 100644 --- a/waltz/macros.fnl +++ b/waltz/macros.fnl @@ -1,17 +1,26 @@ ; (q X) -> q(X) ; (q :x) -> q(x) -; [(q X) (p X)] -> q(X) :- p(X) +; (q #(+ 1 2)) -> q(3) (fn clause [c] (match c - (where [:unquote expr] (list? c)) `[:const ,expr] + (where [:hashfn expr] (list? c)) `[:const ,expr] (where [name & params] (list? c)) `[:literal ,(tostring name) ,(icollect [_ param (ipairs params)] (clause param))] - (where [head & tail] (sequence? c)) `[:clause ,(clause head) ,(icollect [_ elem (ipairs tail)] (clause elem))] (where v (sym? c)) `[:var ,(tostring v)] _ `[:const ,c])) (fn clauses [...] (icollect [_ c (ipairs [...]) :into `(values)] (clause c))) -{: clause : clauses :$ clauses} +(fn defrule [s ...] + `(: ,s :defrule ,(clauses ...))) + +(fn defrules [s ...] + (icollect [_ rule (ipairs [...]) :into `(do)] + (defrule s (table.unpack rule)))) + +(fn query [s ...] + `(: ,s :query ,(clauses ...))) + +{: clause : clauses :$ clauses : defrule : defrules : query} diff --git a/waltz/sqlog.fnl b/waltz/sqlog.fnl index afd819d..07af8e4 100644 --- a/waltz/sqlog.fnl +++ b/waltz/sqlog.fnl @@ -21,7 +21,7 @@ ; simple queries: ; (p x y) -> SELECT p.c1 AS x, p.c2 AS y FROM p ; (p 1 y) -> SELECT p.c2 AS y FROM p WHERE p.c1 = 1 - ; (q x) (p x 1) -> SELECT q.c1 AS x FROM q JOIN p WHERE p.c1 = q.c1 AND p.c2 = 1 +; (q x) (p x 1) -> SELECT q.c1 AS x FROM q JOIN p WHERE p.c1 = q.c1 AND p.c2 = 1 ; (p 1 2) -> SELECT true FROM p WHERE p.c1 = 1 AND p.c2 = 2 ; (p 1 x) (p x 2) -> SELECT t1.c2 AS x FROM p AS t1 JOIN p AS t2 WHERE t1.c1 = 1 AND t1.c2 = t2.c1 AND t2.c2 = 2 @@ -29,6 +29,27 @@ ; [(ancestor x y) (parent x y)] -> SELECT p.c1 AS x, p.c2 AS y FROM parent AS p ; [(ancestor x y) (parent x z) (ancestor z y)] -> SELECT p.c1 AS x, a.y AS y FROM parent AS p JOIN ancestor AS a WHERE p.c1 = a.x AND p.c2 = a.y ; (ancestor x :john) -> WITH RECURSIVE ancestor(x, y) AS (SELECT ... UNION SELECT ...) SELECT a.c1 AS x FROM ancestor AS a WHERE a.y = 'john' +; [(ancestor :bob x) (ancestor x :john)] -> SELECT 'bob' AS c1, a.c1 AS c2 FROM ancestor AS a WHERE a.c2 = 'john' + +; queries with comparisons? arithmetic operations? function calls? +; (p x y) (< x 5) -> SELECT p.c1 AS x, p.c2 AS y FROM p WHERE p.c1 < 5 +; (p x y) (q (+ x 1)) -> SELECT p.c1 AS x, p.c2 AS y FROM p JOIN q WHERE q.c1 = p.c1 + 1 +; (p (+ x 1) y) (q x) -> SELECT q.c1 AS x, p.c2 AS y FROM p JOIN q WHERE p.c1 + 1 = q.c1 +; (p (+ x 1) x) -> SELECT p.c2 AS x FROM p WHERE p.c1 + 1 = p.c2 + +; confusing expressions we probably won't support: +; (p (+ x 1) (* x 2)) -> SELECT p.c1 - 1 AS x FROM p WHERE p.c1 + 1 = p.c2 * 2?? +; no, that's not right - this says x+1 = c1 AND x*2 = c2 +; (p (+ x 1) (* x 2)) -> SELECT p.c1 - 1 AS x FROM p WHERE p.c2 = (p.c1 - 1) * 2 + ; (p (+ x 1) y) -> meaningless? or... +; -> SELECT p.c1 - 1 AS x, p.c2 AS y FROM p +; is there a way to trick sql into generating x = p.c1 - 1 from p.c1 = x + 1? +; (p z y) (= z (+ x 1)) + +; unsupported: inline comparisons, explicit equality checks (use unification instead) +; (p (< x 5) y) -> SELECT p.c1 AS x, p.c2 AS y FROM p WHERE p.c1 < 5 -- does this make sense? seems hard to read, hard to parse +; (p x y) (= x y) -> unnecessary, can be written (p x x) +; (p x y) (= x (+ y 1)) -> unnecessary, can be written (p (+ x 1) x)? (fn Sqlog.new [self] (set self.tables {}) @@ -39,14 +60,27 @@ (when (. name self.rules) (error "tables and rules must not overlap")) (tset self.tables name [...])) -(fn add-clause [analysis clause] (table.insert analysis.clauses clause)) +(fn Sqlog.defrule [self head ...] + (match head + [:literal name] (let [rulelist (or (. self.rules name) [])] + (table.insert rulelist [head ...]) + (tset self.rules name rulelist)) + _ (error "Expected literal for head, got " (fv head)))) + +(fn Sqlog.defrules [self ...] + (for [i 1 (select :# ...)] (self:defrule (table.unpack (select i ...))))) + (fn append-if-missing [list value] (when (not (lume.any list #(= $1 value))) (table.insert list value))) +(fn add-clause [analysis clause] (table.insert analysis.clauses clause)) + (fn Sqlog.reference-name [self analysis name] (if (or (. self.rules name) (. self.tables name)) (do (table.insert analysis.tables name) + (when (. self.rules name) + (append-if-missing analysis.referenced-rules name)) (length analysis.tables)) (error (.. "Unknown table / rule " name)))) @@ -66,7 +100,14 @@ _ (error (.. "expected var or const, got " (fv value)))))) _ (error (.. "Expected literal but got " (fv literal))))) -(fn new-analysis [] {:variables [] :variable-mapping {} :selection [] :clauses [] :tables [] :constants []}) +(fn new-analysis [?parent] + {:variables [] + :variable-mapping {} + :selection [] + :clauses [] + :tables [] + :constants (or (?. ?parent :constants) []) + :referenced-rules (or (?. ?parent :referenced-rules) [])}) (fn Sqlog.gen-expr [self analysis expr] (match expr @@ -82,6 +123,33 @@ (fn cat [list sep ?f] (table.concat (icollect [i v (ipairs list)] ((or ?f #$1) v i)) sep)) +(fn Sqlog.gen-rule-clause [self analysis-parent [head & literals]] + (let [analysis (new-analysis analysis-parent)] + (each [_ literal (ipairs literals)] (self:analyze-literal analysis literal)) + (match head + [:literal name params] + (set analysis.selection (icollect [icolumn param (ipairs params)] + (match param + [:var varname] [:as (. analysis.variable-mapping varname) (.. "c" icolumn)] + [:const val] [:as param (.. "c" icolumn)] + _ (error (.. "Expected const or var, got " (fv param)))))) + _ (error (.. "Expected literal, got " (fv head)))) + (self:gen-select analysis))) + +(fn Sqlog.gen-rule [self analysis name] + (let [rule (. self.rules name)] + (.. name "(" (cat rule ", " #(.. "c" $2)) ") AS NOT MATERIALIZED (" + (cat rule " UNION " #(self:gen-rule-clause analysis $1)) ")"))) + +(fn Sqlog.gen-with-rules [self analysis] + (let [rulequeries []] + ; ipairs will iterate over all referenced-rules even if gen-rule causes more to be appended + (each [_ name (ipairs analysis.referenced-rules)] + (table.insert rulequeries (self:gen-rule analysis name))) + (if (> (length rulequeries) 0) + (.. "WITH RECURSIVE " (cat rulequeries ", ") " ") + ""))) + (fn Sqlog.gen-select [self analysis] (.. "SELECT " (if (> (length analysis.selection) 0) @@ -97,7 +165,7 @@ (let [analysis (new-analysis)] (each [_ literal (ipairs [...])] (self:analyze-literal analysis literal)) (set analysis.selection (icollect [_ varname (ipairs analysis.variables)] [:as (. analysis.variable-mapping varname) varname])) - [(self:gen-select analysis) analysis.constants])) + [(.. (self:gen-with-rules analysis) (self:gen-select analysis)) analysis.constants])) Sqlog diff --git a/waltz/sqltest.fnl b/waltz/sqltest.fnl new file mode 100644 index 0000000..b47f353 --- /dev/null +++ b/waltz/sqltest.fnl @@ -0,0 +1,10 @@ +(local Sqlog (require :waltz.sqlog)) +(import-macros {: $ : query : defrules} :waltz.macros) + +(local s (Sqlog)) +(s:deftable :parent :parent :child) +(defrules s + [(ancestor x y) (parent x y)] + [(ancestor x y) (parent x z) (ancestor z y)]) +(pp (query s (ancestor x y))) +