From 6d46d0f6381deb02f562b8d2c6f212b2866c00be Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Sun, 27 Mar 2022 12:26:26 -0400 Subject: [PATCH] implement math, tweak syntax --- waltz/macros.fnl | 4 +++- waltz/sqlog.fnl | 51 ++++++++++++++++++++++++++--------------------- waltz/sqltest.fnl | 8 +++++--- 3 files changed, 36 insertions(+), 27 deletions(-) diff --git a/waltz/macros.fnl b/waltz/macros.fnl index 3849302..3a30794 100644 --- a/waltz/macros.fnl +++ b/waltz/macros.fnl @@ -5,7 +5,9 @@ (fn clause [c] (match c (where [:hashfn expr] (list? c)) `[:const ,expr] - (where [name & params] (list? c)) `[:literal ,(tostring name) ,(icollect [_ param (ipairs params)] (clause param))] + (where [name & params] (sequence? c)) `[:literal ,(tostring name) ,(icollect [_ param (ipairs params)] (clause param))] + (where [head & args] (list? c) (sym? head)) (icollect [_ expr (ipairs args) :into [(tostring head)]] (clause expr)) + (where c (list? c)) (icollect [_ val (ipairs c)] (clause val)) (where v (sym? c)) `[:var ,(tostring v)] _ `[:const ,c])) diff --git a/waltz/sqlog.fnl b/waltz/sqlog.fnl index 07af8e4..5075504 100644 --- a/waltz/sqlog.fnl +++ b/waltz/sqlog.fnl @@ -19,37 +19,39 @@ ; case and build up from there. ; 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 -; (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 +; [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 +; [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 ; queries using rules: -; [(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' +; ([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 +; queries with arithmetic operations (function calls?) +; [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 = q.c1 + 1 +; [p (+ x 1) x] -> SELECT p.c2 AS x FROM p WHERE p.c1 = p.c2 + 1 + +; queries with comparisons +; [p x y] (< x 5) -> SELECT p.c1 AS x, p.c2 AS y FROM p WHERE p.c1 < 5 ; 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?? +; [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... +; [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)) +; [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)? +; [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 {}) @@ -96,7 +98,8 @@ (each [icolumn value (ipairs params)] (match value [:var varname] (self:reference-variable analysis varname [:column itable icolumn]) - [:const val] (add-clause analysis [:= [:column itable icolumn] [:const val]]) + [:const val] (add-clause analysis [:= [:column itable icolumn] [:const val]]) + [op & args] (add-clause analysis [:= [:column itable icolumn] value]) _ (error (.. "expected var or const, got " (fv value)))))) _ (error (.. "Expected literal but got " (fv literal))))) @@ -109,6 +112,7 @@ :constants (or (?. ?parent :constants) []) :referenced-rules (or (?. ?parent :referenced-rules) [])}) +(local infix-ops (collect [_ op (ipairs [:+ :- :* :/ :< :> :<= :>= := :|| :and :or])] op true)) (fn Sqlog.gen-expr [self analysis expr] (match expr [:const val] (do (table.insert analysis.constants val) "?") @@ -117,7 +121,8 @@ colnames (. colnames icolumn) _ (.. "c" icolumn))) [:as subexpr name] (.. (self:gen-expr analysis subexpr) " AS " name) - [:= lhs rhs] (.. (self:gen-expr analysis lhs) " = " (self:gen-expr analysis rhs)) + (where [:var name] (. analysis.variable-mapping name)) (self:gen-expr analysis (. analysis.variable-mapping name)) + (where [op lhs rhs] (. infix-ops op)) (.. (self:gen-expr analysis lhs) " " op " " (self:gen-expr analysis rhs)) _ (error (.. "Unrecognized expression " (fv expr))))) (fn cat [list sep ?f] diff --git a/waltz/sqltest.fnl b/waltz/sqltest.fnl index b47f353..51c7d4f 100644 --- a/waltz/sqltest.fnl +++ b/waltz/sqltest.fnl @@ -3,8 +3,10 @@ (local s (Sqlog)) (s:deftable :parent :parent :child) +(s:deftable :p :x :y) +(s:deftable :q :z) (defrules s - [(ancestor x y) (parent x y)] - [(ancestor x y) (parent x z) (ancestor z y)]) -(pp (query s (ancestor x y))) + ([ancestor x y] [parent x y]) + ([ancestor x y] [parent x z] [ancestor z y])) +(pp (query s [p x y] [q (+ x 1)]))