implement inference rules

This commit is contained in:
Jeremy Penner 2022-03-27 00:10:37 -04:00
parent 881943ed17
commit e1e0e168b6
3 changed files with 95 additions and 8 deletions

View file

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

View file

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

10
waltz/sqltest.fnl Normal file
View file

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