remove dependencies, add commentary, fix diet-sqlite

This commit is contained in:
Jeremy Penner 2022-04-02 22:04:12 -04:00
parent fd3fcbd978
commit 0f31f8ea4c
4 changed files with 60 additions and 33 deletions

View file

@ -4,7 +4,7 @@
(local sqlffi (require :diet-sqlite.sqlite3_ffi)) (local sqlffi (require :diet-sqlite.sqlite3_ffi))
(local ffi (require :ffi)) (local ffi (require :ffi))
(local util (require :lib.util)) (local util (require :lib.util))
(local {: SQLITE_OK : SQLITE_INTEGER : SQLITE_FLOAT : SQLITE_NULL : SQLITE_BLOB : SQLITE_TEXT} (require :diet-sqlite.codes)) (local {: SQLITE_OK : SQLITE_INTEGER : SQLITE_FLOAT : SQLITE_NULL : SQLITE_BLOB : SQLITE_TEXT : SQLITE_TRANSIENT} (require :diet-sqlite.codes))
(local sql {:step sqlffi.sqlite3_step (local sql {:step sqlffi.sqlite3_step
:reset sqlffi.sqlite3_reset}) :reset sqlffi.sqlite3_reset})

View file

@ -10,11 +10,7 @@
; Ideally we would persist rules as JSON in a special table; maybe sqlog_rules? ; Ideally we would persist rules as JSON in a special table; maybe sqlog_rules?
(local Object (require :core.object)) (local Compiler {})
(local lume (require :lib.lume))
(local util (require :lib.util))
(local Compiler (Object:extend))
; Generating SQL from Datalog should not be too complex, but it pays to start with the simplest ; Generating SQL from Datalog should not be too complex, but it pays to start with the simplest
; case and build up from there. ; case and build up from there.
@ -72,8 +68,26 @@
; (!= [p (+ x 1) _] [q x]) -> UPDATE p SET c1 = q.c1 + 1 FROM q -- this is valid sql, but it's madness - enforce the first query clause matches table ; (!= [p (+ x 1) _] [q x]) -> UPDATE p SET c1 = q.c1 + 1 FROM q -- this is valid sql, but it's madness - enforce the first query clause matches table
(fn cat [list sep ?f] (fn cat [list sep ?f]
"Join all the elements in list with the string sep. If ?f is supplied, it is called to transform each value in the list into a new value first."
(table.concat (icollect [i v (ipairs list)] ((or ?f #$1) v i)) sep)) (table.concat (icollect [i v (ipairs list)] ((or ?f #$1) v i)) sep))
(fn any [list pred]
"Returns true if the supplied predicate function returns true for any values in list."
(var found false)
(each [_ v (ipairs list) :until found] (set found (pred v)))
found)
(fn append-if-missing [list value]
"Adds value to the end of list if it is not currently included."
(when (not (any list #(= $1 value)))
(table.insert list value)))
(fn countiter [max]
"An iterator that counts from 1 to max, inclusive."
(fn [_ iprev]
(let [i (if iprev (+ iprev 1) 1)]
(when (<= i max) i))))
(fn Compiler.new [self] (fn Compiler.new [self]
(set self.tables {}) (set self.tables {})
(set self.rules {})) (set self.rules {}))
@ -85,22 +99,30 @@
{:query (.. "CREATE TABLE " name "(" (cat [...] ", ") ")") :constants [] :selection []}) {:query (.. "CREATE TABLE " name "(" (cat [...] ", ") ")") :constants [] :selection []})
(fn Compiler.defrule [self head ...] (fn Compiler.defrule [self head ...]
"Defines a new rule or expands the definition of an existing rule."
(match head (match head
[:literal name] (let [rulelist (or (. self.rules name) [])] [:literal name] (let [rulelist (or (. self.rules name) [])]
(table.insert rulelist [head ...]) (table.insert rulelist [head ...])
(tset self.rules name rulelist)) (tset self.rules name rulelist))
_ (error "Expected literal for head, got " (fv head)))) _ (error "Expected literal for head, got " (fv head))))
(fn Compiler.defrules [self ...]
(for [i 1 (select :# ...)] (self:defrule (table.unpack (select i ...)))))
(fn append-if-missing [list value] (fn new-analysis [?parent]
(when (not (lume.any list #(= $1 value))) "Creates a new empty analysis object. If ?parent is supplied, share the list of constants and referenced rules, as these are shared
(table.insert list value))) with the full SQL expression."
{:variables [] ; list of all variable names referenced; used to determine which values to return from a query
:variable-mapping {} ; a mapping from variable name to a SQL expr to which it is equal
:selection [] ; list of all columns being selected, generally of the form [:as expr name]
:clauses [] ; list of WHERE clauses, to be joined together by AND
:tables [] ; list of tables or rules queried. (. tables 1) is generally aliased to _t1. All tables are inner joined.
:constants (or (?. ?parent :constants) []) ; list of constant values to be bound to the prepared SQL expression
:referenced-rules (or (?. ?parent :referenced-rules) [])}) ; list of all rules referenced by this expression, so they can be included
(fn add-clause [analysis clause] (table.insert analysis.clauses clause)) (fn add-clause [analysis clause] (table.insert analysis.clauses clause))
(fn Compiler.reference-name [self analysis name] (fn Compiler.reference-name [self analysis name]
"Called when a query references a new table. Appends the table or rule name to the end of analysis.tables
and returns the index of the new value. Also updates analysis.referenced-rules as needed."
(if (or (. self.rules name) (. self.tables name)) (if (or (. self.rules name) (. self.tables name))
(do (table.insert analysis.tables name) (do (table.insert analysis.tables name)
(when (. self.rules name) (when (. self.rules name)
@ -109,14 +131,21 @@
(error (.. "Unknown table / rule " name)))) (error (.. "Unknown table / rule " name))))
(fn Compiler.reference-variable [self analysis varname expr] (fn Compiler.reference-variable [self analysis varname expr]
"Called when a query expression (expr) is known to be equal to the value of varname - usually because
the variable appears in the position of a particular rule or column. Defines a mapping from variable
to expression if none exists, otherwise adds a new clause testing that the original mapping is equal
to this new mapping, implementing unification."
(when (not= varname :_) (when (not= varname :_)
(match (. analysis.variable-mapping varname) (match (. analysis.variable-mapping varname)
mapping (add-clause analysis [:= mapping expr]) mapping (add-clause analysis [:= mapping expr])
nil (do (tset analysis.variable-mapping varname expr) nil (do (tset analysis.variable-mapping varname expr)
(table.insert analysis.variables varname))))) (table.insert analysis.variables varname)))))
; These are SQL functions that return boolean values and can be used as a standalone clause.
(local comparitors (collect [_ op (ipairs [:< :> :<= :>= := :and :or])] op true)) (local comparitors (collect [_ op (ipairs [:< :> :<= :>= := :and :or])] op true))
(fn Compiler.analyze-literal [self analysis literal] (fn Compiler.analyze-literal [self analysis literal]
"Adds a literal of the form [table expr expr expr...] or a comparison expression of the form (op expr expr) to
the analysis object. Typically this implies a join and some number of WHERE clauses."
(match literal (match literal
[:literal name params] (let [itable (self:reference-name analysis name)] [:literal name params] (let [itable (self:reference-name analysis name)]
(each [icolumn value (ipairs params)] (each [icolumn value (ipairs params)]
@ -128,17 +157,9 @@
(where [op] (. comparitors op)) (add-clause analysis literal) (where [op] (. comparitors op)) (add-clause analysis literal)
_ (error (.. "Expected literal or comparison but got " (fv literal))))) _ (error (.. "Expected literal or comparison but got " (fv literal)))))
(fn new-analysis [?parent]
{:variables []
:variable-mapping {}
:selection []
:clauses []
:tables []
:constants (or (?. ?parent :constants) [])
:referenced-rules (or (?. ?parent :referenced-rules) [])})
(local infix-ops (collect [_ op (ipairs [:+ :- :* :/ :< :> :<= :>= := :|| :and :or])] op true)) (local infix-ops (collect [_ op (ipairs [:+ :- :* :/ :< :> :<= :>= := :|| :and :or])] op true))
(fn Compiler.gen-expr [self analysis expr] (fn Compiler.gen-expr [self analysis expr]
"Generates SQL code for a given expression tree."
(match expr (match expr
[:const val] (do (table.insert analysis.constants val) "?") [:const val] (do (table.insert analysis.constants val) "?")
[:column itable icolumn] (.. "_t" itable "." [:column itable icolumn] (.. "_t" itable "."
@ -153,6 +174,7 @@
_ (error (.. "Unrecognized expression " (fv expr))))) _ (error (.. "Unrecognized expression " (fv expr)))))
(fn Compiler.gen-rule-clause [self analysis-parent [head & literals]] (fn Compiler.gen-rule-clause [self analysis-parent [head & literals]]
"Generates a SELECT statement for a given rule (potentially in a family of rules with the same name to be unioned together)"
(let [analysis (new-analysis analysis-parent)] (let [analysis (new-analysis analysis-parent)]
(each [_ literal (ipairs literals)] (self:analyze-literal analysis literal)) (each [_ literal (ipairs literals)] (self:analyze-literal analysis literal))
(match head (match head
@ -162,14 +184,17 @@
(self:gen-select analysis))) (self:gen-select analysis)))
(fn Compiler.gen-rule [self analysis name] (fn Compiler.gen-rule [self analysis name]
"Generates a full expression for a rule family with the given name, to be placed in a WITH RECURSIVE block."
(let [rule (. self.rules name) (let [rule (. self.rules name)
column-count (match rule column-count (match rule
[[[:literal _ clauses]]] (length clauses) [[[:literal _ clauses]]] (length clauses)
_ (error (.. "Rule should be list of list of literals, was " (fv rule))))] _ (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 (" (.. name "(" (table.concat (icollect [i (countiter column-count)] (.. "c" i)) ", ") ") AS NOT MATERIALIZED ("
(cat rule " UNION " #(self:gen-rule-clause analysis $1)) ")"))) (cat rule " UNION " #(self:gen-rule-clause analysis $1)) ")")))
(fn Compiler.gen-with-rules [self analysis] (fn Compiler.gen-with-rules [self analysis]
"Generates a WITH block containing all of the referenced rules found during analysis. Will append to the referenced-rules list
as needed if rules depend on other rules, and only return when all requirements are satisfied."
(let [rulequeries []] (let [rulequeries []]
; ipairs will iterate over all referenced-rules even if gen-rule causes more to be appended ; ipairs will iterate over all referenced-rules even if gen-rule causes more to be appended
(each [_ name (ipairs analysis.referenced-rules)] (each [_ name (ipairs analysis.referenced-rules)]
@ -179,6 +204,7 @@
""))) "")))
(fn Compiler.gen-select [self analysis] (fn Compiler.gen-select [self analysis]
"Generates a SELECT statement for the query defined by analysis."
(.. "SELECT " (.. "SELECT "
(if (> (length analysis.selection) 0) (if (> (length analysis.selection) 0)
(cat analysis.selection ", " #(self:gen-expr analysis $1)) (cat analysis.selection ", " #(self:gen-expr analysis $1))
@ -190,17 +216,20 @@
(.. " WHERE " (cat analysis.clauses " AND " #(self:gen-expr analysis $1))) (.. " WHERE " (cat analysis.clauses " AND " #(self:gen-expr analysis $1)))
""))) "")))
(fn tail [[ _ & result]] result)
(fn Compiler.gen-update [self analysis] (fn Compiler.gen-update [self analysis]
"Generates an UPDATE statement for the query defined by analysis."
(.. "UPDATE " (. analysis.tables 1) " AS _t1 SET " (.. "UPDATE " (. analysis.tables 1) " AS _t1 SET "
(cat analysis.selection ", " #(self:gen-expr analysis $1)) (cat analysis.selection ", " #(self:gen-expr analysis $1))
(if (>= (length analysis.tables) 2) (if (>= (length analysis.tables) 2)
(.. " FROM " (cat (lume.slice analysis.tables 2) " JOIN " #(.. $1 " AS _t" (+ $2 1)))) (.. " FROM " (cat (tail analysis.tables) " JOIN " #(.. $1 " AS _t" (+ $2 1))))
"") "")
(if (> (length analysis.clauses) 0) (if (> (length analysis.clauses) 0)
(.. " WHERE " (cat analysis.clauses " AND " #(self:gen-expr analysis $1))) (.. " WHERE " (cat analysis.clauses " AND " #(self:gen-expr analysis $1)))
""))) "")))
(fn Compiler.query [self ...] (fn Compiler.query [self ...]
"Analyzes the given literals and generates an appropriate SELECT statement."
(let [analysis (new-analysis)] (let [analysis (new-analysis)]
(each [_ literal (ipairs [...])] (self:analyze-literal analysis literal)) (each [_ literal (ipairs [...])] (self:analyze-literal analysis literal))
(set analysis.selection (icollect [_ varname (ipairs analysis.variables)] [:as (. analysis.variable-mapping varname) varname])) (set analysis.selection (icollect [_ varname (ipairs analysis.variables)] [:as (. analysis.variable-mapping varname) varname]))
@ -208,6 +237,7 @@
analysis)) analysis))
(fn Compiler.insert [self head ...] (fn Compiler.insert [self head ...]
"Analyzes the given literals and generates an appropriate INSERT statement."
(match head (match head
[:literal name params] [:literal name params]
(let [analysis (new-analysis) (let [analysis (new-analysis)
@ -224,6 +254,7 @@
_ (error (.. "Expected literal, got " (fv head))))) _ (error (.. "Expected literal, got " (fv head)))))
(fn Compiler.delete [self head ...] (fn Compiler.delete [self head ...]
"Analyzes the given literals and generates an appropriate DELETE statement."
(match head (match head
[:literal name params] [:literal name params]
(let [analysis (new-analysis)] (let [analysis (new-analysis)]
@ -234,6 +265,7 @@
_ (error (.. "Expected literal, got " (fv head))))) _ (error (.. "Expected literal, got " (fv head)))))
(fn Compiler.update [self newhead head ...] (fn Compiler.update [self newhead head ...]
"Analyzes the given literals and generates an appropriate UPDATE statement."
(match [newhead head] (match [newhead head]
[[:literal name params] [:literal name]] [[:literal name params] [:literal name]]
(let [analysis (new-analysis) (let [analysis (new-analysis)
@ -246,5 +278,4 @@
(set analysis.query (.. (self:gen-with-rules analysis) (self:gen-update analysis))) (set analysis.query (.. (self:gen-with-rules analysis) (self:gen-update analysis)))
analysis))) analysis)))
Compiler (setmetatable Compiler {:__call (fn [cls ...] (doto (setmetatable {} {:__index cls} ) (: :new ...)))})

View file

@ -1,15 +1,12 @@
(local Compiler (require :sqlog.compiler)) (local Compiler (require :sqlog.compiler))
(local sqlite (require :diet-sqlite)) (local sqlite (require :diet-sqlite))
(local Object (require :core.object))
(local {: SQLITE_ROW} (require :diet-sqlite.codes)) (local {: SQLITE_ROW} (require :diet-sqlite.codes))
(local Sqlog (Object:extend)) (local Sqlog {})
(fn Sqlog.new [self] (fn Sqlog.new [self ?dbname]
(set self.compiler (Compiler))) (set self.compiler (Compiler))
(set self.db (sqlite.assert (sqlite.open (or ?dbname ":memory:")))))
(fn Sqlog.connect [self dbname]
(set self.db (sqlite.assert (sqlite.open dbname))))
(fn Sqlog.deftable [self name ...] (self:execute (self.compiler:deftable name ...))) (fn Sqlog.deftable [self name ...] (self:execute (self.compiler:deftable name ...)))
(fn Sqlog.defrule [self head ...] (self.compiler:defrule head ...)) (fn Sqlog.defrule [self head ...] (self.compiler:defrule head ...))
@ -55,4 +52,4 @@
(fn Sqlog.query [self ...] (self:execute (self:compile-query ...) true)) (fn Sqlog.query [self ...] (self:execute (self:compile-query ...) true))
Sqlog (setmetatable Sqlog {:__call (fn [cls ...] (doto (setmetatable {} {:__index cls} ) (: :new ...)))})

View file

@ -2,7 +2,6 @@
(import-macros {: $ : query : specify} :sqlog.macros) (import-macros {: $ : query : specify} :sqlog.macros)
(local s (Sqlog)) (local s (Sqlog))
(s:connect ":memory:")
(s:deftable :parent :parent :child) (s:deftable :parent :parent :child)
(specify s (specify s
(* [generation name (|| name " jr") 2] [parent name (|| name " jr")]) (* [generation name (|| name " jr") 2] [parent name (|| name " jr")])