Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

LOGIC-132: "PMap is non-storable" exception when using featurec with

nested feature map.

The recursive `featurec` support was a bit naive. `unify-with-pmap*`
nows handles the various cases properly.
  • Loading branch information...
commit 30fcd69dd4c9ca86b3a73c3f6b5866d6b943ddff 1 parent 6d1780d
@swannodette swannodette authored
View
23 src/main/clojure/clojure/core/logic.clj
@@ -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)
@@ -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?)
@@ -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
View
29 src/test/clojure/clojure/core/logic/tests.clj
@@ -1742,10 +1742,22 @@
(== 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}}))
'())))
@@ -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
Please sign in to comment.
Something went wrong with that request. Please try again.