Permalink
Browse files

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.
  • Loading branch information...
1 parent ae66b6f commit d5eda7d7f89443b449d7955a76e72828561082f6 @swannodette swannodette committed Mar 18, 2013
@@ -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
@@ -212,4 +212,10 @@
;; Deep constraints
(defprotocol IConstrainTree
- (-constrain-tree [t fc s]))
+ (-constrain-tree [t fc s]))
+
+;; -----------------------------------------------------------------------------
+;; Features
+
+(defprotocol IFeature
+ (-feature [x]))
@@ -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

0 comments on commit d5eda7d

Please sign in to comment.