diff --git a/src/main/clojure/clojure/core/logic.clj b/src/main/clojure/clojure/core/logic.clj
index ae65105..a9c308a 100644
--- a/src/main/clojure/clojure/core/logic.clj
+++ b/src/main/clojure/clojure/core/logic.clj
@@ -92,11 +92,20 @@
 (defprotocol IBind
   (bind [this g]))
 
+(defprotocol IBindFair
+  (bind-fair [this g]))
+
 (defprotocol IMPlus
-  (mplus [a f]))
+  (mplus [this that]))
+
+(defprotocol ILeaf
+  (value [this] "The value at this leaf"))
+
+(defprotocol IBranch
+  (children [this] "The children of this node"))
 
-(defprotocol ITake
-  (take* [a]))
+(defn leaf? [thing]
+  (instance? clojure.core.logic.ILeaf thing))
 
 ;; -----------------------------------------------------------------------------
 ;; soft cut & committed choice protocols
@@ -1183,11 +1192,12 @@
   IBind
   (bind [this g]
     (g this))
-  IMPlus
-  (mplus [this f]
-    (choice this f))
-  ITake
-  (take* [this] this))
+  IBindFair
+  (bind-fair [this g]
+    (g this))
+  ILeaf
+  (value [this]
+    this))
 
 (defn add-attr [s x attr attrv]
   (let [x (root-var s x)
@@ -1250,7 +1260,6 @@
   ([m cs] (Substitutions. m nil cs nil #{} nil)))
 
 (def empty-s (make-s))
-(def empty-f (fn []))
 
 (defn subst? [x]
   (instance? Substitutions x))
@@ -1715,40 +1724,48 @@
   ([a g & g-rest]
      `(bind* (bind ~a ~g) ~@g-rest)))
 
+(defmacro bind-fair*
+  ([a g] `(bind-fair ~a ~g))
+  ([a g & g-rest]
+     `(bind-fair* (bind-fair ~a ~g) ~@g-rest)))
+
 (defmacro mplus*
   ([e] e)
   ([e & e-rest]
-     `(mplus ~e (fn [] (mplus* ~@e-rest)))))
+     `(mplus ~e (mplus* ~@e-rest))))
 
-(defmacro -inc [& rest]
-  `(fn -inc [] ~@rest))
-
-(extend-type Object
-  ITake
-  (take* [this] this))
+(declare choice)
 
-;; TODO: Choice always holds a as a list, can we just remove that?
-
-(deftype Choice [a f]
+(deftype Choice [left right]
   clojure.lang.ILookup
   (valAt [this k]
     (.valAt this k nil))
   (valAt [this k not-found]
     (case k
-      :a a
+      :left left
+      :right right
       not-found))
   IBind
   (bind [this g]
-    (mplus (g a) (fn [] (bind f g))))
-  IMPlus
-  (mplus [this fp]
-    (Choice. a (fn [] (mplus (fp) f))))
-  ITake
-  (take* [this]
-    (lazy-seq (cons (first a) (lazy-seq (take* f))))))
+    (choice (bind left g) (bind right g)))
+  IBindFair
+  (bind-fair [this g]
+    (choice (bind-fair left g) (bind-fair right g)))
+  IBranch
+  (children [this]
+    [left right]))
+
+(defn choice [left right]
+  (cond
+   (nil? left) right
+   (nil? right) left
+   :else (Choice. left right)))
 
-(defn choice [a f]
-  (Choice. a f))
+;; TODO: might a binary tree be better?
+(defmacro choice*
+  ([e] e)
+  ([e & e-rest]
+     `(choice ~e (choice* ~@e-rest))))
 
 ;; -----------------------------------------------------------------------------
 ;; MZero
@@ -1757,34 +1774,41 @@
   nil
   (bind [_ g] nil))
 
-(extend-protocol IMPlus
+(extend-protocol IBindFair
   nil
-  (mplus [_ f] (f)))
-
-(extend-protocol ITake
-  nil
-  (take* [_] '()))
-
-;; -----------------------------------------------------------------------------
-;; Unit
-
-(extend-type Object
-  IMPlus
-  (mplus [this f]
-    (Choice. this f)))
+  (bind-fair [_ g] nil))
 
 ;; -----------------------------------------------------------------------------
 ;; Inc
 
-(extend-type clojure.lang.Fn
+(deftype Inc [a restg]
   IBind
   (bind [this g]
-    (-inc (bind (this) g)))
-  IMPlus
-  (mplus [this f]
-    (-inc (mplus (f) this)))
-  ITake
-  (take* [this] (lazy-seq (take* (this)))))
+    (Inc. a (fn [a2] (bind (restg a2) g))))
+  IBindFair
+  (bind-fair [this g]
+    (Inc. a (fn [a2] (bind (g a2) restg))))
+  IBranch
+  (children [this]
+    (when-let [rest (restg a)]
+      [rest])))
+
+(defmacro -inc [a restg]
+  (let [a2 (gensym "a")
+        thunk-body (clojure.walk/prewalk-replace {a a2} restg)
+        thunk `(fn [~a2] ~thunk-body)]
+    `(Inc. ~a ~thunk)))
+
+(defn -dec [inc]
+  ((.restg inc) (.a inc)))
+
+;; -----------------------------------------------------------------------------
+;; Return
+
+(defrecord Return [value]
+  ILeaf
+  (value [this]
+    value))
 
 ;; =============================================================================
 ;; Syntax
@@ -1828,8 +1852,7 @@
   [& clauses]
   (let [a (gensym "a")]
     `(fn [~a]
-       (-inc
-        (mplus* ~@(bind-conde-clauses a clauses))))))
+       (-inc ~a (choice* ~@(bind-conde-clauses a clauses))))))
 
 (defn- lvar-bind [sym]
   ((juxt identity
@@ -1843,17 +1866,56 @@
   conjunction."
   [[& lvars] & goals]
   `(fn [a#]
-     (-inc
-      (let [~@(lvar-binds lvars)]
+     (-inc a# (let [~@(lvar-binds lvars)]
         (bind* a# ~@goals)))))
 
 (declare reifyg)
 
+(defn bfs-lazy [a]
+  (let [q (java.util.ArrayDeque. [a])]
+    (letfn [(bfs-loop []
+              (when-let [node (.pollFirst q)]
+                (if (leaf? node)
+                  (cons (value node) (lazy-seq (bfs-loop)))
+                  (do (doseq [child (children node)]
+                        (.addLast q child))
+                      (recur)))))]
+      (bfs-loop))))
+
+(defn bfs-strict [a]
+  (let [q (java.util.ArrayDeque. [a])
+        results (java.util.ArrayDeque.)]
+    (loop []
+      (when-let [node (.pollFirst q)]
+        (if (leaf? node)
+          (.addLast results (value node))
+          (doseq [child (children node)]
+            (.addLast q child)))
+        (recur)))
+    (into nil results)))
+
+(defn dfs-lazy [node]
+  (if (leaf? node)
+    (list (value node))
+    (apply concat (map dfs-lazy (children node)))))
+
+(defn dfs-strict [node]
+  (let [results (java.util.ArrayDeque.)]
+    (letfn [(dfs-loop [node]
+              (if (leaf? node)
+                (.addLast results (value node))
+                (doseq [child (children node)]
+                  (dfs-loop child))))]
+      (dfs-loop node)
+      (into nil results))))
+
+(def ^:dynamic *search* bfs-lazy)
+
 (defmacro solve [& [n [x :as bindings] & goals]]
   (if (> (count bindings) 1)
     `(solve ~n [q#] (fresh ~bindings ~@goals (== q# ~bindings)))
-    `(let [xs# (take* (fn []
-                        ((fresh [~x]
+    `(let [xs# (lazy-seq
+                (*search* ((fresh [~x]
                            ~@goals
                            (reifyg ~x))
                          empty-s)))]
@@ -1898,11 +1960,15 @@
   ([] `clojure.core.logic/s#)
   ([& goals] `(fn [a#] (bind* a# ~@goals))))
 
+(defmacro all-fair
+  ([] `clojure.core.logic/s#)
+  ([& goals] `(fn [a#] (bind-fair* a# ~@goals))))
+
 (defn solutions
   ([s g]
      (solutions s (lvar) g))
   ([s q g]
-     (take* ((all g (reifyg q)) s))))
+     (*search* ((all g (reifyg q)) s))))
 
 ;; =============================================================================
 ;; Debugging
@@ -1997,14 +2063,13 @@
                         (queue s (unwrap (apply cs (map #(lvar % false) vs))))))
                     empty-s (-> u meta ::when))]
        (first
-         (take*
-           (fn []
+         (*search*
              ((fresh [q]
                 (== u w) (== q u)
                 (fn [a]
                   (fix-constraints a))
                 (reifyg q))
-              init-s))))))
+           init-s)))))
   ([u w & ts]
      (if (some #{:when} ts)
        (let [terms (take-while #(not= % :when) ts)
@@ -2132,12 +2197,15 @@
              (recur b gr))
            b)))
 
-  clojure.lang.Fn
+  Inc
   (ifa [b gs c]
-       (-inc (ifa (b) gs c)))
+    (let [a (.a b)
+          restg (.restg b)]
+      (-inc a (ifa (restg a) gs c))))
 
   Choice
   (ifa [b gs c]
+    ;; TODO: should this be (ifu (.left b) gs (delay (ifu (.right b) gs c)))
     (reduce bind b gs)))
 
 (extend-protocol IIfU
@@ -2154,14 +2222,15 @@
           (recur b gr))
         b)))
 
-  clojure.lang.Fn
+  Inc
   (ifu [b gs c]
-    (-inc (ifu (b) gs c)))
+    (let [a (.a b)
+          restg (.restg b)]
+      (-inc a (ifu (restg a) gs c))))
 
-  ;; TODO: Choice always holds a as a list, can we just remove that?
   Choice
   (ifu [b gs c]
-    (reduce bind (:a b) gs)))
+    (ifu (.left b) gs (delay (ifu (.right b) gs c)))))
 
 (defn- cond-clauses [a]
   (fn [goals]
@@ -2504,7 +2573,7 @@
   (let [aseq (drop-while nil? aseq)]
     (when (seq aseq)
       (choice (first aseq)
-              (fn [] (to-stream (next aseq)))))))
+              (to-stream (next aseq))))))
 
 (defmacro def-arity-exc-helper []
   (try
@@ -2820,8 +2889,8 @@
                      (fn [] (reuse this argv cache @cache (count start))))]
                   ;; we have answer terms to reuse in the cache
                   (let [ans (first ansv*)]
-                    (Choice. (subunify this argv (reify-tabled this ans))
-                      (fn [] (reuse-loop (disj ansv* ans)))))))]
+                    (choice (subunify this argv (reify-tabled this ans))
+                            (-inc this (reuse-loop (disj ansv* ans)))))))]
         (reuse-loop start))))
 
   ;; unify an argument with an answer from a cache
