From b66b30f40abe557e169a9f6ec149f263c84b2f9c Mon Sep 17 00:00:00 2001 From: Nada Amin Date: Wed, 2 Jan 2013 16:06:50 +0100 Subject: [PATCH] LOGIC-92: tweaks for nominal logic and dom constraints --- src/main/clojure/clojure/core/logic/nominal.clj | 6 ++++++ src/test/clojure/clojure/core/logic/nominal/tests.clj | 14 ++++++++++++++ 2 files changed, 20 insertions(+) diff --git a/src/main/clojure/clojure/core/logic/nominal.clj b/src/main/clojure/clojure/core/logic/nominal.clj index b8bba20..038201b 100644 --- a/src/main/clojure/clojure/core/logic/nominal.clj +++ b/src/main/clojure/clojure/core/logic/nominal.clj @@ -39,6 +39,8 @@ (let [t (walk* s t)] (if (lvar? t) (let [v (with-meta (lvar) (meta t)) + rt (root-val s t) + s (if (subst-val? rt) (ext-no-check s v rt) s) s (update-dom s (root-var s v) ::nom (fnil (fn [d] (conj d t)) [])) s (update-dom s (root-var s t) ::nom (fnil (fn [d] (conj d v)) [])) s (bind s (suspc v t swap))] @@ -301,6 +303,10 @@ (-constrain-tree [t fc s] (fc (:body t) s)) + clojure.core.logic.IForceAnswerTerm + (-force-ans [v x] + (force-ans (:body v))) + INomSwap (swap-noms [t swap s] (let [[tbody s] (swap-noms (:body t) swap s)] diff --git a/src/test/clojure/clojure/core/logic/nominal/tests.clj b/src/test/clojure/clojure/core/logic/nominal/tests.clj index 2e31cd7..609fb89 100644 --- a/src/test/clojure/clojure/core/logic/nominal/tests.clj +++ b/src/test/clojure/clojure/core/logic/nominal/tests.clj @@ -379,3 +379,17 @@ (predc x number? `number?) (== (nom/tie a [a x]) q)))) [(nom/tie 'a_0 '(a_0 1))]))) + +(deftest test-92-infd-lost + (is (= (run* [q] + (fresh [x] + (nom/fresh [a] + (infd x (interval 1 3)) + (== q (nom/tie a x))))) + [(nom/tie 'a_0 1) (nom/tie 'a_0 2) (nom/tie 'a_0 3)])) + (is (= (run* [q] + (nom/fresh [a b c] + (fresh [x] + (infd x (interval 1 3)) + (== (nom/tie b (nom/tie a x)) (nom/tie c q))))) + [(nom/tie 'a_0 1) (nom/tie 'a_0 2) (nom/tie 'a_0 3)]))) -- 1.7.10.4