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.

src/main/clojure/clojure/core/logic.clj

@@ -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))))

src/main/clojure/clojure/core/logic/nominal.clj

@@ -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)

src/test/clojure/clojure/core/logic/nominal/tests.clj

@@ -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))])))