Skip to content
Browse files

walk-term for ISeqs should not be lazy, refs #121

Attach metadata only to terms that support it, refs #120

lvars-store should be a map and not a set, refs #122

Tests for LOGIC-120, LOGIC-121 and LOGIC-122
  • Loading branch information...
1 parent ea4b1e9 commit 2bf23fd1ea64966bae094c9f634dfb21ddd386d1 @jonase jonase committed with David Nolen
View
8 src/main/clojure/clojure/core/logic.clj
@@ -950,10 +950,10 @@
(walk-term [v f] (f v))
clojure.lang.ISeq
- (walk-term [v f]
- (with-meta
- (map #(walk-term (f %) f) v)
- (meta v)))
+ (walk-term [v f]
+ (with-meta
+ (doall (map #(walk-term (f %) f) v))
+ (meta v)))
clojure.lang.IPersistentVector
(walk-term [v f]
View
14 src/main/clojure/clojure/core/logic/unifier.clj
@@ -13,7 +13,7 @@
(let [v (if-let [u (@store lvar-expr)]
u
(lvar lvar-expr false))]
- (swap! store conj lvar-expr)
+ (swap! store assoc lvar-expr v)
v))
(defn- lcons-expr? [expr]
@@ -48,7 +48,7 @@
(if skip
tail
(lcons (prep* f store) tail)))
- (doall (walk-term expr (replace-lvar store))))
+ (walk-term expr (replace-lvar store)))
:else expr))))
@@ -56,15 +56,17 @@
"Prep a quoted expression. All symbols preceded by ? will
be replaced with logic vars."
[expr]
- (let [lvars (atom #{})
+ (let [lvars (atom {})
prepped (cond
- (lvarq-sym? expr) (lvar expr false)
+ (lvarq-sym? expr) (proc-lvar expr lvars)
(lcons-expr? expr)
(prep* expr lvars true)
- :else (doall (walk-term expr (replace-lvar lvars))))]
- (with-meta prepped {::lvars @lvars})))
+ :else (walk-term expr (replace-lvar lvars)))]
+ (if (instance? clojure.lang.IMeta prepped)
+ (with-meta prepped {::lvars (keys @lvars)})
+ prepped)))
(defn queue-constraint [s c vs]
(cond
View
11 src/test/clojure/clojure/core/logic/tests.clj
@@ -1236,6 +1236,9 @@
(is (= (u/unify ['{:a [?b (?c [?d {:e ?e}])]} {:a [:b '(:c [:d {:e :e}])]}])
{:a [:b '(:c [:d {:e :e}])]})))
+(deftest test-unifier-12
+ (is (= (u/unify '[?x 1]) 1)))
+
;; -----------------------------------------------------------------------------
;; custom var reification
@@ -1295,7 +1298,9 @@
(deftest test-unifier-as-1
(is (= (u/unify {:as '{?x (?y ?z)}} ['?x '(1 2)])))
- (is (= (u/unify {:as '{?x (?y ?z)}} ['(?x) '((1 2))]))))
+ (is (= (u/unify {:as '{?x (?y ?z)}} ['(?x) '((1 2))])))
+ (is (= (u/unify {:as '{?x (?y ?y)}} '[[?y ?x] [1 (1 1)]])
+ '[1 (1 1)])))
;;Anonymous constraints
(deftest test-unifier-anon-constraints-3 ;;One var
@@ -1328,6 +1333,10 @@
(is (= (u/unifier ['(?x 2 . ?y) '(1 9 3 4 5)])
nil)))
+(deftest test-binding-map-7
+ (is (= (u/unifier '[((?x ?y)) ((1 2))])
+ '{?x 1 ?y 2})))
+
(deftest test-binding-map-constraints-1
(is (= (u/unifier {:when {'?x evenc '?y div3c}} ['(?x ?y) '(2 6)])
'{?x 2 ?y 6}))

0 comments on commit 2bf23fd

Please sign in to comment.
Something went wrong with that request. Please try again.