Skip to content

Commit fa6400e

Browse files
committed
UNIFY-4: Fixed false unification on seqs of differing lengths
1 parent 2e65349 commit fa6400e

File tree

3 files changed

+25
-20
lines changed

3 files changed

+25
-20
lines changed

pom.xml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@
1818
<parent>
1919
<groupId>org.clojure</groupId>
2020
<artifactId>pom.contrib</artifactId>
21-
<version>0.0.25</version>
21+
<version>0.0.26</version>
2222
</parent>
2323

2424
<developers>

src/main/clojure/clojure/core/unify.clj

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -50,11 +50,13 @@
5050

5151
(defn- bind-phase
5252
[binds variable expr]
53-
(if (ignore-variable? variable)
53+
(if (or (nil? expr)
54+
(ignore-variable? variable))
5455
binds
5556
(assoc binds variable expr)))
5657

57-
(defn- determine-occursness [want-occurs? variable? v expr binds]
58+
(defn- determine-occursness
59+
[want-occurs? variable? v expr binds]
5860
(if want-occurs?
5961
`(if (occurs? ~variable? ~v ~expr ~binds)
6062
(throw (IllegalStateException. (str "Cycle found in the path " ~expr)))
@@ -63,11 +65,10 @@
6365

6466
(defmacro create-var-unification-fn
6567
[want-occurs?]
66-
(let [varp 'varp ;;(gensym)
67-
v 'v ;;(gensym)
68-
expr 'expr ;;(gensym)
69-
binds 'binds ;;(gensym)
70-
]
68+
(let [varp (gensym)
69+
v (gensym)
70+
expr (gensym)
71+
binds (gensym)]
7172
`(fn var-unify
7273
[~varp ~v ~expr ~binds]
7374
(if-let [vb# (~binds ~v)]
@@ -128,6 +129,7 @@
128129
(defn- try-subst
129130
"Attempts to substitute the bindings in the appropriate locations in the given expression."
130131
[variable? x binds]
132+
{:pre [(map? binds) (fn? variable?)]}
131133
(walk/prewalk (fn [expr]
132134
(if (variable? expr)
133135
(or (binds expr) expr)

src/test/clojure/clojure/core/unify/tests.clj

Lines changed: 15 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -40,15 +40,6 @@
4040
(is (= '{Bar 2, Foo 1} (#'clojure.core.unify/garner-unifiers CAPS '(Foo Bar) '(1 2))))
4141
(is (= '{?y a, ?x ?y} (#'clojure.core.unify/garner-unifiers '(?x ?y a) '(?y ?x ?x)))))
4242

43-
(deftest test-norvig-bug-cases
44-
(testing "that the unification of the problem cases in Norvig's paper
45-
'Correcting A Widespread Error in Unification Algorithms'. An
46-
incorrect unifier will return nil or loop forever."
47-
(is (= '{?x ?y} (unify '(p ?x ?y) '(p ?y ?x))))
48-
(is (= '{?y a, ?x ?y} (unify '(p ?x ?y a) '(p ?y ?x ?x))))
49-
;; higher-order predicates!
50-
(is (= '{?x ?y, ?z (p ?x ?y)} (unify '(q (p ?x ?y) (p ?y ?x)) '(q ?z ?z))))))
51-
5243
(deftest test-range-variables
5344
(is (= '{?x 1 ?y (2 3)} (#'clojure.core.unify/garner-unifiers '(?x & ?y) [1 2 3])))
5445
(is (= '{?x 1 ?y 2 ?z (3)} (#'clojure.core.unify/garner-unifiers '(?x ?y & ?z) [1 2 3])))
@@ -69,25 +60,37 @@
6960
(is (= '(a a a) (#'clojure.core.unify/unifier* CAPS '(X Y a) '(Y X X))))
7061
(is (= '((?a * 5 ** 2) + (4 * 5) + 3) (#'clojure.core.unify/unifier* '((?a * ?x ** 2) + (?b * ?x) + ?c) '(?z + (4 * 5) + 3)))))
7162

72-
7363
(deftest test-unifier
7464
(is (= '((?a * 5 ** 2) + (4 * 5) + 3) (#'clojure.core.unify/unifier '((?a * ?x ** 2) + (?b * ?x) + ?c) '(?z + (4 * 5) + 3))))
7565
(is (= 42 (#'clojure.core.unify/unifier '?x 42)))
7666
(is (= '{a 2} (#'clojure.core.unify/unifier (hash-map 'a '?x) (hash-map 'a 2))))
7767
(is (= #{2 3 4} (#'clojure.core.unify/unifier #{'?a '?b '?c} #{2 3 4}))))
7868

79-
8069
(deftest test-unifier-no-occurs
8170
(is (= '((?a * 5 ** 2) + (4 * 5) + 3) (#'clojure.core.unify/unifier- '((?a * ?x ** 2) + (?b * ?x) + ?c) '(?z + (4 * 5) + 3))))
8271
(is (= 42 (#'clojure.core.unify/unifier- '?x 42)))
8372
(is (= '{a 2} (#'clojure.core.unify/unifier- (hash-map 'a '?x) (hash-map 'a 2))))
8473
(is (= #{2 3 4} (#'clojure.core.unify/unifier- #{'?a '?b '?c} #{2 3 4}))))
8574

86-
8775
(deftest test-mk-unifier
8876
(let [u (#'clojure.core.unify/make-occurs-unifier-fn #(and (symbol? %)
8977
(re-matches #"^\?.*" (name %))))]
9078
(is (= '((?a * 5 ** 2) + (4 * 5) + 3) (u '((?a * ?x ** 2) + (?b * ?x) + ?c) '(?z + (4 * 5) + 3))))))
9179

9280
(deftest test-aux
9381
(is (#'clojure.core.unify/composite? "foo")))
82+
83+
(deftest test-norvig-bug-cases
84+
(testing "that the unification of the problem cases in Norvig's paper
85+
'Correcting A Widespread Error in Unification Algorithms'. An
86+
incorrect unifier will return nil or loop forever."
87+
(is (= '{?x ?y} (unify '(p ?x ?y) '(p ?y ?x))))
88+
(is (= '{?y a, ?x ?y} (unify '(p ?x ?y a) '(p ?y ?x ?x))))
89+
;; higher-order predicates!
90+
(is (= '{?x ?y, ?z (p ?x ?y)} (unify '(q (p ?x ?y) (p ?y ?x)) '(q ?z ?z))))))
91+
92+
(deftest regressions
93+
(testing "That seqs of different lengths do not unify per UNIFY-4"
94+
(is (= {} (unify '[1 ?x] '[1])))
95+
(is (= {} (unify '[1 ?x ?y ?z] '[1])))))
96+

0 commit comments

Comments
 (0)