From d5eda7d7f89443b449d7955a76e72828561082f6 Mon Sep 17 00:00:00 2001
From: David Nolen <david.nolen@gmail.com>
Date: Sun, 17 Mar 2013 17:49:29 -0700
Subject: [PATCH] LOGIC-108: recursive featurec. Add protocol IFeature.
 Implementers should return something which can optional unify in the manner
 of partial-map. Extend IPersistentHashMap to IFeature. Add test cases
 demonstrating recursive behavior.

---
 src/main/clojure/clojure/core/logic.clj           | 14 +++++++++++++-
 src/main/clojure/clojure/core/logic/protocols.clj |  8 +++++++-
 src/test/clojure/clojure/core/logic/tests.clj     | 14 ++++++++++++++
 3 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/src/main/clojure/clojure/core/logic.clj b/src/main/clojure/clojure/core/logic.clj
index f68663b5..33b3bc6c 100644
--- a/src/main/clojure/clojure/core/logic.clj
+++ b/src/main/clojure/clojure/core/logic.clj
@@ -2629,6 +2629,10 @@
 (defn partial-map? [x]
   (instance? PMap x))
 
+(extend-type clojure.lang.IPersistentMap
+  IFeature
+  (-feature [x] (partial-map x)))
+
 (defn -featurec
   [x fs]
   (reify
@@ -2651,13 +2655,21 @@
     IConstraintWatchedStores
     (watched-stores [this] #{::subst})))
 
+(defn ->feature [x]
+  (-feature
+    (walk-term x
+      (fn [y]
+        (if (tree-term? y)
+          (->feature y)
+          y)))))
+
 (defn featurec
   "Ensure that a map contains at least the key-value pairs
   in the map fs. fs must be partially instantiated - that is, 
   it may contain values which are logic variables to support 
   feature extraction."
   [x fs]
-  (cgoal (-featurec x (partial-map fs))))
+  (cgoal (-featurec x (->feature fs))))
 
 ;; =============================================================================
 ;; defnc
diff --git a/src/main/clojure/clojure/core/logic/protocols.clj b/src/main/clojure/clojure/core/logic/protocols.clj
index 6231f4d7..ec0c1f67 100644
--- a/src/main/clojure/clojure/core/logic/protocols.clj
+++ b/src/main/clojure/clojure/core/logic/protocols.clj
@@ -212,4 +212,10 @@
 ;; Deep constraints
 
 (defprotocol IConstrainTree
-  (-constrain-tree [t fc s]))
\ No newline at end of file
+  (-constrain-tree [t fc s]))
+
+;; -----------------------------------------------------------------------------
+;; Features
+
+(defprotocol IFeature
+  (-feature [x]))
diff --git a/src/test/clojure/clojure/core/logic/tests.clj b/src/test/clojure/clojure/core/logic/tests.clj
index c3f04860..059fbcea 100644
--- a/src/test/clojure/clojure/core/logic/tests.clj
+++ b/src/test/clojure/clojure/core/logic/tests.clj
@@ -1736,6 +1736,20 @@
   (is (= (u/unifier ['(?x ?y) '(?y ?x)])
          '{?x ?y})))
 
+(deftest test-108-recursive-features
+  (is (= (run* [x y]
+           (featurec x {:foo {:bar y}})
+           (== x {:foo {:bar 1}}))
+        '([{:foo {:bar 1}} 1])))
+  (is (= (run* [x y]
+           (featurec x {:foo {:bar y}})
+           (== x {:foo {:bar 1 :woz 2}}))
+        '([{:foo {:bar 1 :woz 2}} 1])))
+  (is (= (run* [x y]
+           (featurec x {:foo {:bar y}})
+           (== x {:foo {:baz 1}}))
+        '())))
+
 ;; =============================================================================
 ;; cKanren