Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Add PMap (partial-map) record that unifies with maps whose keys are a…

… superset of its keys.
  • Loading branch information...
commit 9b340ea4fff2f4dad50b0f9631054e713b895fe8 1 parent e458733
@lynaghk lynaghk authored David Nolen committed
View
8 src/main/clojure/clojure/core/logic.clj
@@ -3738,3 +3738,11 @@
([_ [y . ys] [y . zs]]
(!= y x)
(rembero x ys zs)))
+
+
+
+
+
+
+
+(load "logic/partial_map")
View
59 src/main/clojure/clojure/core/logic/partial_map.clj
@@ -0,0 +1,59 @@
+;;This file defines a PMap (partial map) record that unifies with maps without having all of that map's keys.
+(in-ns 'clojure.core.logic)
+
+(defprotocol IUnifyWithPMap
+ (unify-with-pmap [pmap u s]))
+
+(defrecord PMap []
+ IUnifyWithMap
+ (unify-with-map [v u s]
+ (loop [ks (keys v) s s]
+ (if (seq ks)
+ (let [kf (first ks)
+ uf (get u kf ::not-found)]
+ (if (= uf ::not-found)
+ nil
+ (if-let [s (unify s (get v kf) uf)]
+ (recur (next ks) s)
+ nil)))
+ s)))
+
+ IUnifyWithPMap
+ (unify-with-pmap [v u s]
+ (unify-with-map v u s))
+
+ IUnifyTerms
+ (unify-terms [u v s]
+ (unify-with-pmap v u s))
+
+ IUnifyWithLVar
+ (unify-with-lvar [v u s]
+ (ext-no-check s u v)))
+
+(extend-protocol IUnifyWithPMap
+ nil
+ (unify-with-pmap [v u s] nil)
+
+ Object
+ (unify-with-pmap [v u s] nil)
+
+ clojure.core.logic.LVar
+ (unify-with-pmap [v u s]
+ (ext s v u))
+
+ clojure.lang.IPersistentMap
+ (unify-with-pmap [v u s]
+ (unify-with-map u v s)))
+
+(defn partial-map
+ "Given map m, returns partial map that unifies with maps even if it doesn't share all of the keys of that map.
+ Only the keys of the partial map will be unified:
+
+ (run* [q]
+ (fresh [pm x]
+ (== pm (partial-map {:a x}))
+ (== pm {:a 1 :b 2})
+ (== pm q)))
+ ;;=> ({:a 1})"
+ [m]
+ (map->PMap m))
View
8 src/test/clojure/clojure/core/logic/tests.clj
@@ -1196,6 +1196,14 @@
(== z [x y])
(== [x] [3])))))
+(deftest test-49-partial-map-unification
+ (is (= '[{:a 1}]
+ (run* [q]
+ (fresh [pm x]
+ (== pm (partial-map {:a x}))
+ (== pm {:a 1 :b 2})
+ (== pm q))))))
+
;; =============================================================================
;; cKanren
Please sign in to comment.
Something went wrong with that request. Please try again.