From 82d04e0649c74643072700a1927aa20f55fb3da5 Mon Sep 17 00:00:00 2001
From: Jeremy Penner <jeremy@sporktania.com>
Date: Sun, 27 Mar 2022 14:34:50 -0400
Subject: [PATCH] comparison support, fix bugs in inference rules

* rule expression generation was miscounting the number of parameters
* allow using arbitrary expressions in the head of a rule
---
 waltz/sqlog.fnl   | 30 ++++++++++++++++--------------
 waltz/sqltest.fnl |  4 +++-
 2 files changed, 19 insertions(+), 15 deletions(-)

diff --git a/waltz/sqlog.fnl b/waltz/sqlog.fnl
index 5075504..eb2eaad 100644
--- a/waltz/sqlog.fnl
+++ b/waltz/sqlog.fnl
@@ -12,6 +12,7 @@
 
 (local Object (require :core.object))
 (local lume (require :lib.lume))
+(local util (require :lib.util))
 
 (local Sqlog (Object:extend))
 
@@ -38,6 +39,8 @@
 
 ; queries with comparisons
 ; [p x y] (< x 5) -> SELECT p.c1 AS x, p.c2 AS y FROM p WHERE p.c1 < 5
+; [p x y] (= x y) -> unnecessary but supported, can be written (p x x)
+; [p x y] (= x (+ y 1)) -> unnecessary but supported, can be written (p (+ x 1) x)?
 
 ; 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??
@@ -48,10 +51,8 @@
 ; 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)
+; unsupported: inline comparisons
 ; [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 {})
@@ -92,6 +93,7 @@
     nil (do (tset analysis.variable-mapping varname expr)
             (table.insert analysis.variables varname))))
 
+(local comparitors (collect [_ op (ipairs [:< :> :<= :>= := :and :or])] op true))
 (fn Sqlog.analyze-literal [self analysis literal]
   (match literal
     [:literal name params] (let [itable (self:reference-name analysis name)]
@@ -99,9 +101,10 @@
                                (match value
                                  [:var varname] (self:reference-variable analysis varname [:column itable icolumn])
                                  [: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)))))
+                                 (where [op] (= (. comparitors op) nil)) (add-clause analysis [:= [:column itable icolumn] value])
+                                 _ (error (.. "expected var, const, or function, got " (fv value))))))
+    (where [op] (. comparitors op)) (add-clause analysis literal)
+    _ (error (.. "Expected literal or comparison but got " (fv literal)))))
 
 (fn new-analysis [?parent]
   {:variables []
@@ -122,7 +125,7 @@
                                    _        (.. "c" icolumn)))
     [:as subexpr name] (.. (self:gen-expr analysis subexpr) " AS " name)
     (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))
+    (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]
@@ -133,17 +136,16 @@
     (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))))))
+      (set analysis.selection (icollect [icolumn param (ipairs params)] [:as param (.. :c icolumn)]))
       _ (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 ("
+  (let [rule (. self.rules name)
+        column-count (match rule
+                       [[[:literal _ clauses]]] (length clauses)
+                       _ (error (.. "Rule should be list of list of literals, was " (fv rule))))]
+    (.. name "(" (table.concat (icollect [i (util.countiter column-count)] (.. "c" i)) ", ") ") AS NOT MATERIALIZED ("
         (cat rule " UNION " #(self:gen-rule-clause analysis $1)) ")")))
 
 (fn Sqlog.gen-with-rules [self analysis]
diff --git a/waltz/sqltest.fnl b/waltz/sqltest.fnl
index 51c7d4f..d037bf4 100644
--- a/waltz/sqltest.fnl
+++ b/waltz/sqltest.fnl
@@ -6,7 +6,9 @@
 (s:deftable :p :x :y)
 (s:deftable :q :z)
 (defrules s
+  ([generation name (|| name " jr") 2] [parent name (|| name " jr")])
+  ([generation name (|| name " iii") 3] [ancestor name (|| name " iii")])
   ([ancestor x y] [parent x y])
   ([ancestor x y] [parent x z] [ancestor z y]))
-(pp (query s [p x y] [q (+ x 1)]))
+(pp (query s [generation "bob" descendant nth]))