Skip to content

Commit

Permalink
Allowing users to explicitly set which vars to bind before running ru…
Browse files Browse the repository at this point in the history 
…les/or-joins (xtdb#980, fixes xtdb#946)

* Initial steps to fix up rules a bit.

* Should not expand into or-joins with literals in the head.

* Default to old behaviour when there are no bound vars.
  • Loading branch information
@hraberg
hraberg committed Jun 30, 2020
1 parent 047a928 commit a6d8e4c
Show file tree
Hide file tree
Showing 2 changed files with 41 additions and 26 deletions.
61 changes: 39 additions & 22 deletions crux-core/src/crux/query.clj
View file
Expand Up @@ -79,6 +79,8 @@
:sym-b logic-var?)))))

(s/def ::args-list (s/coll-of logic-var? :kind vector? :min-count 1))
(s/def ::rule-args (s/cat :bound-args (s/? ::args-list)
:free-args (s/* logic-var?)))

(s/def ::not (expression-spec 'not (s/+ ::term)))
(s/def ::not-join (expression-spec 'not-join (s/cat :args ::args-list
Expand All @@ -88,7 +90,7 @@
(s/def ::or-body (s/+ (s/or :term ::term
:and ::and)))
(s/def ::or (expression-spec 'or ::or-body))
(s/def ::or-join (expression-spec 'or-join (s/cat :args ::args-list
(s/def ::or-join (expression-spec 'or-join (s/cat :args ::rule-args
:body ::or-body)))

(s/def ::term (s/or :triple ::triple
Expand All @@ -108,8 +110,7 @@

(s/def ::rule-head (s/and list?
(s/cat :name (s/and symbol? (complement built-ins))
:bound-args (s/? ::args-list)
:args (s/* logic-var?))))
:args ::rule-args)))
(s/def ::rule-definition (s/and vector?
(s/cat :head ::rule-head
:body (s/+ ::term))))
Expand Down Expand Up @@ -247,7 +248,8 @@
(collect-vars (normalize-clauses not-clause)))
(apply merge-with set/union))
or-join-vars (set (for [or-join-clause or-join-clauses
arg (:args or-join-clause)]
:let [{:keys [bound-args free-args]} (:args or-join-clause)]
arg (concat bound-args free-args)]
arg))]
{:e-vars (set (for [{:keys [e]} triple-clauses
:when (logic-var? e)]
Expand Down Expand Up @@ -453,17 +455,23 @@
or-branches (for [[type sub-clauses] (case or-type
:or clause
:or-join (:body clause))
:let [where (case type
:let [{:keys [bound-args free-args]} (:args clause)
where (case type
:term [sub-clauses]
:and sub-clauses)
body-vars (->> (collect-vars (normalize-clauses where))
(vals)
(reduce into #{}))
or-vars (if or-join?
(set (:args clause))
(set (concat bound-args free-args))
body-vars)
free-vars (set/difference or-vars known-vars)
bound-vars (set/difference or-vars free-vars)]]
[free-vars
bound-vars] (if (and or-join? (not (empty? bound-args)))
(let [bound-vars (set/intersection known-vars (set bound-args))]
[(set/difference (set (concat bound-args free-args)) bound-vars)
bound-vars])
[(set/difference or-vars known-vars)
(set/intersection or-vars known-vars)])]]
(do (when or-join?
(doseq [var or-vars
:when (not (contains? body-vars var))]
Expand Down Expand Up @@ -829,22 +837,29 @@
(when-not rules
(throw (IllegalArgumentException.
(str "Unknown rule: " (cio/pr-edn-str sub-clause)))))
(let [rule-args+body (for [{:keys [head body]} rules]
[(vec (concat (:bound-args head)
(:args head)))
body])
[arity :as arities] (->> rule-args+body
(let [rule-args+num-bound-args+body (for [{:keys [head body]} rules
:let [{:keys [bound-args free-args]} (:args head)]]
[(vec (concat bound-args free-args))
(count bound-args)
body])
[arity :as arities] (->> rule-args+num-bound-args+body
(map (comp count first))
(distinct))]
(distinct))

[num-bound-args :as num-bound-args-groups] (->> rule-args+num-bound-args+body
(map second)
(distinct))]
(when-not (= 1 (count arities))
(throw (IllegalArgumentException. (str "Rule definitions require same arity: " (cio/pr-edn-str rules)))))
(when-not (= 1 (count num-bound-args-groups))
(throw (IllegalArgumentException. (str "Rule definitions require same number of bound args: " (cio/pr-edn-str rules)))))
(when-not (= arity (count (:args clause)))
(throw (IllegalArgumentException.
(str "Rule invocation has wrong arity, expected: " arity " " (cio/pr-edn-str sub-clause)))))
;; TODO: the caches and expansion here needs
;; revisiting.
(let [expanded-rules (for [[branch-index [rule-args body]] (map-indexed vector rule-args+body)
:let [rule-arg->query-arg (zipmap rule-args (:args clause))
(let [expanded-rules (for [[branch-index [args _ body]] (map-indexed vector rule-args+num-bound-args+body)
:let [rule-arg->query-arg (zipmap args (:args clause))
body-vars (->> (collect-vars (normalize-clauses body))
(vals)
(reduce into #{}))
Expand All @@ -864,12 +879,14 @@
(if (= 1 (count expanded-rules))
(first expanded-rules)
(when (seq expanded-rules)
[[:or-join
(with-meta
{:args (vec (filter logic-var? (:args clause)))
:body (vec (for [expanded-rule expanded-rules]
[:and expanded-rule]))}
{:rule-name rule-name})]])))))
(let [[bound-args free-args] (split-at num-bound-args (:args clause))]
[[:or-join
(with-meta
{:args {:bound-args (vec (filter logic-var? bound-args))
:free-args (vec (filter logic-var? free-args))}
:body (vec (for [expanded-rule expanded-rules]
[:and expanded-rule]))}
{:rule-name rule-name})]]))))))
[sub-clause]))
(reduce into [])))

Expand Down
6 changes: 2 additions & 4 deletions crux-test/test/crux/query_test.clj
View file
Expand Up @@ -94,8 +94,6 @@
"Ivan"] (first (api/q (api/db *api*)
'{:find [e first-name]
:where [(or [e :name first-name])]
:rules [[(my-rule e first-name)
(or [e :name first-name])]]
:full-results? true})))))

(t/testing "Can retrieve full results in rule"
Expand Down Expand Up @@ -1144,9 +1142,9 @@
(s/conform :crux.query/where '[[i :age age]
(over-twenty-one? age)])))

(t/is (= [{:head '{:name over-twenty-one?, :args [age]},
(t/is (= [{:head '{:name over-twenty-one?, :args {:free-args [age]}},
:body '[[:range [[:sym-val {:op >=, :sym age, :val 21}]]]]}
'{:head {:name over-twenty-one?, :args [age]},
'{:head {:name over-twenty-one?, :args {:free-args [age]}},
:body [[:not [[:range [[:sym-val {:op <, :sym age, :val 21}]]]]]]}]
(s/conform :crux.query/rules '[[(over-twenty-one? age)
[(>= age 21)]]
Expand Down

0 comments on commit a6d8e4c

Please sign in to comment.