Permalink
Browse files

fully lazy core.logic :)

occur check is now set via field in Substitution, `oc`. `solve` ->
`-run` and it takes an extra parameter now to set occurs-check. change
the run macros to use `-run`. remove `lazy-run` no longer needed.

update the benchmarks in bench.clj to use `doall` so we can time
things properly.
  • Loading branch information...
1 parent b6f2bbf commit 3be00503588772c5ababd35f037a967fb00036e2 @swannodette swannodette committed Dec 29, 2012
Showing with 82 additions and 92 deletions.
  1. +27 −34 src/main/clojure/clojure/core/logic.clj
  2. +55 −58 src/main/clojure/clojure/core/logic/bench.clj
@@ -5,7 +5,6 @@
(:import [java.io Writer]
[java.util UUID]))
-(def ^{:dynamic true} *occurs-check* true)
(def ^{:dynamic true} *reify-vars* true)
(def ^{:dynamic true} *locals*)
@@ -989,7 +988,7 @@
(occurs-check-term v u s)))
(defn ext [s u v]
- (if (and *occurs-check* (occurs-check s u (if (subst-val? v) (:v v) v)))
+ (if (and (:oc s) (occurs-check s u (if (subst-val? v) (:v v) v)))
nil
(ext-no-check s u v)))
@@ -1053,8 +1052,9 @@
;; cs - constraint store
;; cq - for the constraint queue
;; cqs - constraint ids in the queue
+;; oc - occurs check
-(deftype Substitutions [s vs ts cs cq cqs _meta]
+(deftype Substitutions [s vs ts cs cq cqs oc _meta]
Object
(equals [this o]
(or (identical? this o)
@@ -1069,7 +1069,7 @@
clojure.lang.IObj
(meta [this] _meta)
(withMeta [this new-meta]
- (Substitutions. s vs ts cs cq cqs new-meta))
+ (Substitutions. s vs ts cs cq cqs oc new-meta))
clojure.lang.ILookup
(valAt [this k]
@@ -1082,6 +1082,7 @@
:cs cs
:cq cq
:cqs cqs
+ :oc oc
not-found))
clojure.lang.IPersistentCollection
@@ -1104,23 +1105,25 @@
:cs [:cs cs]
:cq [:cq cq]
:cqs [:cqs cqs]
+ :oc [:oc cqs]
nil))
(assoc [this k v]
(case k
- :s (Substitutions. v vs ts cs cq cqs _meta)
- :vs (Substitutions. s v ts cs cq cqs _meta)
- :ts (Substitutions. s vs v cs cq cqs _meta)
- :cs (Substitutions. s vs ts v cq cqs _meta)
- :cq (Substitutions. s vs ts cs v cqs _meta)
- :cqs (Substitutions. s vs ts cs cq v _meta)
+ :s (Substitutions. v vs ts cs cq cqs oc _meta)
+ :vs (Substitutions. s v ts cs cq cqs oc _meta)
+ :ts (Substitutions. s vs v cs cq cqs oc _meta)
+ :cs (Substitutions. s vs ts v cq cqs oc _meta)
+ :cq (Substitutions. s vs ts cs v cqs oc _meta)
+ :cqs (Substitutions. s vs ts cs cq v oc _meta)
+ :oc (Substitutions. s vs ts cs cq cqs v _meta)
(throw (Exception. (str "Substitutions has no field for key" k)))))
ISubstitutions
(ext-no-check [this u v]
(let [u (if-not (lvar? v)
(assoc-meta u ::root true)
u)]
- (Substitutions. (assoc s u v) (if vs (conj vs u)) ts cs cq cqs _meta)))
+ (Substitutions. (assoc s u v) (if vs (conj vs u)) ts cs cq cqs oc _meta)))
(walk [this v]
(if (lvar? v)
@@ -1169,7 +1172,7 @@
xs (if (lvar? v)
[x (root-var this v)]
[x])
- s (if *occurs-check*
+ s (if oc
(ext this x v)
(ext-no-check this x v))]
(when s
@@ -1251,12 +1254,13 @@
(-> v :doms dom))))
(defn- make-s
- ([] (Substitutions. {} nil nil (make-cs) nil #{} nil))
- ([m] (Substitutions. m nil nil (make-cs) nil #{} nil))
- ([m cs] (Substitutions. m nil nil cs nil #{} nil)))
+ ([] (Substitutions. {} nil nil (make-cs) nil #{} true nil))
+ ([m] (Substitutions. m nil nil (make-cs) nil #{} true nil))
+ ([m cs] (Substitutions. m nil nil cs nil #{} true nil)))
-(defn tabled-s []
- (Substitutions. {} nil (atom {}) (make-cs) nil #{} nil))
+(defn tabled-s
+ ([] (tabled-s false))
+ ([oc] (Substitutions. {} nil (atom {}) (make-cs) nil #{} oc nil)))
(def empty-s (make-s))
(def empty-f (fn []))
@@ -1861,50 +1865,39 @@
(declare reifyg)
-(defmacro solve [& [n [x :as bindings] & goals]]
+(defmacro -run [oc n [x :as bindings] & goals]
(if (> (count bindings) 1)
- `(solve ~n [q#] (fresh ~bindings ~@goals (== q# ~bindings)))
+ `(-run ~oc ~n [q#] (fresh ~bindings ~@goals (== q# ~bindings)))
`(let [xs# (take* (fn []
((fresh [~x]
~@goals
(reifyg ~x))
- (tabled-s))))]
+ (tabled-s ~oc))))]
(if ~n
(take ~n xs#)
xs#))))
(defmacro run
"Executes goals until a maximum of n results are found."
[n & goals]
- `(doall (solve ~n ~@goals)))
+ `(-run true ~n ~@goals))
(defmacro run*
"Executes goals until results are exhausted."
[& goals]
- `(run false ~@goals))
+ `(-run true false ~@goals))
(defmacro run-nc
"Executes goals until a maximum of n results are found. Does not
occurs-check."
[& [n & goals]]
- `(binding [*occurs-check* false]
- (run ~n ~@goals)))
+ `(-run false ~n ~@goals))
(defmacro run-nc*
"Executes goals until results are exhausted. Does not occurs-check."
[& goals]
`(run-nc false ~@goals))
-(defmacro lazy-run
- "Lazily executes goals until a maximum of n results are found."
- [& [n & goals]]
- `(solve ~n ~@goals))
-
-(defmacro lazy-run*
- "Lazily executes goals until results are exhausted."
- [& goals]
- `(solve false ~@goals))
-
(defmacro all
"Like fresh but does does not create logic variables."
([] `clojure.core.logic/s#)
Oops, something went wrong.

0 comments on commit 3be0050

Please sign in to comment.