Skip to content

Commit

Permalink
Issue #267: local bindings not visible if used in a non-hash join.
Browse files Browse the repository at this point in the history
  • Loading branch information
@rbrush
rbrush committed Mar 11, 2017
1 parent ab9f6c0 commit 06d7ad5
Show file tree
Hide file tree
Showing 4 changed files with 151 additions and 117 deletions.
3 changes: 3 additions & 0 deletions src/main/clojure/clara/macros.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -99,6 +99,7 @@
'~condition
~(com/compile-join-filter (:join-filter-expressions beta-node)
(:join-filter-join-bindings beta-node)
(:new-bindings beta-node)
{})
~(gen-beta-network child-ids beta-graph all-bindings)
~join-bindings)
Expand All @@ -115,6 +116,7 @@
'~condition
~(com/compile-join-filter (:join-filter-expressions beta-node)
(:join-filter-join-bindings beta-node)
(:new-bindings beta-node)
{})
~(gen-beta-network child-ids beta-graph all-bindings)
~join-bindings)
Expand All @@ -139,6 +141,7 @@
~(:accumulator beta-node)
~(com/compile-join-filter (:join-filter-expressions beta-node)
(:join-filter-join-bindings beta-node)
(:new-bindings beta-node)
{})
~(:result-binding beta-node)
~(gen-beta-network child-ids beta-graph all-bindings)
Expand Down
46 changes: 29 additions & 17 deletions src/main/clojure/clara/rules/compiler.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -404,11 +404,9 @@
"Compiles to a predicate function that ensures the given items can be unified. Returns a ready-to-eval
function that accepts a token, a fact, and an environment, and returns truthy if the given fact satisfies
the criteria."
[{:keys [type constraints args] :as unification-condition} ancestor-bindings env]
[{:keys [type constraints args] :as unification-condition} ancestor-bindings element-bindings env]
(let [accessors (field-name->accessors-used type constraints)

binding-keys (variables-as-keywords constraints)

destructured-env (if (> (count env) 0)
{:keys (mapv #(symbol (name %)) (keys env))}
'?__env__)
Expand All @@ -424,18 +422,29 @@
[name (list accessor '?__fact__)])
accessors)))

token-assignments (mapcat #(list (symbol (name %)) (list 'get-in '?__token__ [:bindings %])) binding-keys)
;; Binding keys that are not newly created are drawn from the token.
token-binding-keys (remove element-bindings (variables-as-keywords constraints))

token-assignments (mapcat #(list (symbol (name %))
(list 'get-in '?__token__ [:bindings %]))
token-binding-keys)

new-binding-assignments (mapcat #(list (symbol (name %))
(list 'get '?__element-bindings__ %))
element-bindings)

assignments (concat
fact-assignments
token-assignments)
token-assignments
new-binding-assignments)

equality-only-variables (into #{} (for [binding ancestor-bindings]
(symbol (name (keyword binding)))))]

`(fn [~'?__token__
~(add-meta '?__fact__ type)
~destructured-env]
~'?__element-bindings__
~destructured-env]
(let [~@assignments
~'?__bindings__ (atom {})]
~(compile-constraints constraints equality-only-variables)))))
Expand Down Expand Up @@ -1207,12 +1216,13 @@
condition
children
join-bindings)

;; If the join operation includes arbitrary expressions
;; that can't expressed as a hash join, we must use the expressions
(if (:join-filter-expressions beta-node)
(let [join-filter-expr (compile-join-filter (:join-filter-expressions beta-node)
(:join-filter-join-bindings beta-node)
(:new-bindings beta-node)
(:env beta-node))]
(with-meta
(eng/->ExpressionJoinNode
Expand Down Expand Up @@ -1241,6 +1251,7 @@

(let [join-filter-expr (compile-join-filter (:join-filter-expressions beta-node)
(:join-filter-join-bindings beta-node)
(:new-bindings beta-node)
(:env beta-node))]
(with-meta
(eng/->NegationWithJoinFilterNode
Expand Down Expand Up @@ -1298,6 +1309,7 @@

(let [join-filter-expr (compile-join-filter (:join-filter-expressions beta-node)
(:join-filter-join-bindings beta-node)
(:new-bindings beta-node)
(:env beta-node))]
(with-meta
(eng/->AccumulateWithJoinFilterNode
Expand Down Expand Up @@ -1498,16 +1510,16 @@
(equals [this other]
(let [other ^AlphaRootsWrapper other]
(cond
(identical? fact-type (.fact-type other))

(identical? fact-type (.fact-type other))
true

(not (== fact-type-hash (.fact-type-hash other)))
false

:else
(= fact-type (.fact-type other)))))

;; Since know we will need to find the hashcode of this object in all cases just eagerly calculate it upfront
;; and avoid extra calls to hash later.
(hashCode [this] fact-type-hash))
Expand Down Expand Up @@ -1557,7 +1569,7 @@
;; ensuring determinism, we respect that ordering here by conj'ing on to the existing
;; collection.
(conj (wrapped-ancestors-fn fact-type) fact-type))))

update-roots->facts! (fn [^java.util.Map roots->facts roots-group fact]
(if-let [v (.get roots->facts roots-group)]
(.add ^java.util.List v fact)
Expand All @@ -1570,7 +1582,7 @@
(doseq [fact facts
roots-group (fact-type->roots (wrapped-fact-type-fn fact))]
(update-roots->facts! roots->facts roots-group fact))

(let [return-list (java.util.LinkedList.)
entries (.entrySet roots->facts)
entries-it (.iterator entries)]
Expand All @@ -1579,14 +1591,14 @@
;; for performance but wrap them in unmodifiableList to make it clear that the caller is not expected to mutate these lists.
;; Since after this function returns the only reference to the fact lists will be through the unmodifiedList we can depend elsewhere
;; on these lists not changing. Since the only expected workflow with these lists is to loop through them, not add or remove elements,
;; we don't gain much from using a transient (which can be efficiently converted to a persistent data structure) rather than a mutable type.
;; we don't gain much from using a transient (which can be efficiently converted to a persistent data structure) rather than a mutable type.
(loop []
(when (.hasNext entries-it)
(let [^java.util.Map$Entry e (.next entries-it)]
(.add return-list [(-> e ^AlphaRootsWrapper (.getKey) .roots)
(java.util.Collections/unmodifiableList (.getValue e))])
(recur))))

(java.util.Collections/unmodifiableList return-list))))))


Expand Down Expand Up @@ -1697,7 +1709,7 @@
;; The returned salience will be a tuple of the form [rule-salience internal-salience],
;; where internal-salience is considered after the rule-salience and is assigned automatically by the compiler.
activation-group-fn (eng/options->activation-group-fn options)

rulebase (build-network beta-tree beta-roots alpha-nodes productions
fact-type-fn ancestors-fn activation-group-sort-fn activation-group-fn)

Expand Down
Loading

0 comments on commit 06d7ad5

Please sign in to comment.