reduce can be terminated via (reduced x), first cut at reduce lib

src/clj/clojure/core.clj

@@ -6001,6 +6001,21 @@
           (let [[shift mask imap switch-type skip-check] (prep-hashes ge default tests thens)]
             `(let [~ge ~e] (case* ~ge ~shift ~mask ~default ~imap ~switch-type :hash-identity ~skip-check))))))))
 
+
+;; redefine reduce with internal-reduce
+(defn reduced
+  "Wraps x in a way such that a reduce will terminate with the value x"
+  {:added "1.5"}
+  [x]
+  (clojure.lang.Reduced. x))
+
+(defn reduced?
+  "Returns true if x is the result of a call to reduced"
+  {:inline (fn [x] `(clojure.lang.RT/isReduced ~x ))
+   :inline-arities #{1}
+   :added "1.5"}
+  ([x] (clojure.lang.RT/isReduced x)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; helper files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (alter-meta! (find-ns 'clojure.core) assoc :doc "Fundamental library of the Clojure language")
 (load "core_proxy")
@@ -6012,7 +6027,6 @@
 (load "instant")
 (load "uuid")
 
-;; redefine reduce with internal-reduce
 (defn reduce
   "f should be a function of 2 arguments. If val is not supplied,
   returns the result of applying f to the first 2 items in coll, then

src/clj/clojure/core/protocols.clj

@@ -66,14 +66,20 @@
         (if (.hasNext iter)
           (loop [ret (.next iter)]
             (if (.hasNext iter)
-              (recur (f ret (.next iter)))
+              (let [ret (f ret (.next iter))]
+                (if (reduced? ret)
+                  @ret
+                  (recur ret)))
               ret))
           (f))))
    ([coll f val]
       (let [iter (.iterator coll)]
         (loop [ret val]
           (if (.hasNext iter)
-            (recur (f ret (.next iter)))
+            (let [ret (f ret (.next iter))]
+                (if (reduced? ret)
+                  @ret
+                  (recur ret)))
             ret)))))
   )
 
@@ -89,9 +95,12 @@
    [s f val]
    (if-let [s (seq s)]
      (if (chunked-seq? s)
-       (recur (chunk-next s)
-              f
-              (.reduce (chunk-first s) f val))
+       (let [ret (.reduce (chunk-first s) f val)]
+         (if (reduced? ret)
+           @ret
+           (recur (chunk-next s)
+                  f
+                  ret)))
        (internal-reduce s f val))
      val))
 
@@ -102,7 +111,10 @@
      (loop [i (.i str-seq)
             val val]
        (if (< i (.length s))
-         (recur (inc i) (f val (.charAt s i)))
+         (let [ret (f val (.charAt s i))]
+                (if (reduced? ret)
+                  @ret
+                  (recur (inc i) ret)))
          val))))
 
   clojure.lang.ArraySeq
@@ -112,7 +124,10 @@
          (loop [i (.index a-seq)
                 val val]
            (if (< i (alength arr))
-             (recur (inc i) (f val (aget arr i)))
+             (let [ret (f val (aget arr i))]
+                (if (reduced? ret)
+                  @ret
+                  (recur (inc i) ret)))
              val))))
 
   java.lang.Object
@@ -125,7 +140,10 @@
      (if-let [s (seq s)]
        ;; roll over to faster implementation if underlying seq changes type
        (if (identical? (class s) cls)
-         (recur cls (next s) f (f val (first s)))
+         (let [ret (f val (first s))]
+                (if (reduced? ret)
+                  @ret
+                  (recur cls (next s) f ret)))
          (internal-reduce s f val))
        val))))
 
