Merge branch 'master' into patches

12 files changed, 408 insertions, 47 deletions

diff --git a/build.xml b/build.xml
index 1c894931..99661c4e 100644
--- a/build.xml
+++ b/build.xml
@@ -13,6 +13,7 @@
   <property name="jsrc" location="${src}/jvm"/>
   <property name="cljsrc" location="${src}/clj"/>
   <property name="build" location="classes"/>
+  <property name="test-classes" location="test-classes"/>
   <property name="dist" location="dist"/>
 
   <!-- version related properties -->
@@ -91,6 +92,7 @@
       <sysproperty key="clojure.compile.path" value="${build}"/>
       <!-- <sysproperty key="clojure.compile.warn-on-reflection" value="true"/> -->
       <arg value="clojure.core"/>
+      <arg value="clojure.core.protocols"/>
       <arg value="clojure.main"/>
       <arg value="clojure.set"/>
       <arg value="clojure.xml"/>
@@ -105,6 +107,18 @@
     </java>
   </target>
 
+  <target name="compile-tests" 
+          description="Compile the subset of tests that require compilation.">
+    <delete dir="${test-classes}"/>
+    <mkdir dir="${test-classes}"/>
+    <java classname="clojure.lang.Compile"
+          classpath="${test-classes}:${test}:${build}:${cljsrc}"
+          failonerror="true">
+      <sysproperty key="clojure.compile.path" value="${test-classes}"/>
+      <arg value="clojure.test-clojure.protocols.examples"/>
+    </java>
+  </target>
+
   <target name="clojure" depends="compile-clojure"
           description="Create clojure jar file.">
     <jar jarfile="${clojure_jar}" basedir="${build}">
@@ -121,10 +135,12 @@
   </target>
 
   <target name="test"
-          description="Run clojure tests">
+          description="Run clojure tests"
+          depends="compile-tests">
 <!--           depends="clojure"> -->
     <java classname="clojure.main" failonerror="true">
       <classpath>
+        <path location="${test-classes}"/>
         <path location="${test}"/>
         <path location="${clojure_jar}"/>
       </classpath>
@@ -167,6 +183,7 @@
   <target name="clean"
           description="Remove autogenerated files and directories.">
     <delete dir="${build}"/>
+    <delete dir="${test-classes}"/>
     <delete dir="${dist}"/>
     <delete file="pom.xml"/>
   </target>
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)
diff --git a/test/clojure/test_clojure.clj b/test/clojure/test_clojure.clj
index ac264e0f..bb7764d2 100644
--- a/test/clojure/test_clojure.clj
+++ b/test/clojure/test_clojure.clj
@@ -48,6 +48,7 @@
       :clojure-set
       :clojure-xml
       :clojure-zip
