Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

LOGIC-126: bad fd/* fd/+ from StackOverflow

The issue is that it's possible for a var to have both a value and
domain. Previously get-dom *always* returned the domain, this
permitted an the undesirable situation that constraints checked against
the domain and not the actual value.

Now the fundamental get-dom always return the value if the var has one
over the domain (it continues to return nil in the unfound case, which
will likely change). After auditing the fd code it's clear that the
primary use of get-dom was the desire to get the actual value or the
domain. The only place where we don't do this is domc. domc has to
reach into the implementation. This is OK for now, I'd like to see
how CLP(Set) and other constraint domains play out.

We tweaked resolve-storable-dom in the singleton case. We only run
constraints if the var doesn't have a binding (we wouldn't have made
it this far if it had). This prevents I believe the bad behavior we
seen in the past when flipping walk/get-dom in let-dom.

let-dom now just uses get-dom, no separate walk. Added note in
distintc why we need both get-dom and walk there.

Overall we're getting closer, but I think further simplifications and
improvment can be made.
  • Loading branch information...
commit 52eec3b04c2b785c84bed81671db80c2163c4967 1 parent 8098ae1
@swannodette swannodette authored
View
15 src/main/clojure/clojure/core/logic.clj
@@ -493,8 +493,14 @@
(defn get-dom [s x dom]
(let [v (root-val s x)]
- (if (subst-val? v)
- (-> v :doms dom))))
+ (cond
+ (subst-val? v) (let [v' (:v v)]
+ (if (not= v' ::unbound)
+ v'
+ (-> v :doms dom)))
+ (not (lvar? v)) v
+ ;; :else ::no-dom ;; NOTE: this doesn't work, some assumptions about nil - David
+ )))
(defn- make-s
([] (make-s {}))
@@ -2310,10 +2316,7 @@
(defmacro let-dom
[a vars & body]
(let [get-var-dom (fn [a [v b]]
- `(~b (let [v# (walk ~a ~v)]
- (if (lvar? v#)
- (get-dom-fd ~a v#)
- v#))))]
+ `(~b (get-dom-fd ~a ~v)))]
`(let [~@(mapcat (partial get-var-dom a) (partition 2 vars))]
~@body)))
View
15 src/main/clojure/clojure/core/logic/fd.clj
@@ -627,7 +627,10 @@
(defn resolve-storable-dom
[a x dom]
(if (singleton-dom? dom)
- (ext-run-cs (rem-dom a x ::l/fd) x dom)
+ (let [xv (walk a x)]
+ (if (lvar? xv)
+ (ext-run-cs (rem-dom a x ::l/fd) x dom)
+ a))
(ext-dom-fd a x dom)))
(defn update-var-dom
@@ -712,14 +715,16 @@
IEnforceableConstraint
clojure.lang.IFn
(invoke [this s]
- (when (member? (get-dom s x) (walk s x))
- (rem-dom s x ::l/fd)))
+ (let [dom (-> (root-val s x) :doms ::l/fd)]
+ (when (member? dom (walk s x))
+ (rem-dom s x ::l/fd))))
IConstraintOp
(rator [_] `domc)
(rands [_] [x])
IRelevant
(-relevant? [this s]
- (not (nil? (get-dom s x))))
+ (let [dom (-> (root-val s x) :doms ::l/fd)]
+ (not (nil? dom))))
IRunnable
(runnable? [this s]
(not (lvar? (walk s x))))
@@ -1026,6 +1031,8 @@
(loop [y* (seq y*) s s]
(if y*
(let [y (first y*)
+ ;; NOTE: we can't just get-dom because get-dom
+ ;; return nil, walk returns the var - David
v (or (get-dom s y) (walk s y))
s (if-not (lvar? v)
(cond
View
10 src/test/clojure/clojure/core/logic/tests.clj
@@ -1789,6 +1789,16 @@
:shoe-palace sp
:tootsies tt})))))))
+(deftest test-126-times-plus
+ (is (= (set
+ (run* [q]
+ (fresh [x y p]
+ (fd/in x y (fd/interval 1 38))
+ (fd/* x y p)
+ (fd/+ p 2 40)
+ (== q [x y]))))
+ #{[1 38] [38 1] [2 19] [19 2]})))
+
;; =============================================================================
;; cKanren
Please sign in to comment.
Something went wrong with that request. Please try again.