autoindex defined tables, allow table creation / arbitrary sql in specify blocks, fix hashfn escape

This commit is contained in:
Jeremy Penner 2022-04-02 23:29:37 -04:00
parent 078e667c44
commit 926d808a92
4 changed files with 14 additions and 10 deletions

View file

@ -98,7 +98,10 @@
"Defines the column names of a table and their expected ordering" "Defines the column names of a table and their expected ordering"
(when (. name self.rules) (error "tables and rules must not overlap")) (when (. name self.rules) (error "tables and rules must not overlap"))
(tset self.tables name [...]) (tset self.tables name [...])
{:query (.. "CREATE TABLE " name "(" (cat [...] ", ") ")") :constants [] :selection []}) {:query (.. "CREATE TABLE " (quoteid name) "(" (cat [...] ", " quoteid)
", PRIMARY KEY (" (cat [...] ", " quoteid) "))")
:constants []
:selection []})
(fn Compiler.defrule [self head ...] (fn Compiler.defrule [self head ...]
"Defines a new rule or expands the definition of an existing rule." "Defines a new rule or expands the definition of an existing rule."
@ -108,7 +111,6 @@
(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 new-analysis [?parent] (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 "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." with the full SQL expression."

View file

@ -10,7 +10,6 @@
(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 ...))
(fn Sqlog.defrules [self ...] (self.compiler:defrules ...))
(fn Sqlog.compile-sql [self analysis] (fn Sqlog.compile-sql [self analysis]
(when (= analysis.stmt nil) (when (= analysis.stmt nil)
@ -47,6 +46,9 @@
(when (not= action nil) (when (not= action nil)
(match action (match action
[:* & rule] (self:defrule (table.unpack rule)) [:* & rule] (self:defrule (table.unpack rule))
[:table & params] (self:deftable (table.unpack (icollect [_ param (ipairs params)]
(match param [_ name] name))))
[:sql query & constants] (self:execute {: query : constants})
_ (self:execute (self:compile-action action))) _ (self:execute (self:compile-action action)))
(self:specify ...))) (self:specify ...)))

View file

@ -4,7 +4,7 @@
(fn clause [c] (fn clause [c]
(match c (match c
(where [:hashfn expr] (list? c)) `[:const ,expr] (where [escape expr] (list? c) (= (tostring escape) :hashfn)) `[:const ,expr]
(where [name & params] (sequence? c)) `[:literal ,(tostring name) ,(icollect [_ param (ipairs params)] (clause param))] (where [name & params] (sequence? c)) `[:literal ,(tostring name) ,(icollect [_ param (ipairs params)] (clause param))]
(where [head & args] (list? c) (sym? head)) (icollect [_ expr (ipairs args) :into [(tostring head)]] (clause expr)) (where [head & args] (list? c) (sym? head)) (icollect [_ expr (ipairs args) :into [(tostring head)]] (clause expr))
(where c (list? c)) (icollect [_ val (ipairs c)] (clause val)) (where c (list? c)) (icollect [_ val (ipairs c)] (clause val))

View file

@ -2,16 +2,16 @@
(import-macros {: $ : query : specify} :sqlog.macros) (import-macros {: $ : query : specify} :sqlog.macros)
(local s (Sqlog)) (local s (Sqlog))
(s:deftable :parent :parent :child)
(specify s (specify s
(table parent parent child)
(* [generation name (|| name " jr") 2] [parent name (|| name " jr")]) (* [generation name (|| name " jr") 2] [parent name (|| name " jr")])
(* [generation name (|| name " iii") 3] [ancestor name (|| name " iii")]) (* [generation name (|| name " iii") 3] [ancestor name (|| name " iii")])
(* [ancestor x y 1] [parent x y]) (* [ancestor x y 2] [parent x y])
(* [ancestor x y (+ gen 1)] [parent x z] [ancestor z y gen]) (* [ancestor x y (+ gen 1)] [parent x z] [ancestor z y gen])
[parent :bob "bob jr"] [parent :bob "bob jr"]
[parent "bob jr" "bob iii"] [parent "bob jr" "bob iii"]
[parent :bob :fred] [parent :bob #(.. :fred :dy)]
[parent :fred :jim] [parent :fred :jim]
[parent :fred :betty]) [parent :fred :betty])
(pp (query s [generation :bob descendant gen])) (pp (query s [ancestor :bob descendant gen]))