Skip to content

Commit

Permalink
LOGIC-132: "PMap is non-storable" exception when using featurec with
Browse files Browse the repository at this point in the history
nested feature map.

The recursive `featurec` support was a bit naive. `unify-with-pmap*`
nows handles the various cases properly.
  • Loading branch information
swannodette committed May 6, 2013
1 parent 6d1780d commit 30fcd69
Show file tree
Hide file tree
Showing 2 changed files with 40 additions and 12 deletions.
23 changes: 11 additions & 12 deletions src/main/clojure/clojure/core/logic.clj
Expand Up @@ -2573,6 +2573,8 @@
;; =============================================================================
;; Partial Maps

(declare featurec partial-map)

(defn unify-with-pmap* [u v s]
(loop [ks (keys u) s s]
(if (seq ks)
Expand All @@ -2581,9 +2583,14 @@
(if (= vf ::not-found)
nil
(let [uf (get u kf)]
(if-let [s (unify s uf vf)]
(recur (next ks) s)
nil))))
(if (lvar? vf)
(recur (next ks) ((featurec vf uf) s))
(if (map? uf)
(if-let [s (unify s (partial-map uf) vf)]
(recur (next ks) s))
(if-let [s (unify s uf vf)]
(recur (next ks) s)
nil))))))
s)))

(declare partial-map?)
Expand Down Expand Up @@ -2644,21 +2651,13 @@
IConstraintWatchedStores
(-watched-stores [this] #{::subst})))

(defn ->feature [x]
(-feature
(walk-term x
(fn [y]
(if (tree-term? y)
(->feature y)
y)))))

(defn featurec
"Ensure that a map contains at least the key-value pairs
in the map fs. fs must be partially instantiated - that is,
it may contain values which are logic variables to support
feature extraction."
[x fs]
(cgoal (-featurec x (->feature fs))))
(cgoal (-featurec x (partial-map fs))))

;; =============================================================================
;; defnc
Expand Down
29 changes: 29 additions & 0 deletions src/test/clojure/clojure/core/logic/tests.clj
Expand Up @@ -1741,10 +1741,22 @@
(featurec x {:foo {:bar y}})
(== x {:foo {:bar 1}}))
'([{:foo {:bar 1}} 1])))
(is (= (run* [x y]
(== x {:foo {:bar 1}})
(featurec x {:foo {:bar y}}))
'([{:foo {:bar 1}} 1])))
(is (= (run* [x y]
(featurec x {:foo {:bar y}})
(== x {:foo {:bar 1 :woz 2}}))
'([{:foo {:bar 1 :woz 2}} 1])))
(is (= (run* [x y]
(== x {:foo {:bar 1 :woz 2}})
(featurec x {:foo {:bar y}}))
'([{:foo {:bar 1 :woz 2}} 1])))
(is (= (run* [x y]
(== x {:foo {:baz 1}})
(featurec x {:foo {:bar y}}))
'()))
(is (= (run* [x y]
(featurec x {:foo {:bar y}})
(== x {:foo {:baz 1}}))
Expand Down Expand Up @@ -1810,6 +1822,23 @@
(fd/in x y z (fd/interval 0 9))))
'([6 3]))))

(deftest test-logic-132-recursive-featurec
(is (= (run* [x y]
(featurec x {:a {:b 1}})
(== y {:b 1})
(== x {:a y}))
'([{:a {:b 1}} {:b 1}])))
(is (= (run* [x y]
(featurec x {:a {:b 1}})
(== x {:a y})
(== y {:b 1}))
'([{:a {:b 1}} {:b 1}])))
(is (= (run* [x y]
(== x {:a y})
(== y {:b 1})
(featurec x {:a {:b 1}}))
'([{:a {:b 1}} {:b 1}]))))

;; =============================================================================
;; cKanren

Expand Down

0 comments on commit 30fcd69

Please sign in to comment.