From 053654494177136753dd481728c1dea0c29489fe Mon Sep 17 00:00:00 2001
From: "Kevin J. Lynagh" <kevin@keminglabs.com>
Date: Sun, 3 Feb 2013 21:04:00 -0800
Subject: [PATCH] Add `fnc` macro that defines anonymous constraints suitable
 for use with the unifier's :when map, rename `defc` to
 `defnc` for consistency.

---
 src/main/clojure/clojure/core/logic.clj       |   67 ++++++++++++++++---------
 src/test/clojure/clojure/core/logic/tests.clj |   25 +++++++++
 2 files changed, 67 insertions(+), 25 deletions(-)

diff --git a/src/main/clojure/clojure/core/logic.clj b/src/main/clojure/clojure/core/logic.clj
index 9523e30..e49070f 100644
--- a/src/main/clojure/clojure/core/logic.clj
+++ b/src/main/clojure/clojure/core/logic.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
diff --git a/src/test/clojure/clojure/core/logic/tests.clj b/src/test/clojure/clojure/core/logic/tests.clj
index 396dd4b..3f8e50c 100644
--- a/src/test/clojure/clojure/core/logic/tests.clj
+++ b/src/test/clojure/clojure/core/logic/tests.clj
@@ -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))
-- 
1.7.9.6 (Apple Git-31.1)