+      :protocols
       ])
 
 (def test-namespaces
diff --git a/test/clojure/test_clojure/protocols.clj b/test/clojure/test_clojure/protocols.clj
new file mode 100644
index 00000000..b38f41cd
--- /dev/null
+++ b/test/clojure/test_clojure/protocols.clj
@@ -0,0 +1,151 @@
+;   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.
+
+; Author: Stuart Halloway
+
+(ns clojure.test-clojure.protocols
+  (:use clojure.test clojure.test-clojure.protocols.examples)
+  (:require [clojure.test-clojure.protocols.more-examples :as other]))
+
+;; temporary hack until I decide how to cleanly reload protocol
+(defn reload-example-protocols
+  []
+  (alter-var-root #'clojure.test-clojure.protocols.examples/ExampleProtocol
+                  assoc :impls {})
+  (alter-var-root #'clojure.test-clojure.protocols.more-examples/SimpleProtocol
+                  assoc :impls {})
+  (require :reload
+           'clojure.test-clojure.protocols.examples
+           'clojure.test-clojure.protocols.more-examples))
+
+(defn method-names
+  "return sorted list of method names on a class"
+  [c]
+  (->> (.getMethods c)
+     (map #(.getName %))
+     (sort)))
+
+(deftest protocols-test
+  (testing "protocol fns throw IllegalArgumentException if no impl matches"
+    (is (thrown-with-msg?
+          IllegalArgumentException
+          #"No implementation of method: :foo of protocol: #'clojure.test-clojure.protocols.examples/ExampleProtocol found for class: java.lang.Integer"
+          (foo 10))))
+  (testing "protocols generate a corresponding interface using _ instead of - for method names"
+    (is (= ["bar" "baz" "baz" "foo" "with_quux"] (method-names clojure.test_clojure.protocols.examples.ExampleProtocol))))
+  (testing "protocol will work with instances of its interface (use for interop, not in Clojure!)"
+    (let [obj (proxy [clojure.test_clojure.protocols.examples.ExampleProtocol] []
+                (foo [] "foo!"))]
+      (is (= "foo!" (.foo obj)) "call through interface")
+      (is (= "foo!" (foo obj)) "call through protocol")))
+  (testing "you can implement just part of a protocol if you want"
+    (let [obj (reify ExampleProtocol
+                     (baz [a b] "two-arg baz!"))]
+      (is (= "two-arg baz!" (baz obj nil)))
+      (is (thrown? AbstractMethodError (baz obj))))))
+
+(deftype ExtendTestWidget [name])
+(deftest extend-test
+  (testing "you can extend a protocol to a class"
+    (extend String ExampleProtocol
+            {:foo identity})
+    (is (= "pow" (foo "pow"))))
+  (testing "you can have two methods with the same name. Just use namespaces!"
+    (extend String other/SimpleProtocol
+     {:foo (fn [s] (.toUpperCase s))})
+    (is (= "POW" (other/foo "pow"))))
+  (testing "you can extend deftype types"
+    (extend
+     ExtendTestWidget
+     ExampleProtocol
+     {:foo (fn [this] (str "widget " (.name this)))})
+    (is (= "widget z" (foo (ExtendTestWidget. "z"))))))
+
+(deftype ExtendsTestWidget []
+  ExampleProtocol)
+(deftest extends?-test
+  (reload-example-protocols)
+  (testing "returns false if a type does not implement the protocol at all"
+    (is (false? (extends? other/SimpleProtocol ExtendsTestWidget))))
+  (testing "returns true if a type implements the protocol directly" ;; semantics changed 4/15/2010
+    (is (true? (extends? ExampleProtocol ExtendsTestWidget))))
+  (testing "returns true if a type explicitly extends protocol"
+    (extend
+     ExtendsTestWidget
+     other/SimpleProtocol
+     {:foo identity})
+    (is (true? (extends? other/SimpleProtocol ExtendsTestWidget)))))
+
+(deftype ExtendersTestWidget [])
+(deftest extenders-test
+  (reload-example-protocols)
+  (testing "a fresh protocol has no extenders"
+    (is (nil? (extenders ExampleProtocol))))
+  (testing "extending with no methods doesn't count!"
+    (deftype Something [])
+    (extend ::Something ExampleProtocol)
+    (is (nil? (extenders ExampleProtocol))))
+  (testing "extending a protocol (and including an impl) adds an entry to extenders"
+    (extend ExtendersTestWidget ExampleProtocol {:foo identity})
+    (is (= [ExtendersTestWidget] (extenders ExampleProtocol)))))
+
+(deftype SatisfiesTestWidget []
+  ExampleProtocol)
+(deftest satisifies?-test
+  (reload-example-protocols)
+  (let [whatzit (SatisfiesTestWidget.)]
+    (testing "returns false if a type does not implement the protocol at all"
+      (is (false? (satisfies? other/SimpleProtocol whatzit))))
+    (testing "returns true if a type implements the protocol directly"
+      (is (true? (satisfies? ExampleProtocol whatzit))))
+    (testing "returns true if a type explicitly extends protocol"
+      (extend
+       SatisfiesTestWidget
+       other/SimpleProtocol
+       {:foo identity})
+      (is (true? (satisfies? other/SimpleProtocol whatzit)))))  )
+
+(deftype ReExtendingTestWidget [])
+(deftest re-extending-test
+  (reload-example-protocols)
+  (extend
+   ReExtendingTestWidget
+   ExampleProtocol
+   {:foo (fn [_] "first foo")
+    :baz (fn [_] "first baz")})
+  (testing "if you re-extend, the old implementation is replaced (not merged!)"
+    (extend
+     ReExtendingTestWidget
+     ExampleProtocol
+     {:baz (fn [_] "second baz")
+      :bar (fn [_ _] "second bar")})
+    (let [whatzit (ReExtendingTestWidget.)]
+      (is (thrown? IllegalArgumentException (foo whatzit)))
+      (is (= "second bar" (bar whatzit nil)))
+      (is (= "second baz" (baz whatzit))))))
+
+(defrecord DefrecordObjectMethodsWidgetA [a])
+(defrecord DefrecordObjectMethodsWidgetB [a])
+(deftest defrecord-object-methods-test
+  (testing ".equals depends on fields and type"
+    (is (true? (.equals (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 1))))
+    (is (false? (.equals (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 2))))
+    (is (false? (.equals (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetB. 1)))))
+  (testing ".hashCode depends on fields and type"
+    (is (= (.hashCode (DefrecordObjectMethodsWidgetA. 1)) (.hashCode (DefrecordObjectMethodsWidgetA. 1))))
+    (is (= (.hashCode (DefrecordObjectMethodsWidgetA. 2)) (.hashCode (DefrecordObjectMethodsWidgetA. 2))))
+    (is (not= (.hashCode (DefrecordObjectMethodsWidgetA. 1)) (.hashCode (DefrecordObjectMethodsWidgetA. 2))))
+    (is (= (.hashCode (DefrecordObjectMethodsWidgetB. 1)) (.hashCode (DefrecordObjectMethodsWidgetB. 1))))
+    (is (not= (.hashCode (DefrecordObjectMethodsWidgetA. 1)) (.hashCode (DefrecordObjectMethodsWidgetB. 1))))))
+
+;; todo
+;; what happens if you extend after implementing directly? Extend is ignored!!
+;; extend-type extend-protocol extend-class
+;; maybe: find-protocol-impl find-protocol-method
+;; deftype, printable forms
+;; reify, definterface
diff --git a/test/clojure/test_clojure/protocols/examples.clj b/test/clojure/test_clojure/protocols/examples.clj
new file mode 100644
index 00000000..f0296955
--- /dev/null
+++ b/test/clojure/test_clojure/protocols/examples.clj
@@ -0,0 +1,10 @@
+(ns clojure.test-clojure.protocols.examples)
+
+(defprotocol ExampleProtocol
+  "example protocol used by clojure tests"
+
+  (foo [a] "method with one arg")
+  (bar [a b] "method with two args")
+  (baz [a] [a b] "method with multiple arities")
+  (with-quux [a] "method name with a hyphen"))
+
diff --git a/test/clojure/test_clojure/protocols/more_examples.clj b/test/clojure/test_clojure/protocols/more_examples.clj
new file mode 100644
index 00000000..6bee018a
--- /dev/null
+++ b/test/clojure/test_clojure/protocols/more_examples.clj
@@ -0,0 +1,7 @@
+(ns clojure.test-clojure.protocols.more-examples)
+
+(defprotocol SimpleProtocol
+  "example protocol used by clojure tests. Note that
+   foo collides with examples/ExampleProtocol."
+
+  (foo [a] ""))
diff --git a/test/clojure/test_clojure/sequences.clj b/test/clojure/test_clojure/sequences.clj
index 6aa3c695..51d379b1 100644
--- a/test/clojure/test_clojure/sequences.clj
+++ b/test/clojure/test_clojure/sequences.clj
@@ -7,18 +7,73 @@
 ;   You must not remove this notice, or any other, from this software.
 
 ; Author: Frantisek Sodomka
-
+; Contributors: Stuart Halloway
 
 (ns clojure.test-clojure.sequences
   (:use clojure.test))
 
-
 ;; *** Tests ***
 
 ; TODO:
-; apply, map, reduce, filter, remove
+; apply, map, filter, remove
 ; and more...
 
+(deftest test-reduce
+  (let [int+ (fn [a b] (+ (int a) (int b)))
+        arange (range 100) ;; enough to cross nodes
+        avec (into [] arange)
+        alist (into () arange)
+        obj-array (into-array arange)
+        int-array (into-array Integer/TYPE arange)
+        long-array (into-array Long/TYPE arange)
+        float-array (into-array Float/TYPE arange)
+        char-array (into-array Character/TYPE (map char arange))
+        double-array (into-array Double/TYPE arange)
+        byte-array (into-array Byte/TYPE (map byte arange))
+        int-vec (into (vector-of :int) arange)
+        long-vec (into (vector-of :long) arange)
+        float-vec (into (vector-of :float) arange)
+        char-vec (into (vector-of :char) (map char arange))
+        double-vec (into (vector-of :double) arange)
+        byte-vec (into (vector-of :byte) (map byte arange))
+        all-true (into-array Boolean/TYPE (repeat 10 true))]
+    (is (= 4950
+           (reduce + arange)
+           (reduce + avec)
+           (reduce + alist)
+           (reduce + obj-array)
+           (reduce + int-array)
+           (reduce + long-array)
+           (reduce + float-array)
+           (reduce int+ char-array)
+           (reduce + double-array)
+           (reduce int+ byte-array)
+           (reduce + int-vec)
+           (reduce + long-vec)
+           (reduce + float-vec)
+           (reduce int+ char-vec)
+           (reduce + double-vec)
+           (reduce int+ byte-vec)))
+    (is (= 4951
+           (reduce + 1 arange)
+           (reduce + 1 avec)
+           (reduce + 1 alist)
+           (reduce + 1 obj-array)
+           (reduce + 1 int-array)
+           (reduce + 1 long-array)
+           (reduce + 1 float-array)
+           (reduce int+ 1 char-array)
+           (reduce + 1 double-array)
+           (reduce int+ 1 byte-array)
+           (reduce + 1 int-vec)
+           (reduce + 1 long-vec)
+           (reduce + 1 float-vec)
+           (reduce int+ 1 char-vec)
+           (reduce + 1 double-vec)
+           (reduce int+ 1 byte-vec)))
+    (is (= true
+           (reduce #(and %1 %2) all-true)
+           (reduce #(and %1 %2) true all-true)))))
 
 (deftest test-equality
   ; lazy sequences