From cdc4bf8563e9f566cc6e3e0e4f8a7735cd92b88e Mon Sep 17 00:00:00 2001 From: David Nolen Date: Thu, 27 Sep 2012 22:33:19 -0400 Subject: [PATCH] LOGIC-54 LOGIC-55 LOGIC-56: Set unification no longer supported. IUnifyWithSet protocol left as stub for the brave ones. --- src/main/clojure/clojure/core/logic.clj | 56 --------- src/test/clojure/clojure/core/logic/tests.clj | 110 ------------------ 2 files changed, 166 deletions(-) diff --git a/src/main/clojure/clojure/core/logic.clj b/src/main/clojure/clojure/core/logic.clj index 1ea85132..93501dc0 100644 --- a/src/main/clojure/clojure/core/logic.clj +++ b/src/main/clojure/clojure/core/logic.clj @@ -1170,9 +1170,6 @@ IUnifyWithMap (unify-with-map [v u s] (ext s v u)) - IUnifyWithSet - (unify-with-set [v u s] - (ext s v u)) IUnifyWithRefinable (unify-with-refinable [v u s] (ext-no-check s v (:lvar u))) @@ -1299,8 +1296,6 @@ (unify-with-lseq u v s)) IUnifyWithMap (unify-with-map [v u s] nil) - IUnifyWithSet - (unify-with-set [v u s] nil) IReifyTerm (reify-term [v s] (loop [v v s s] @@ -1368,10 +1363,6 @@ (unify-terms [u v s] (unify-with-map v u s)) - clojure.lang.IPersistentSet - (unify-terms [u v s] - (unify-with-set v u s)) - java.lang.Byte (unify-terms [u v s] (unify-with-integer v u s)) @@ -1498,53 +1489,6 @@ nil s)))))) -;; ----------------------------------------------------------------------------- -;; Unify IPersistentSet with X - -(extend-protocol IUnifyWithSet - nil - (unify-with-set [v u s] nil) - - Object - (unify-with-set [v u s] nil) - - ;; TODO : improve speed, the following takes 890ms - ;; - ;; (let [a (lvar 'a) - ;; b (lvar 'b) - ;; c (lvar 'c) - ;; d (lvar 'd) - ;; s1 #{a b 3 4 5} - ;; s2 #{1 2 3 c d}] - ;; (dotimes [_ 10] - ;; (time - ;; (dotimes [_ 1e5] - ;; (.s (unify empty-s s1 s2)))))) - clojure.lang.IPersistentSet - (unify-with-set [v u s] - (loop [u u v v ulvars [] umissing []] - (if (seq u) - (if (seq v) - (let [uf (first u)] - (if (lvar? uf) - (recur (disj u uf) v (conj ulvars uf) umissing) - (if (contains? v uf) - (recur (disj u uf) (disj v uf) ulvars umissing) - (recur (disj u uf) v ulvars (conj umissing uf))))) - nil) - (if (seq v) - (if (seq ulvars) - (loop [v v vlvars [] vmissing []] - (if (seq v) - (let [vf (first v)] - (if (lvar? vf) - (recur (disj v vf) (conj vlvars vf) vmissing) - (recur (disj v vf) vlvars (conj vmissing vf)))) - (unify s (concat ulvars umissing) - (concat vmissing vlvars)))) - nil) - s))))) - ;; ----------------------------------------------------------------------------- ;; Unify Refinable with X diff --git a/src/test/clojure/clojure/core/logic/tests.clj b/src/test/clojure/clojure/core/logic/tests.clj index e587a568..18dbba6a 100644 --- a/src/test/clojure/clojure/core/logic/tests.clj +++ b/src/test/clojure/clojure/core/logic/tests.clj @@ -25,10 +25,6 @@ (let [x (lvar 'x)] (is (= (unify empty-s nil {}) nil)))) -(deftest unify-nil-set-1 - (let [x (lvar 'x)] - (is (= (unify empty-s nil #{}) nil)))) - ;; ----------------------------------------------------------------------------- ;; object @@ -80,9 +76,6 @@ (deftest unify-object-map-1 (is (= (unify empty-s 1 {}) nil))) -(deftest unify-object-set-1 - (is (= (unify empty-s 1 #{}) nil))) - ;; ----------------------------------------------------------------------------- ;; lvar @@ -134,16 +127,6 @@ os (ext-no-check empty-s x {1 2 3 4})] (is (= (unify empty-s x {1 2 3 4}) os)))) -(deftest unify-lvar-set-1 - (let [x (lvar 'x) - os (ext-no-check empty-s x #{})] - (is (= (unify empty-s x #{}) os)))) - -(deftest unify-lvar-set-2 - (let [x (lvar 'x) - os (ext-no-check empty-s x #{1 2 3})] - (is (= (unify empty-s x #{1 2 3}) os)))) - ;; ----------------------------------------------------------------------------- ;; lcons @@ -246,9 +229,6 @@ (deftest unify-lcons-map-1 (is (= (unify empty-s (lcons 1 (lvar 'x)) {}) nil))) -(deftest unify-lcons-set-1 - (is (= (unify empty-s (lcons 1 (lvar 'x)) #{}) nil))) - ;; ----------------------------------------------------------------------------- ;; seq @@ -332,12 +312,6 @@ (deftest unify-seq-map-2 (is (= (unify empty-s '() {}) nil))) -(deftest unify-seq-set-1 - (is (= (unify empty-s [] #{}) nil))) - -(deftest unify-seq-set-2 - (is (= (unify empty-s '() #{}) nil))) - ;; ----------------------------------------------------------------------------- ;; map @@ -378,74 +352,6 @@ m2 {1 4 3 x}] (is (= (unify empty-s m1 m2) nil)))) -(deftest unify-map-set-1 - (is (= (unify empty-s {} #{}) nil))) - -;; ----------------------------------------------------------------------------- -;; set - -(deftest unify-set-object-1 - (is (= (unify empty-s #{} 1) nil))) - -(deftest unify-set-lvar-1 - (let [x (lvar 'x) - os (ext-no-check empty-s x #{})] - (is (= (unify empty-s #{} x) os)))) - -(deftest unify-set-lcons-1 - (let [x (lvar 'x)] - (is (= (unify empty-s #{} (lcons 1 x)) nil)))) - -(deftest unify-set-seq-1 - (is (= (unify empty-s #{} '()) nil))) - -(deftest unify-set-map-1 - (is (= (unify empty-s #{} {}) nil))) - -(deftest unify-set-set-1 - (is (= (unify empty-s #{} #{}) empty-s))) - -(deftest unify-set-set-2 - (is (= (unify empty-s #{} #{1}) nil))) - -(deftest unify-set-set-3 - (let [x (lvar 'x) - os (ext-no-check empty-s x 1)] - (is (= (unify empty-s #{x} #{1}) os)))) - -(deftest unify-set-set-4 - (let [x (lvar 'x) - y (lvar 'y) - os (-> empty-s - (ext-no-check x 2) - (ext-no-check y 1))] - (is (= (unify empty-s #{1 x} #{2 y}) os)))) - -(deftest unify-set-set-5 - (let [x (lvar 'x) - y (lvar 'y) - os (-> empty-s - (ext-no-check x 2) - (ext-no-check y 1))] - (is (= (unify empty-s #{x 1} #{2 y}) os)))) - -(deftest unify-set-set-6 - (let [a (lvar 'a) - b (lvar 'b) - c (lvar 'c) - d (lvar 'd) - s (:s (unify empty-s #{a b 3 4 5} #{1 2 3 c d}))] - (is (and (= (count s) 4) - (= (set (keys s)) #{a b c d}) - (= (set (vals s)) #{1 2 4 5}))))) - -(deftest unify-set-set-7 - (let [a (lvar 'a) - b (lvar 'b) - c (lvar 'c) - d (lvar 'd)] - (is (= (unify empty-s #{a b 9 4 5} #{1 2 3 c d}) nil)))) - ;; ============================================================================= ;; walk @@ -1253,25 +1159,9 @@ (match-map {:foo {:bar 1}} q)) '(1)))) -(defne match-set [s o] - ([#{:cat :bird :dog} _])) - -(defn test-defne-set [] - (is (= (run* [q] - (match-set #{:cat :bird :dog} q)) - '(_.0)))) - -(comment - ;; FIXME: for some reason set #{:cat :bird} works on match-set call - David - ) - ;; ----------------------------------------------------------------------------- ;; Tickets -(deftest test-32-unify-set - (is (= (run* [q] (== q #{1})) - '(#{1})))) - (deftest test-31-unifier-associative (is (= (binding [*reify-vars* false] (unifier '{:a ?x} '{:a ?y} '{:a 5}))