From 37d35b1a622eb4cf80e0bda1eea3e9f61279546a Mon Sep 17 00:00:00 2001 From: "Kevin J. Lynagh" Date: Sun, 3 Feb 2013 21:04:00 -0800 Subject: [PATCH 1/3] Add tests for unifier with `defc` constraint. --- src/test/clojure/clojure/core/logic/tests.clj | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/src/test/clojure/clojure/core/logic/tests.clj b/src/test/clojure/clojure/core/logic/tests.clj index 396dd4b..6169218 100644 --- a/src/test/clojure/clojure/core/logic/tests.clj +++ b/src/test/clojure/clojure/core/logic/tests.clj @@ -1197,6 +1197,24 @@ (is (= (unifier '{:a [?b (?c [?d {:e ?e}])]} {:a [:b '(:c [:d {:e :e}])]}) {:a [:b '(:c [:d {:e :e}])]}))) +;; ----------------------------------------------------------------------------- +;; Unifier with defc constraints + +(defc 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))) + (deftest test-binding-map-1 (is (= (binding-map '(?x ?y) '(1 2)) -- 1.7.9.6 (Apple Git-31.1) From 9e1a9ac99d29538924a2fdbb4093b5f25fc8b770 Mon Sep 17 00:00:00 2001 From: "Kevin J. Lynagh" Date: Sun, 3 Feb 2013 21:49:44 -0800 Subject: [PATCH 2/3] Add `constraint` macro that defines anonymous constraints suitable for use with the unifier's :when map. The `defc` macro now defers to this macro. --- src/main/clojure/clojure/core/logic.clj | 63 ++++++++++++++++--------- src/test/clojure/clojure/core/logic/tests.clj | 9 +++- 2 files changed, 48 insertions(+), 24 deletions(-) diff --git a/src/main/clojure/clojure/core/logic.clj b/src/main/clojure/clojure/core/logic.clj index 9523e30..34337bb 100644 --- a/src/main/clojure/clojure/core/logic.clj +++ b/src/main/clojure/clojure/core/logic.clj @@ -2910,30 +2910,47 @@ ;; consider ^:partial type hint for arguments ;; these argument only need to be partially instantiated +(defmacro constraint + "Define an anonymous constraint that can be used with the unifier: + + (let [oddc (constraint [x] (odd? x))] + + (unifier {:a '?a} {:a 1} :when {'?a oddc}) + ;;=> {:a 1} + + (unifier {:a '?a} {:a 2} :when {'?a oddc}) + ;;=> nil + ) + + Use defc 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 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)))))) + `(def ~name (constraint ~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 6169218..e891ce0 100644 --- a/src/test/clojure/clojure/core/logic/tests.clj +++ b/src/test/clojure/clojure/core/logic/tests.clj @@ -1198,7 +1198,7 @@ {:a [:b '(:c [:d {:e :e}])]}))) ;; ----------------------------------------------------------------------------- -;; Unifier with defc constraints +;; Unifier with constraints (defc evenc [x] (even? x)) @@ -1215,6 +1215,13 @@ (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 (constraint [x] (even? x))}) + {:a 2})) + (is (= (unifier '{:a ?a} {:a 1} :when {'?a (constraint [x] (even? x))}) + nil))) + (deftest test-binding-map-1 (is (= (binding-map '(?x ?y) '(1 2)) -- 1.7.9.6 (Apple Git-31.1) From 8e278ec7e4ab92c6454a8ab006f279c3a0653897 Mon Sep 17 00:00:00 2001 From: "Kevin J. Lynagh" Date: Sun, 3 Feb 2013 22:19:36 -0800 Subject: [PATCH 3/3] Rename `constraint` to `fnc` and `defc` to `defnc` for terseness. --- src/main/clojure/clojure/core/logic.clj | 12 ++++++------ src/test/clojure/clojure/core/logic/tests.clj | 2 +- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/main/clojure/clojure/core/logic.clj b/src/main/clojure/clojure/core/logic.clj index 34337bb..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,10 +2910,10 @@ ;; consider ^:partial type hint for arguments ;; these argument only need to be partially instantiated -(defmacro constraint +(defmacro fnc "Define an anonymous constraint that can be used with the unifier: - (let [oddc (constraint [x] (odd? x))] + (let [oddc (fnc [x] (odd? x))] (unifier {:a '?a} {:a 1} :when {'?a oddc}) ;;=> {:a 1} @@ -2922,7 +2922,7 @@ ;;=> nil ) - Use defc to define a constraint and assign a toplevel var." + Use defnc to define a constraint and assign a toplevel var." [args & body] (let [name (gensym "constraint") -name (symbol (str "-" name))] @@ -2949,8 +2949,8 @@ (~'watched-stores [_#] #{:clojure.core.logic/subst})))] ~name))) -(defmacro defc [name args & body] - `(def ~name (constraint ~args ~@body))) +(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 e891ce0..e30b9fe 100644 --- a/src/test/clojure/clojure/core/logic/tests.clj +++ b/src/test/clojure/clojure/core/logic/tests.clj @@ -1200,7 +1200,7 @@ ;; ----------------------------------------------------------------------------- ;; Unifier with constraints -(defc evenc [x] +(defnc evenc [x] (even? x)) (deftest test-unifier-constraints-1 ;;One var -- 1.7.9.6 (Apple Git-31.1)