diff --git a/diet-sqlite/init.fnl b/diet-sqlite/init.fnl index f9113d5..7074a25 100644 --- a/diet-sqlite/init.fnl +++ b/diet-sqlite/init.fnl @@ -4,7 +4,7 @@ (local sqlffi (require :diet-sqlite.sqlite3_ffi)) (local ffi (require :ffi)) (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 :reset sqlffi.sqlite3_reset}) diff --git a/sqlog/compiler.fnl b/sqlog/compiler.fnl index a16a9c2..ef9be81 100644 --- a/sqlog/compiler.fnl +++ b/sqlog/compiler.fnl @@ -10,11 +10,7 @@ ; Ideally we would persist rules as JSON in a special table; maybe sqlog_rules? -(local Object (require :core.object)) -(local lume (require :lib.lume)) -(local util (require :lib.util)) - -(local Compiler (Object:extend)) +(local Compiler {}) ; Generating SQL from Datalog should not be too complex, but it pays to start with the simplest ; 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 (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)) +(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] (set self.tables {}) (set self.rules {})) @@ -85,22 +99,30 @@ {:query (.. "CREATE TABLE " name "(" (cat [...] ", ") ")") :constants [] :selection []}) (fn Compiler.defrule [self head ...] + "Defines a new rule or expands the definition of an existing rule." (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 Compiler.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 new-analysis [?parent] + "Creates a new empty analysis object. If ?parent is supplied, share the list of constants and referenced rules, as these are shared + 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 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)) (do (table.insert analysis.tables name) (when (. self.rules name) @@ -109,14 +131,21 @@ (error (.. "Unknown table / rule " name)))) (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 :_) (match (. analysis.variable-mapping varname) mapping (add-clause analysis [:= mapping expr]) nil (do (tset analysis.variable-mapping varname expr) (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)) (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 [:literal name params] (let [itable (self:reference-name analysis name)] (each [icolumn value (ipairs params)] @@ -128,17 +157,9 @@ (where [op] (. comparitors op)) (add-clause analysis 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)) (fn Compiler.gen-expr [self analysis expr] + "Generates SQL code for a given expression tree." (match expr [:const val] (do (table.insert analysis.constants val) "?") [:column itable icolumn] (.. "_t" itable "." @@ -153,6 +174,7 @@ _ (error (.. "Unrecognized expression " (fv expr))))) (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)] (each [_ literal (ipairs literals)] (self:analyze-literal analysis literal)) (match head @@ -162,14 +184,17 @@ (self:gen-select analysis))) (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) 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 (" + (.. name "(" (table.concat (icollect [i (countiter column-count)] (.. "c" i)) ", ") ") AS NOT MATERIALIZED (" (cat rule " UNION " #(self:gen-rule-clause analysis $1)) ")"))) (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 []] ; ipairs will iterate over all referenced-rules even if gen-rule causes more to be appended (each [_ name (ipairs analysis.referenced-rules)] @@ -179,6 +204,7 @@ ""))) (fn Compiler.gen-select [self analysis] + "Generates a SELECT statement for the query defined by analysis." (.. "SELECT " (if (> (length analysis.selection) 0) (cat analysis.selection ", " #(self:gen-expr analysis $1)) @@ -190,17 +216,20 @@ (.. " WHERE " (cat analysis.clauses " AND " #(self:gen-expr analysis $1))) ""))) +(fn tail [[ _ & result]] result) (fn Compiler.gen-update [self analysis] + "Generates an UPDATE statement for the query defined by analysis." (.. "UPDATE " (. analysis.tables 1) " AS _t1 SET " (cat analysis.selection ", " #(self:gen-expr analysis $1)) (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) (.. " WHERE " (cat analysis.clauses " AND " #(self:gen-expr analysis $1))) ""))) (fn Compiler.query [self ...] + "Analyzes the given literals and generates an appropriate SELECT statement." (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])) @@ -208,6 +237,7 @@ analysis)) (fn Compiler.insert [self head ...] + "Analyzes the given literals and generates an appropriate INSERT statement." (match head [:literal name params] (let [analysis (new-analysis) @@ -224,6 +254,7 @@ _ (error (.. "Expected literal, got " (fv head))))) (fn Compiler.delete [self head ...] + "Analyzes the given literals and generates an appropriate DELETE statement." (match head [:literal name params] (let [analysis (new-analysis)] @@ -234,6 +265,7 @@ _ (error (.. "Expected literal, got " (fv head))))) (fn Compiler.update [self newhead head ...] + "Analyzes the given literals and generates an appropriate UPDATE statement." (match [newhead head] [[:literal name params] [:literal name]] (let [analysis (new-analysis) @@ -246,5 +278,4 @@ (set analysis.query (.. (self:gen-with-rules analysis) (self:gen-update analysis))) analysis))) -Compiler - +(setmetatable Compiler {:__call (fn [cls ...] (doto (setmetatable {} {:__index cls} ) (: :new ...)))}) diff --git a/sqlog/init.fnl b/sqlog/init.fnl index 3424b0c..6ca2850 100644 --- a/sqlog/init.fnl +++ b/sqlog/init.fnl @@ -1,15 +1,12 @@ (local Compiler (require :sqlog.compiler)) (local sqlite (require :diet-sqlite)) -(local Object (require :core.object)) (local {: SQLITE_ROW} (require :diet-sqlite.codes)) -(local Sqlog (Object:extend)) +(local Sqlog {}) -(fn Sqlog.new [self] - (set self.compiler (Compiler))) - -(fn Sqlog.connect [self dbname] - (set self.db (sqlite.assert (sqlite.open dbname)))) +(fn Sqlog.new [self ?dbname] + (set self.compiler (Compiler)) + (set self.db (sqlite.assert (sqlite.open (or ?dbname ":memory:"))))) (fn Sqlog.deftable [self name ...] (self:execute (self.compiler:deftable name ...))) (fn Sqlog.defrule [self head ...] (self.compiler:defrule head ...)) @@ -55,4 +52,4 @@ (fn Sqlog.query [self ...] (self:execute (self:compile-query ...) true)) -Sqlog +(setmetatable Sqlog {:__call (fn [cls ...] (doto (setmetatable {} {:__index cls} ) (: :new ...)))}) diff --git a/sqlog/sqltest.fnl b/sqlog/sqltest.fnl index 3e87c70..f6e1432 100644 --- a/sqlog/sqltest.fnl +++ b/sqlog/sqltest.fnl @@ -2,7 +2,6 @@ (import-macros {: $ : query : specify} :sqlog.macros) (local s (Sqlog)) -(s:connect ":memory:") (s:deftable :parent :parent :child) (specify s (* [generation name (|| name " jr") 2] [parent name (|| name " jr")])