implement inference rules

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}
 

waltz/sqlog.fnl

@@ -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
 

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)))
+