From 9b340ea4fff2f4dad50b0f9631054e713b895fe8 Mon Sep 17 00:00:00 2001
From: "Kevin J. Lynagh" <kevin@keminglabs.com>
Date: Fri, 12 Oct 2012 11:09:25 -0700
Subject: [PATCH] Add PMap (partial-map) record that unifies with maps whose
 keys are a superset of its keys.

---
 src/main/clojure/clojure/core/logic.clj       |  8 +++
 .../clojure/core/logic/partial_map.clj        | 59 +++++++++++++++++++
 src/test/clojure/clojure/core/logic/tests.clj |  8 +++
 3 files changed, 75 insertions(+)
 create mode 100644 src/main/clojure/clojure/core/logic/partial_map.clj

diff --git a/src/main/clojure/clojure/core/logic.clj b/src/main/clojure/clojure/core/logic.clj
index 6a2b6d80..5089b1f0 100644
--- a/src/main/clojure/clojure/core/logic.clj
+++ b/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")
diff --git a/src/main/clojure/clojure/core/logic/partial_map.clj b/src/main/clojure/clojure/core/logic/partial_map.clj
new file mode 100644
index 00000000..97089b18
--- /dev/null
+++ b/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))
diff --git a/src/test/clojure/clojure/core/logic/tests.clj b/src/test/clojure/clojure/core/logic/tests.clj
index 7b062408..3d264958 100644
--- a/src/test/clojure/clojure/core/logic/tests.clj
+++ b/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