Merge branch 'master' into patches

6 files changed, 163 insertions, 43 deletions

diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj
index 06ca970b..cb2f1d2b 100644
--- a/src/clj/clojure/core.clj
+++ b/src/clj/clojure/core.clj
@@ -690,16 +690,8 @@
   {:inline (fn [x] `(. clojure.lang.Numbers (inc ~x)))}
   [x] (. clojure.lang.Numbers (inc x)))
 
+;; reduce is defined again later after InternalReduce loads
 (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
-  applying f to that result and the 3rd item, etc. If coll contains no
-  items, f must accept no arguments as well, and reduce returns the
-  result of calling f with no arguments.  If coll has only 1 item, it
-  is returned and f is not called.  If val is supplied, returns the
-  result of applying f to val and the first item in coll, then
-  applying f to that result and the 2nd item, etc. If coll contains no
-  items, returns val and f is not called."
   ([f coll]
    (let [s (seq coll)]
      (if s
@@ -4704,7 +4696,28 @@
 (load "core_print")
 (load "genclass")
 (load "core_deftype")
+(load "core/protocols")
 (load "gvec")
+
+;; 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
+  applying f to that result and the 3rd item, etc. If coll contains no
+  items, f must accept no arguments as well, and reduce returns the
+  result of calling f with no arguments.  If coll has only 1 item, it
+  is returned and f is not called.  If val is supplied, returns the
+  result of applying f to val and the first item in coll, then
+  applying f to that result and the 2nd item, etc. If coll contains no
+  items, returns val and f is not called."
+  ([f coll]
+     (if-let [s (seq coll)]
+       (reduce f (first s) (next s))
+       (f)))
+  ([f start coll]
+     (let [s (seq coll)]
+       (clojure.core.protocols/internal-reduce s f start))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; futures (needs proxy);;;;;;;;;;;;;;;;;;
 (defn future-call 
   "Takes a function of no args and yields a future object that will
diff --git a/src/clj/clojure/core/protocols.clj b/src/clj/clojure/core/protocols.clj
new file mode 100644
index 00000000..4184e91e
--- /dev/null
+++ b/src/clj/clojure/core/protocols.clj
@@ -0,0 +1,92 @@
+;   Copyright (c) Rich Hickey. All rights reserved.
+;   The use and distribution terms for this software are covered by the
+;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;   which can be found in the file epl-v10.html at the root of this distribution.
+;   By using this software in any fashion, you are agreeing to be bound by
+;   the terms of this license.
+;   You must not remove this notice, or any other, from this software.
+
+(ns clojure.core.protocols)
+
+(defprotocol InternalReduce
+  "Protocol for concrete seq types that can reduce themselves
+   faster than first/next recursion. Called by clojure.core/reduce."
+  (internal-reduce [seq f start]))
+
+(extend-protocol InternalReduce
+  nil
+  (internal-reduce
+   [s f val]
+   val)
+  
+  ;; handles vectors and ranges
+  clojure.lang.IChunkedSeq
+  (internal-reduce
+   [s f val]
+   (if-let [s (seq s)]
+     (recur (chunk-next s)
+            f
+            (.reduce (chunk-first s) f val))
+     val))
+
+  clojure.lang.StringSeq
+  (internal-reduce
+   [str-seq f val]
+   (let [s (.s str-seq)]
+     (loop [i (.i str-seq)
+            val val]
+       (if (< i (.length s))
+         (recur (inc i) (f val (.charAt s i)))
+         val))))
+  
+  clojure.lang.ArraySeq
+  (internal-reduce
+       [a-seq f val]
+       (let [#^objects arr (.array a-seq)]
+         (loop [i (.index a-seq)
+                val val]
+           (if (< i (alength arr))
+             (recur (inc i) (f val (aget arr i)))
+             val))))
+  
+  java.lang.Object
+  (internal-reduce
+   [s f val]
+   (loop [cls (class s)
+          s s
+          f f
+          val val]
+     (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)))
+         (internal-reduce s f val))
+       val))))
+
+(def arr-impl
+  '(internal-reduce
+       [a-seq f val]
+       (let [arr (.array a-seq)]
+         (loop [i (.index a-seq)
+                val val]
+           (if (< i (alength arr))
+             (recur (inc i) (f val (aget arr i)))
+             val)))))
+
+(defn- emit-array-impls*
+  [syms]
+  (apply
+   concat
+   (map
+    (fn [s]
+      [(symbol (str "clojure.lang.ArraySeq$ArraySeq_" s))
+       arr-impl])
+    syms)))
+
+(defmacro emit-array-impls
+  [& syms]
+  `(extend-protocol InternalReduce
+     ~@(emit-array-impls* syms)))
+
+(emit-array-impls int long float double byte char boolean)
+
diff --git a/src/clj/clojure/gvec.clj b/src/clj/clojure/gvec.clj
index 2b1223ad..3f4c5f6e 100644
--- a/src/clj/clojure/gvec.clj
+++ b/src/clj/clojure/gvec.clj
@@ -54,6 +54,21 @@
 (deftype VecSeq [#^clojure.core.ArrayManager am #^clojure.core.IVecImpl vec anode #^int i #^int offset] 
   :no-print true
 
+  clojure.core.protocols.InternalReduce
+  (internal-reduce
+   [_ f val]
+   (loop [result val
+          aidx offset]
+     (if (< aidx (count vec))
+       (let [node (.arrayFor vec aidx)
+             result (loop [result result
+                           node-idx (bit-and (int 0x1f) aidx)]
+                      (if (< node-idx (.alength am node))
+                        (recur (f result (.aget am node node-idx)) (inc node-idx))
+                        result))]
+         (recur result (bit-and (int 0xffe0) (+ aidx (int 32)))))
+       result)))
+  
   clojure.lang.ISeq
   (first [_] (.aget am anode offset))
   (next [this] 
@@ -132,12 +147,12 @@
         (System/arraycopy tail 0 new-tail 0 (.alength am tail))
         (.aset am new-tail (.alength am tail) val)
         (new Vec am (inc cnt) shift root new-tail (meta this)))
-      (let [tail-node (VecNode. (:edit root) tail)] 
+      (let [tail-node (VecNode. (.edit root) tail)] 
         (if (> (bit-shift-right cnt (int 5)) (bit-shift-left (int 1) shift)) ;overflow root?
-          (let [new-root (VecNode. (:edit root) (object-array 32))]
-            (doto #^objects (:arr new-root)
+          (let [new-root (VecNode. (.edit root) (object-array 32))]
+            (doto #^objects (.arr new-root)
               (aset 0 root)
-              (aset 1 (.newPath this (:edit root) shift tail-node)))
+              (aset 1 (.newPath this (.edit root) shift tail-node)))
             (new Vec am (inc cnt) (+ shift (int 5)) new-root (let [tl (.array am 1)] (.aset am  tl 0 val) tl) (meta this)))
           (new Vec am (inc cnt) shift (.pushTail this shift root tail-node) 
                  (let [tl (.array am 1)] (.aset am  tl 0 val) tl) (meta this))))))
@@ -177,8 +192,8 @@
         (cond
          (nil? new-root) 
            (new Vec am (dec cnt) shift EMPTY-NODE new-tail (meta this))
-         (and (> shift 5) (nil? (aget #^objects (:arr new-root) 1)))
-           (new Vec am (dec cnt) (- shift 5) (aget #^objects (:arr new-root) 0) new-tail (meta this))
+         (and (> shift 5) (nil? (aget #^objects (.arr new-root) 1)))
+           (new Vec am (dec cnt) (- shift 5) (aget #^objects (.arr new-root) 0) new-tail (meta this))
          :else
            (new Vec am (dec cnt) shift new-root new-tail (meta this))))))
 
@@ -240,55 +255,55 @@
         tail
         (loop [node root level shift]
           (if (zero? level)
-            (:arr node)
-            (recur (aget #^objects (:arr node) (bit-and (bit-shift-right i level) (int 0x1f))) 
+            (.arr node)
+            (recur (aget #^objects (.arr node) (bit-and (bit-shift-right i level) (int 0x1f))) 
                    (- level (int 5))))))
       (throw (IndexOutOfBoundsException.))))
 
   (pushTail [this level parent tailnode]
     (let [subidx (bit-and (bit-shift-right (dec cnt) level) (int 0x1f))
-          ret (VecNode. (:edit parent) (aclone #^objects (:arr parent)))
+          ret (VecNode. (.edit parent) (aclone #^objects (.arr parent)))
           node-to-insert (if (= level (int 5))
                            tailnode
-                           (let [child (aget #^objects (:arr parent) subidx)]
+                           (let [child (aget #^objects (.arr parent) subidx)]
                              (if child
                                (.pushTail this (- level (int 5)) child tailnode)
-                               (.newPath this (:edit root) (- level (int 5)) tailnode))))]
-      (aset #^objects (:arr ret) subidx node-to-insert)
+                               (.newPath this (.edit root) (- level (int 5)) tailnode))))]
+      (aset #^objects (.arr ret) subidx node-to-insert)
       ret))
 
   (popTail [this level node]
     (let [subidx (bit-and (bit-shift-right (- cnt 2) level) (int 0x1f))]
       (cond
        (> level 5) 
-         (let [new-child (.popTail this (- level 5) (aget #^objects (:arr node) subidx))]
+         (let [new-child (.popTail this (- level 5) (aget #^objects (.arr node) subidx))]
            (if (and (nil? new-child) (zero? subidx))
              nil
-             (let [arr (aclone #^objects (:arr node))]
+             (let [arr (aclone #^objects (.arr node))]
                (aset arr subidx new-child)
-               (VecNode. (:edit root) arr))))
+               (VecNode. (.edit root) arr))))
        (zero? subidx) nil
-       :else (let [arr (aclone #^objects (:arr node))]
+       :else (let [arr (aclone #^objects (.arr node))]
                (aset arr subidx nil)
-               (VecNode. (:edit root) arr)))))
+               (VecNode. (.edit root) arr)))))
 
   (newPath [this edit #^int level node]
     (if (zero? level)
       node
       (let [ret (VecNode. edit (object-array 32))]
-        (aset #^objects (:arr ret) 0 (.newPath this edit (- level (int 5)) node))
+        (aset #^objects (.arr ret) 0 (.newPath this edit (- level (int 5)) node))
         ret)))
 
   (doAssoc [this level node i val] 
     (if (zero? level)
       ;on this branch, array will need val type
-      (let [arr (.aclone am (:arr node))]
+      (let [arr (.aclone am (.arr node))]
         (.aset am arr (bit-and i (int 0x1f)) val)
-        (VecNode. (:edit node) arr))
-      (let [arr (aclone #^objects (:arr node))
+        (VecNode. (.edit node) arr))
+      (let [arr (aclone #^objects (.arr node))
             subidx (bit-and (bit-shift-right i level) (int 0x1f))]
         (aset arr subidx (.doAssoc this (- level (int 5)) (aget arr subidx) i val))
-        (VecNode. (:edit node) arr))))
+        (VecNode. (.edit node) arr))))
 
   java.lang.Iterable
   (iterator [this]
diff --git a/src/jvm/clojure/lang/ArraySeq.java b/src/jvm/clojure/lang/ArraySeq.java
index 117dd4f5..3517eab4 100644
--- a/src/jvm/clojure/lang/ArraySeq.java
+++ b/src/jvm/clojure/lang/ArraySeq.java
@@ -15,7 +15,7 @@ package clojure.lang;
 import java.lang.reflect.Array;
 
 public class ArraySeq extends ASeq implements IndexedSeq, IReduce{
-final Object array;
+public final Object array;
 final int i;
 final Object[] oa;
 //ISeq _rest;
@@ -164,7 +164,7 @@ public int lastIndexOf(Object o) {
 //////////////////////////////////// specialized primitive versions ///////////////////////////////
 
 static public class ArraySeq_int extends ASeq implements IndexedSeq, IReduce{
-	final int[] array;
+	public final int[] array;
 	final int i;
 
 	ArraySeq_int(IPersistentMap meta, int[] array, int i){
@@ -240,7 +240,7 @@ static public class ArraySeq_int extends ASeq implements IndexedSeq, IReduce{
 
 
 static public class ArraySeq_float extends ASeq implements IndexedSeq, IReduce{
-	final float[] array;
+	public final float[] array;
 	final int i;
 
 	ArraySeq_float(IPersistentMap meta, float[] array, int i){
@@ -315,7 +315,7 @@ static public class ArraySeq_float extends ASeq implements IndexedSeq, IReduce{
 }
 
 static public class ArraySeq_double extends ASeq implements IndexedSeq, IReduce{
-	final double[] array;
+	public final double[] array;
 	final int i;
 
 	ArraySeq_double(IPersistentMap meta, double[] array, int i){
@@ -390,7 +390,7 @@ static public class ArraySeq_double extends ASeq implements IndexedSeq, IReduce{
 }
 
 static public class ArraySeq_long extends ASeq implements IndexedSeq, IReduce{
-	final long[] array;
+	public final long[] array;
 	final int i;
 
 	ArraySeq_long(IPersistentMap meta, long[] array, int i){
@@ -465,7 +465,7 @@ static public class ArraySeq_long extends ASeq implements IndexedSeq, IReduce{
 }
 
 static public class ArraySeq_byte extends ASeq implements IndexedSeq, IReduce{
-	final byte[] array;
+	public final byte[] array;
 	final int i;
 
 	ArraySeq_byte(IPersistentMap meta, byte[] array, int i){
@@ -540,7 +540,7 @@ static public class ArraySeq_byte extends ASeq implements IndexedSeq, IReduce{
 }
 
 static public class ArraySeq_char extends ASeq implements IndexedSeq, IReduce{
-	final char[] array;
+	public final char[] array;
 	final int i;
 
 	ArraySeq_char(IPersistentMap meta, char[] array, int i){
@@ -615,7 +615,7 @@ static public class ArraySeq_char extends ASeq implements IndexedSeq, IReduce{
 }
 
 static public class ArraySeq_boolean extends ASeq implements IndexedSeq, IReduce{
-	final boolean[] array;
+	public final boolean[] array;
 	final int i;
 
 	ArraySeq_boolean(IPersistentMap meta, boolean[] array, int i){
diff --git a/src/jvm/clojure/lang/PersistentVector.java b/src/jvm/clojure/lang/PersistentVector.java
index e93052e4..a521eaa8 100644
--- a/src/jvm/clojure/lang/PersistentVector.java
+++ b/src/jvm/clojure/lang/PersistentVector.java
@@ -233,10 +233,10 @@ public ISeq seq(){
 
 static public final class ChunkedSeq extends ASeq implements IChunkedSeq{
 
-	final PersistentVector vec;
+	public final PersistentVector vec;
 	final Object[] node;
 	final int i;
-	final int offset;
+	public final int offset;
 
 	public ChunkedSeq(PersistentVector vec, int i, int offset){
 		this.vec = vec;
diff --git a/src/jvm/clojure/lang/StringSeq.java b/src/jvm/clojure/lang/StringSeq.java
index aa70617b..bcb269d5 100644
--- a/src/jvm/clojure/lang/StringSeq.java
+++ b/src/jvm/clojure/lang/StringSeq.java
@@ -13,8 +13,8 @@
 package clojure.lang;
 
 public class StringSeq extends ASeq implements IndexedSeq{
-final CharSequence s;
-final int i;
+public final CharSequence s;
+public final int i;
 
 static public StringSeq create(CharSequence s){
 	if(s.length() == 0)