Permalink
Browse files

LOGIC-91: `predc` constraint entailment issues

The problem is that cgoal calls `runnable?`, runs the constraint, then
calls `relevant?`, however when a constraint is already in the store
we call `relevant?` *first*, because of other constraints may have
done the work for us.

Added `irelevant?` predicate. `cgoal` and the `run-constraint` now use
this. Remove all `IRelevant` implementations that simply return
`true`.

The all different constraint will still exhibit the issue as
FDConstraint implements `IRelevant` for delegation purporses. We
should probably eliminate `FDConstraint` and implement some kind of
templating facility to avoid the boilerplate.
  • Loading branch information...
1 parent 33ce790 commit 020f730429d71315f752ea51abad20dca896c8b0 @swannodette swannodette committed Jan 2, 2013
@@ -2976,6 +2976,9 @@
(fn [a]
(assoc a :cs (runc (:cs a) c false))))
+(defn irelevant? [c]
+ (instance? clojure.core.logic.IRelevant c))
+
(defn relevant? [c a]
(let [id (id c)]
(and (or ((-> a :cs :cm) id)
@@ -2984,7 +2987,7 @@
(defn run-constraint [c]
(fn [a]
- (if (relevant? c a)
+ (if (or (not (irelevant? c)) (relevant? c a))
(if (runnable? c a)
((composeg* (runcg c) c (stopcg c)) a)
a)
@@ -3102,7 +3105,7 @@
(invoke [_ a]
(if (runnable? c a)
(when-let [a (c a)]
- (if (relevant? c a)
+ (if (and (irelevant? c) (relevant? c a))
((addcg c) a)
a))
((addcg c) a)))
@@ -3643,7 +3646,7 @@
(rator [_] `-distinctfd)
(rands [_] [x])
IRelevant
- (-relevant? [this s] true) ;; we are relevant until we run
+ (-relevant? [this s] true) ;; FIXME: this is because FDConstraint delegates :( - David
IRunnable
(runnable? [this s]
;; we can only run if x is is bound to
@@ -3698,8 +3701,7 @@
(rator [_] `distinctfd)
(rands [_] [v*])
IRelevant
- (-relevant? [this s]
- true)
+ (-relevant? [this s] true) ;; FIXME: this is because FDConstraint delegates :( - David
IRunnable
(runnable? [this s]
(let [v* (walk s v*)]
@@ -4068,8 +4070,6 @@
(let [fs (into {} fs)
r (-reify* r (walk* a fs))]
`(featurec ~(walk* r x) ~(walk* r fs))))
- IRelevant
- (-relevant? [_ a] true)
IRunnable
(runnable? [_ a]
(not (lvar? (walk a x))))
@@ -4130,8 +4130,6 @@
clojure.core.logic/IReifiableConstraint
(~'reifyc [_# _# r# a#]
(list '~name (map #(-reify r# %) ~args)))
- clojure.core.logic/IRelevant
- (~'-relevant? [_# s#] true)
clojure.core.logic/IRunnable
(~'runnable? [_# s#]
(ground-term? ~args s#))
@@ -4169,8 +4167,6 @@
IReifiableConstraint
(reifyc [_ v r a]
pform)
- IRelevant
- (-relevant? [_ a] true)
IRunnable
(runnable? [_ a]
(not (lvar? (walk a x))))
@@ -4243,8 +4239,6 @@
(reifier c x v r a)
(let [x (walk* r x)]
`(fixc ~x ~reifier))))
- IRelevant
- (-relevant? [_ a] true)
IRunnable
(runnable? [_ a]
(not (lvar? (walk a x))))
@@ -225,8 +225,6 @@
(symbol? (first swap))
(symbol? (second swap)))
`(~'swap ~swap ~t1 ~t2))))
- clojure.core.logic.IRelevant
- (-relevant? [_ a] true)
clojure.core.logic.IRunnable
(runnable? [_ a]
(let [t1 (walk a v1)
@@ -361,3 +361,21 @@
(== y 'foo)
(== [x y] q))))
'())))
+
+;; tickets
+
+(deftest test-77-predc-not-purged
+ (is (= (run* [q]
+ (nom/fresh [a]
+ (fresh [x]
+ (predc x number? `number?)
+ (== x 1)
+ (== (nom/tie a [a x]) q))))
+ [(nom/tie 'a_0 '(a_0 1))]))
+ (is (= (run* [q]
+ (nom/fresh [a]
+ (fresh [x]
+ (== x 1)
+ (predc x number? `number?)
+ (== (nom/tie a [a x]) q))))
+ [(nom/tie 'a_0 '(a_0 1))])))

0 comments on commit 020f730

Please sign in to comment.