Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

LOGIC-62: add IRelevantVar protocol. updatec now uses it. move unboun…

…d-vars after Substitutions

definition. !=c constraint no purges vars as they disappear from the prefix. changed
logic var names for distincto. tests.
  • Loading branch information...
commit 36cd3dfabd4848bce1c57fe5147b7f6c353de1b6 1 parent 1ae0929
David Nolen authored
Showing with 25 additions and 13 deletions.
  1. +25 −13 src/main/clojure/clojure/core/logic.clj
View
38 src/main/clojure/clojure/core/logic.clj
@@ -165,6 +165,9 @@
(defprotocol IRelevant
(-relevant? [this s]))
+(defprotocol IRelevantVar
+ (-relevant-var? [this x]))
+
(defprotocol IReifiableConstraint
(reifiable? [this])
(reifyc [this v r]))
@@ -793,13 +796,6 @@
(filter lvar?)
(into [])))
-(declare walk-unbound)
-
-(defn unbound-rands [a c]
- (->> (rands c)
- flatten
- (filter #(lvar? (walk-unbound a %)))))
-
(declare add-var)
;; ConstraintStore
@@ -828,7 +824,15 @@
cs (reduce (fn [cs v] (add-var cs v c)) this vars)]
(ConstraintStore. (:km cs) (:cm cs) (inc cid) running)))
(updatec [this c]
- (ConstraintStore. km (assoc cm (id c) c) cid running))
+ (let [oc (cm (id c))
+ nkm (if (satisfies? IRelevantVar c)
+ (reduce (fn [km x]
+ (if-not (-relevant-var? c x)
+ (dissoc km x)
+ km))
+ km (var-rands oc))
+ km)]
+ (ConstraintStore. nkm (assoc cm (id c) c) cid running)))
(remc [this c]
(let [vs (var-rands c)
ocid (id c)
@@ -1074,6 +1078,11 @@
l (reduce (fn [l [k v]] (cons (Pair. k v) l)) '() v)]
(make-s s l (make-cs))))
+(defn unbound-rands [a c]
+ (->> (rands c)
+ flatten
+ (filter #(lvar? (walk-unbound a %)))))
+
;; =============================================================================
;; Logic Variables
@@ -3609,6 +3618,9 @@
IRelevant
(-relevant? [this s]
(not (empty? p)))
+ IRelevantVar
+ (-relevant-var? [this x]
+ ((recover-vars p) x))
IConstraintWatchedStores
(watched-stores [this] #{::subst}))))
@@ -3651,11 +3663,11 @@
with another element of l."
[l]
([()])
- ([[a]])
- ([[a b . r]]
- (!= a b)
- (distincto (lcons a r))
- (distincto (lcons b r))))
+ ([[h]])
+ ([[h0 h1 . t]]
+ (!= h0 h1)
+ (distincto (lcons h0 t))
+ (distincto (lcons h1 t))))
(defne rembero
"A relation between l and o where is removed from
Please sign in to comment.
Something went wrong with that request. Please try again.