Permalink
Browse files

LOGIC-92: tweaks for nominal logic and dom constraints

  • Loading branch information...
1 parent 5c2800a commit f973b36cb02b3b797852859f2cc2a09356157cc4 @namin namin committed with swannodette Jan 2, 2013
View
6 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)]
View
14 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)])))

0 comments on commit f973b36

Please sign in to comment.