Permalink
Browse files

Add `fnc` macro that defines anonymous constraints suitable for use w…

…ith the unifier's :when map, rename `defc` to `defnc` for consistency.
  • Loading branch information...
1 parent 7d04a84 commit f015355c6cc375294c7b6a4b29565b62f0a68e27 @lynaghk lynaghk committed with swannodette Feb 4, 2013
Showing with 67 additions and 25 deletions.
  1. +42 −25 src/main/clojure/clojure/core/logic.clj
  2. +25 −0 src/test/clojure/clojure/core/logic/tests.clj
@@ -2887,7 +2887,7 @@
(cgoal (-featurec x (partial-map fs))))
;; =============================================================================
-;; defc
+;; defnc
(defn ground-term? [x s]
(letfn [(-ground-term? [x s]
@@ -2910,30 +2910,47 @@
;; consider ^:partial type hint for arguments
;; these argument only need to be partially instantiated
-(defmacro defc [name args & body]
- (let [-name (symbol (str "-" name))]
- `(let [~-name (fn ~-name
- [~@args]
- (reify
- ~'clojure.lang.IFn
- (~'invoke [this# a#]
- (let [[~@args :as args#] (map #(clojure.core.logic/walk* a# %) ~args)
- test# (do ~@body)]
- (when test#
- ((clojure.core.logic/remcg this#) a#))))
- clojure.core.logic/IConstraintOp
- (~'rator [_#] '~name)
- (~'rands [_#] (filter clojure.core.logic/lvar? (flatten ~args)))
- clojure.core.logic/IReifiableConstraint
- (~'reifyc [_# _# r# a#]
- (list '~name (map #(clojure.core.logic/-reify r# %) ~args)))
- clojure.core.logic/IRunnable
- (~'runnable? [_# s#]
- (clojure.core.logic/ground-term? ~args s#))
- clojure.core.logic/IConstraintWatchedStores
- (~'watched-stores [_#] #{:clojure.core.logic/subst})))]
- (defn ~name ~args
- (cgoal (~-name ~@args))))))
+(defmacro fnc
+ "Define an anonymous constraint that can be used with the unifier:
+
+ (let [oddc (fnc [x] (odd? x))]
+
+ (unifier {:a '?a} {:a 1} :when {'?a oddc})
+ ;;=> {:a 1}
+
+ (unifier {:a '?a} {:a 2} :when {'?a oddc})
+ ;;=> nil
+ )
+
+ Use defnc to define a constraint and assign a toplevel var."
+ [args & body]
+ (let [name (gensym "constraint")
+ -name (symbol (str "-" name))]
+ `(letfn [(~name [~@args]
+ (cgoal (~-name ~@args)))
+ (~-name [~@args]
+ (reify
+ ~'clojure.lang.IFn
+ (~'invoke [this# a#]
+ (let [[~@args :as args#] (map #(clojure.core.logic/walk* a# %) ~args)
+ test# (do ~@body)]
+ (when test#
+ ((clojure.core.logic/remcg this#) a#))))
+ clojure.core.logic/IConstraintOp
+ (~'rator [_#] '~name)
+ (~'rands [_#] (filter clojure.core.logic/lvar? (flatten ~args)))
+ clojure.core.logic/IReifiableConstraint
+ (~'reifyc [_# _# r# a#]
+ (list '~name (map #(clojure.core.logic/-reify r# %) ~args)))
+ clojure.core.logic/IRunnable
+ (~'runnable? [_# s#]
+ (clojure.core.logic/ground-term? ~args s#))
+ clojure.core.logic/IConstraintWatchedStores
+ (~'watched-stores [_#] #{:clojure.core.logic/subst})))]
+ ~name)))
+
+(defmacro defnc [name args & body]
+ `(def ~name (fnc ~args ~@body)))
;; =============================================================================
;; Predicate Constraint
@@ -1197,6 +1197,31 @@
(is (= (unifier '{:a [?b (?c [?d {:e ?e}])]} {:a [:b '(:c [:d {:e :e}])]})
{:a [:b '(:c [:d {:e :e}])]})))
+;; -----------------------------------------------------------------------------
+;; Unifier with constraints
+
+(defnc evenc [x]
+ (even? x))
+
+(deftest test-unifier-constraints-1 ;;One var
+ (is (= (unifier '{:a ?a} {:a 2} :when {'?a evenc})
+ {:a 2}))
+ (is (= (unifier '{:a ?a} {:a 1} :when {'?a evenc})
+ nil)))
+
+(deftest test-unifier-constraints-2 ;;Two vars
+ (is (= (unifier '{:a ?a :b ?b} {:a 2 :b 2} :when {'?a evenc '?b evenc})
+ {:a 2 :b 2}))
+ (is (= (unifier '{:a ?a :b ?b} {:a 1 :b 2} :when {'?a evenc '?b evenc})
+ nil)))
+
+;;Anonymous constraints
+(deftest test-unifier-constraints-3 ;;One var
+ (is (= (unifier '{:a ?a} {:a 2} :when {'?a (fnc [x] (even? x))})
+ {:a 2}))
+ (is (= (unifier '{:a ?a} {:a 1} :when {'?a (fnc [x] (even? x))})
+ nil)))
+
(deftest test-binding-map-1
(is (= (binding-map '(?x ?y) '(1 2))

0 comments on commit f015355

Please sign in to comment.