Permalink
Browse files

LOGIC-54 LOGIC-55 LOGIC-56: Set unification no longer supported. IUni…

…fyWithSet protocol left as stub for the brave ones.
  • Loading branch information...
1 parent dc0cd77 commit cdc4bf8563e9f566cc6e3e0e4f8a7735cd92b88e David Nolen committed Sep 28, 2012
Showing with 0 additions and 166 deletions.
  1. +0 −56 src/main/clojure/clojure/core/logic.clj
  2. +0 −110 src/test/clojure/clojure/core/logic/tests.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
@@ -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}))

0 comments on commit cdc4bf8

Please sign in to comment.