remove dependencies, add commentary, fix diet-sqlite
This commit is contained in:
parent
fd3fcbd978
commit
0f31f8ea4c
|
@ -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})
|
||||||
|
|
|
@ -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 ...)))})
|
||||||
|
|
||||||
|
|
|
@ -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 ...)))})
|
||||||
|
|
|
@ -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")])
|
||||||
|
|
Loading…
Reference in a new issue