@@ -2851,22 +2920,21 @@
                  (make-suspended-stream (:cache ss) (:ansv* ss)
                    (fn [] (bind ((:f ss)) g))))
                this)))))
-
-  IMPlus
-  (mplus [this f]
+  IBindFair
+  (bind-fair [this g]
     (waiting-stream-check this
       ;; success continuation
-      (fn [fp] (mplus fp f))
+      (fn [f] (bind-fair f g))
       ;; failure continuation
       (fn []
-        (let [a-inf (f)]
-          (if (waiting-stream? a-inf)
-            (into a-inf this)
-            (mplus a-inf (fn [] this)))))))
-
-  ITake
-  (take* [this]
-    (waiting-stream-check this (fn [f] (take* f)) (fn [] ()))))
+        (into []
+          (map (fn [ss]
+                 (make-suspended-stream (:cache ss) (:ansv* ss)
+                   (fn [] (bind-fair ((:f ss)) g))))
+               this)))))
+  IBranch
+  (children [this]
+    (waiting-stream-check this (fn [a] a) (fn [] nil))))
 
 (defn master
   "Take the argument to the goal and check that we don't
@@ -3072,8 +3140,8 @@
                  (filter reifiable?)
                  (map #(reifyc % v r a)))]
     (if (empty? rcs)
-      (choice (list v) empty-f)
-      (choice (list `(~v :- ~@rcs)) empty-f))))
+      (Return. v)
+      (Return. `(~v :- ~@rcs)))))
 
 (defn reifyg [x]
   (all
@@ -3082,11 +3150,10 @@
      (let [v (walk* a x)
            r (-reify* empty-s v)]
        (if (zero? (count r))
-         (choice (list v) empty-f)
+         (Return. v)
          (let [v (walk* r v)]
            (reify-constraints v r a)))))))
 
