SpindleyQ/edtris
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

sqlog compiler fixes and extensions

Browse source
This commit is contained in:
Jeremy Penner 2022-04-20 23:22:38 -04:00
parent 6df7ec8c33
commit 6984389fbf
3 changed files with 33 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
sqlog/compiler.fnl
View file

@ -161,7 +161,7 @@
(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)))))
(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." "Generates SQL code for a given expression tree."
(match expr (match expr
@ -172,7 +172,10 @@
_ (.. "c" icolumn))) _ (.. "c" icolumn)))
[:rowid itable] (.. "_t" itable "._rowid_") [:rowid itable] (.. "_t" itable "._rowid_")
[:as subexpr name] (.. (self:gen-expr analysis subexpr) " AS " (quoteid name)) [:as subexpr name] (.. (self:gen-expr analysis subexpr) " AS " (quoteid name))
[:set column subexpr] (.. column " = " (self:gen-expr analysis subexpr)) [:set column subexpr] (.. (quoteid column) " = " (self:gen-expr analysis subexpr))
[:case & clauses] (.. "CASE " (cat clauses " " #(self:gen-expr analysis $1)) " END")
[:when cmp result] (.. "WHEN " (self:gen-expr analysis cmp) " THEN " (self:gen-expr analysis result))
[:else result] (.. "ELSE " (self:gen-expr analysis result))
(where [:var name] (. analysis.variable-mapping name)) (self:gen-expr analysis (. analysis.variable-mapping name)) (where [:var name] (. analysis.variable-mapping name)) (self:gen-expr analysis (. analysis.variable-mapping name))
(where [op lhs rhs] (. infix-ops op)) (.. "(" (self:gen-expr analysis lhs) " " op " " (self:gen-expr analysis rhs) ")") (where [op lhs rhs] (. infix-ops op)) (.. "(" (self:gen-expr analysis lhs) " " op " " (self:gen-expr analysis rhs) ")")
[funcname & args] (.. funcname "(" (cat args ", " #(self:gen-expr analysis $1)) ")") [funcname & args] (.. funcname "(" (cat args ", " #(self:gen-expr analysis $1)) ")")

12
sqlog/init.fnl
View file

@ -11,14 +11,18 @@
(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 multi? [analysis] (and analysis (> (length analysis) 0)))
(fn Sqlog.compile-sql [self analysis] (fn Sqlog.compile-sql [self analysis]
(if (multi? analysis) (each [_ a (ipairs analysis)] (self:compile-sql a))
(when (= analysis.stmt nil) (when (= analysis.stmt nil)
(let [stmt (sqlite.assert (sqlite.prepare self.db analysis.query))] (let [stmt (sqlite.assert (sqlite.prepare self.db analysis.query))]
(sqlite.bind stmt analysis.constants) (sqlite.bind stmt analysis.constants)
(set analysis.stmt stmt))) (set analysis.stmt stmt))))
analysis) analysis)
(fn Sqlog.execute [self analysis ?collect-results] (fn Sqlog.execute [self analysis ?collect-results]
(if (multi? analysis) (icollect [_ a (ipairs analysis)] (self:execute a ?collect-results))
(do (print "running:" analysis.query (fv analysis.constants))
(self:compile-sql analysis) (self:compile-sql analysis)
(sqlite.reset analysis.stmt) (sqlite.reset analysis.stmt)
(if ?collect-results (if ?collect-results
@ -30,15 +34,17 @@
_ icol) _ icol)
(sqlite.column analysis.stmt icol)))) (sqlite.column analysis.stmt icol))))
result) result)
(sqlite.step analysis.stmt))) (sqlite.step analysis.stmt)))))
(fn Sqlog.compile-action [self action] (fn Sqlog.compile-action [self action]
(self:compile-sql (self:compile-sql
(match action (match action
[:do & actions] (icollect [_ act (ipairs actions)] (self:compile-action act))
[:!+ & insert] (self.compiler:insert (table.unpack insert)) [:!+ & insert] (self.compiler:insert (table.unpack insert))
[:literal] (self.compiler:insert action) [:literal] (self.compiler:insert action)
[:!- & delete] (self.compiler:delete (table.unpack delete)) [:!- & delete] (self.compiler:delete (table.unpack delete))
[:!= & update] (self.compiler:update (table.unpack update))))) [:!= & update] (self.compiler:update (table.unpack update))
_ (error (.. "No such action " (fv action))))))
(fn Sqlog.compile-query [self ...] (self:compile-sql (self.compiler:query ...))) (fn Sqlog.compile-query [self ...] (self:compile-sql (self.compiler:query ...)))

3
sqlog/sqltest.fnl
View file

@ -1,4 +1,5 @@
(local Sqlog (require :sqlog)) (local Sqlog (require :sqlog))
(local {: show} (require :inspector.debug))
(import-macros {: $ : query : specify} :sqlog.macros) (import-macros {: $ : query : specify} :sqlog.macros)
(local s (Sqlog)) (local s (Sqlog))
@ -13,5 +14,5 @@
[parent :bob #(.. :fred :dy)] [parent :bob #(.. :fred :dy)]
[parent :fred :jim] [parent :fred :jim]
[parent :fred :betty]) [parent :fred :betty])
(pp (query s [ancestor :bob descendant gen])) (show (query s [ancestor (case descendant (when "bob jr" :bob) (else :jim)) descendant gen]))