Implement ground. Fixes #99.

This commit is contained in:
Richard Newman 2016-10-17 20:42:07 -07:00
parent 1ddf37163c
commit 3cfccc4b81
2 changed files with 55 additions and 1 deletions

View file

@ -269,10 +269,38 @@
(raise-str "Can't handle entity" e)))))
(defn apply-ground-clause [cc function]
(let [{:keys [args binding]} function]
(when-not (= (count args) 1)
(raise-str "Too many args to ground."))
(when-not (and (instance? BindScalar binding)
(instance? Variable (:variable binding)))
(raise-str "ground only binds scalars."))
(let [var (:variable binding)
val (first args)
constant? (instance? Constant val)
external (when (instance? Variable val)
(first (get (:external-bindings cc) (:symbol val))))]
(when-not (or constant? external)
(raise-str "ground argument must be constant or externally bound."))
(-> cc
;; TODO: figure out if we can conclusively know the type of the var.
; (assoc-in [:known-types (:symbol var)] nil)
(util/append-in [:bindings (:symbol var)]
(if constant?
(:value val)
external))))))
(def sql-functions
;; Future: versions of this that uses snippet() or matchinfo().
{"fulltext" apply-fulltext-clause
"get-else" apply-get-else-clause})
"get-else" apply-get-else-clause
"ground" apply-ground-clause})
(defn apply-sql-function
"Either returns an application of `function` to `cc`, or nil to

View file

@ -598,6 +598,32 @@
[(get-else $ ?page :page/title "No title") ?title]]
conn)))))
(deftest-db test-ground conn
(let [attrs (<? (<initialize-with-schema conn page-schema))]
(is (= {:select (list
[:datoms0.e :page]
[(sql/param :xyz) :foo]),
:modifiers [:distinct],
:from '([:datoms datoms0]),
:where (list :and [:= :datoms0.a (:page/url attrs)])}
(expand '[:find ?page ?foo :in
$ ?xyz ; Bound param.
:where
[(ground ?xyz) ?foo]
[?page :page/url _]]
conn)))
(is (= {:select (list
[:datoms0.e :page]
[452 :foo]),
:modifiers [:distinct],
:from '([:datoms datoms0]),
:where (list :and [:= :datoms0.a (:page/url attrs)])}
(expand '[:find ?page ?foo :in $
:where
[(ground 452) ?foo]
[?page :page/url _]]
conn)))))
(deftest-db test-limit-order conn
(let [attrs (<? (<initialize-with-schema conn aggregate-schema))
context