-
 (defn cgoal [c]
   (reify
     clojure.lang.IFn
diff --git a/src/main/clojure/clojure/core/logic/par.clj b/src/main/clojure/clojure/core/logic/par.clj
new file mode 100644
index 0000000..72e15d9
--- /dev/null
+++ b/src/main/clojure/clojure/core/logic/par.clj
@@ -0,0 +1,68 @@
+(ns clojure.core.logic.par
+  (:refer-clojure :exclude [==])
+  (use clojure.core.logic))
+
+;; fork-join wrapper from clojure.reducer
+
+(defmacro ^:private compile-if
+  [exp then else]
+  (if (try (eval exp)
+           (catch Throwable _ false))
+    `(do ~then)
+    `(do ~else)))
+
+(compile-if
+ (Class/forName "java.util.concurrent.ForkJoinTask")
+ ;; We're running a JDK 7+
+ (do
+   (def pool (delay (java.util.concurrent.ForkJoinPool.)))
+
+   (defn- fjtask [^Callable f]
+     (java.util.concurrent.ForkJoinTask/adapt f))
+
+   (defn- fjinvoke [f]
+     (if (java.util.concurrent.ForkJoinTask/inForkJoinPool)
+       (f)
+       (.invoke ^java.util.concurrent.ForkJoinPool @pool ^java.util.concurrent.ForkJoinTask (fjtask f))))
+
+   (defn- fjfork [task] (.fork ^java.util.concurrent.ForkJoinTask task))
+
+   (defn- fjjoin [task] (.join ^java.util.concurrent.ForkJoinTask task)))
+ ;; We're running a JDK <7
+ (do
+   (def pool (delay (jsr166y.ForkJoinPool.)))
+
+   (defn- fjtask [^Callable f]
+     (jsr166y.ForkJoinTask/adapt f))
+
+   (defn- fjinvoke [f]
+     (if (jsr166y.ForkJoinTask/inForkJoinPool)
+       (f)
+       (.invoke ^jsr166y.ForkJoinPool @pool ^jsr166y.ForkJoinTask (fjtask f))))
+
+   (defn- fjfork [task] (.fork ^jsr166y.ForkJoinTask task))
+
+   (defn- fjjoin [task] (.join ^jsr166y.ForkJoinTask task))))
+
+;; parallel solvers
+
+(declare dfs-par)
+
+(defn dfs-par*
+  ([]
+     nil)
+  ([node]
+     (dfs-par node))
+  [[node-a node-b]
+   (let [task-b (fjfork (fjtask #(dfs-par node-b)))
+         results-a (dfs-par node-a)
+         results-b (fjjoin task-b)]
+     (concat results-a results-b))])
+
+(defn dfs-par [node]
+  (fjinvoke
+   #(if (leaf? node)
+      (list (value node))
+      (apply dfs-par* (children node)))))
+
+;; TODO bfs-par
diff --git a/src/test/clojure/clojure/core/logic/tests.clj b/src/test/clojure/clojure/core/logic/tests.clj
index 423d5da..eaa42b7 100644
--- a/src/test/clojure/clojure/core/logic/tests.clj
+++ b/src/test/clojure/clojure/core/logic/tests.clj
@@ -443,6 +443,24 @@
          '(true))))
 
 ;; =============================================================================
+;; Fair conjuctions
+
+(def endlesso
+  (fresh [] endlesso))
+
+(deftest test-all-fair
+  (is (= (run* [q]
+               (all-fair
+                endlesso
+                u#))
+         ()))
+  (is (= (run* [q]
+               (all-fair
+                u#
+                endlesso))
+         ())))
+
+;; =============================================================================
 ;; TRS
 
 (defn pairo [p]
@@ -768,16 +786,10 @@
 ;; -----------------------------------------------------------------------------
 ;; condu (committed-choice)
 
-(comment
-  (defn onceo [g]
-    (condu
-      (g s#)))
-
  (deftest test-condu-1
    (is (= (run* [x]
             (onceo (teacupo x)))
           '(tea))))
- )
 
 (deftest test-condu-2
   (is (= (into #{}
@@ -1742,8 +1754,8 @@
 (deftest test-infd-1
   (let [x (lvar 'x)
         y (lvar 'y)
-        f ((infd x y (interval 1 10)) empty-s)
-        s (f)]
+        g (infd x y (interval 1 10))
+        s (-dec (g empty-s))]
     (is (= (get-dom-fd s x) (interval 1 10)))
     (is (= (get-dom-fd s y) (interval 1 10)))))
 
@@ -1960,7 +1972,7 @@
             (domfd x (interval 1 10))
             (domfd y (interval 1 5))) empty-s)
         s ((=fd x y) s)]
-    (is (= (take* ((reifyg x) s))
+    (is (= (*search* ((reifyg x) s))
            '(1 2 3 4 5)))))
 
 (deftest test-process-interval-smaller-1