@@ -136,7 +154,10 @@
          (loop [i (.index a-seq)
                 val val]
            (if (< i (alength arr))
-             (recur (inc i) (f val (aget arr i)))
+             (let [ret (f val (aget arr i))]
+                (if (reduced? ret)
+                  @ret
+                  (recur (inc i) ret)))
              val)))))
 
 (defn- emit-array-impls*

src/jvm/clojure/lang/ArrayChunk.java

@@ -56,8 +56,14 @@ public IChunk dropFirst(){
 
 public Object reduce(IFn f, Object start) {
 		Object ret = f.invoke(start, array[off]);
+		if(RT.isReduced(ret))
+			return ret;
 		for(int x = off + 1; x < end; x++)
+			{
 			ret = f.invoke(ret, array[x]);
+			if(RT.isReduced(ret))
+				return ret;
+			}
 		return ret;
 }
 }

src/jvm/clojure/lang/PersistentArrayMap.java

@@ -282,6 +282,8 @@ public void remove(){
 public Object kvreduce(IFn f, Object init){
     for(int i=0;i < array.length;i+=2){
         init = f.invoke(init, array[i], array[i+1]);
+	    if(RT.isReduced(init))
+		    return ((IDeref)init).deref();
         }
     return init;
 }

src/jvm/clojure/lang/PersistentHashMap.java

@@ -180,7 +180,9 @@ public Iterator iterator(){
 
 public Object kvreduce(IFn f, Object init){
     init = hasNull?f.invoke(init,null,nullValue):init;
-    if(root != null){
+	if(RT.isReduced(init))
+		return ((IDeref)init).deref();
+	if(root != null){
         return root.kvreduce(f,init);
     }
     return init;
@@ -383,11 +385,13 @@ public ISeq nodeSeq(){
 	}
 
     public Object kvreduce(IFn f, Object init){
-        for(INode node : array)
-            {
-            if(node != null)
+        for(INode node : array){
+            if(node != null){
                 init = node.kvreduce(f,init);
-            }
+	            if(RT.isReduced(init))
+		            return ((IDeref)init).deref();
+	            }
+	        }
         return init;
     }
 
@@ -1058,6 +1062,8 @@ static public Object kvreduce(Object[] array, IFn f, Object init){
                  if(node != null)
                      init = node.kvreduce(f,init);
                  }
+             if(RT.isReduced(init))
+	             return ((IDeref)init).deref();
              }
         return init;
     }

src/jvm/clojure/lang/PersistentTreeMap.java

@@ -538,11 +538,20 @@ Node balanceRight(Node parent){
 
     public Object kvreduce(IFn f, Object init){
         init = f.invoke(init, key(), val());
-        if(left() != null)
+	    if(RT.isReduced(init))
+		    return ((IDeref)init).deref();
+
+	    if(left() != null){
             init = left().kvreduce(f, init);
-        if(right() != null)
+	        if(RT.isReduced(init))
+		        return ((IDeref)init).deref();
+	        }
+	    if(right() != null){
             init = right().kvreduce(f, init);
-        return init;
+	        if(RT.isReduced(init))
+		        return ((IDeref)init).deref();
+	        }
+	    return init;
     }
 
 

src/jvm/clojure/lang/PersistentVector.java

@@ -236,8 +236,11 @@ public Object kvreduce(IFn f, Object init){
     int step = 0;
     for(int i=0;i<cnt;i+=step){
         Object[] array = arrayFor(i);
-        for(int j =0;j<array.length;++j)
+        for(int j =0;j<array.length;++j){
             init = f.invoke(init,j+i,array[j]);
+            if(RT.isReduced(init))
+	            return ((IDeref)init).deref();
+            }
         step = array.length;
     }
     return init;

src/jvm/clojure/lang/RT.java

@@ -1680,6 +1680,10 @@ static public boolean isLineNumberingReader(Reader r){
 	return r instanceof LineNumberingPushbackReader;
 }
 
+static public boolean isReduced(Object r){
+	return r instanceof Reduced;
+}
+
 static public String resolveClassNameInContext(String className){
 	//todo - look up in context var
 	return className;

src/jvm/clojure/lang/Reduced.java

@@ -0,0 +1,18 @@
+// Copyright (c) Metadata Partners, LLC.
+// All rights reserved.
+
+/* rich 4/30/12 */
+
+package clojure.lang;
+
+public class Reduced implements IDeref{
+Object val;
+
+public Reduced(Object val){
+	this.val = val;
+}
+
+public Object deref(){
+	return val;
+}
+}