From e0e0b6a2f192bf743e3629dff0b23a39ccf4f8db Mon Sep 17 00:00:00 2001
From: Stuart Halloway <stu@thinkrelevance.com>
Date: Fri, 23 Apr 2010 13:47:44 -0400
Subject: [PATCH] make defrecord .cons work, #231

- based on original patch from Allen Rohner
  - altered to handle nil correctly
  - added test cases

Signed-off-by: Stuart Halloway <stu@thinkrelevance.com>
---
 src/clj/clojure/core_deftype.clj        | 18 +++++++++++++++++-
 test/clojure/test_clojure/protocols.clj | 24 ++++++++++++++++++++++++
 2 files changed, 41 insertions(+), 1 deletion(-)

diff --git a/src/clj/clojure/core_deftype.clj b/src/clj/clojure/core_deftype.clj
index ce81b44882..6e1d8d7e9d 100644
--- a/src/clj/clojure/core_deftype.clj
+++ b/src/clj/clojure/core_deftype.clj
@@ -107,6 +107,22 @@
 (defn munge [s]
   ((if (symbol? s) symbol str) (clojure.lang.Compiler/munge (str s))))
 
+(defn- imap-cons
+  [#^IPersistentMap this o]
+  (cond
+   (instance? java.util.Map$Entry o)
+     (let [#^java.util.Map$Entry pair o]
+       (.assoc this (.getKey pair) (.getValue pair)))
+   (instance? clojure.lang.IPersistentVector o)
+     (let [#^clojure.lang.IPersistentVector vec o]
+       (.assoc this (.nth vec 0) (.nth vec 1)))
+   :else (loop [this this
+                o o]
+      (if (seq o)
+        (let [#^java.util.Map$Entry pair (first o)]
+          (recur (.assoc this (.getKey pair) (.getValue pair)) (rest o)))
+        this))))
+
 (defn- emit-defrecord 
   "Do not use this directly - use defrecord"
   [tagname name fields interfaces methods]
@@ -163,7 +179,7 @@
              (conj m 
                    `(count [~'this] (+ ~(count base-fields) (count ~'__extmap)))
                    `(empty [~'this] (throw (UnsupportedOperationException. (str "Can't create empty: " ~(str classname)))))
-                   `(cons [~'this ~'e] (let [[~'k ~'v] ~'e] (.assoc ~'this ~'k ~'v)))
+                   `(cons [~'this ~'e] ((var imap-cons) ~'this ~'e))
                    `(equiv [~'this ~'o] (.equals ~'this ~'o))
                    `(containsKey [~'this ~'k] (not (identical? ~'this (.valAt ~'this ~'k ~'this))))
                    `(entryAt [~'this ~'k] (let [~'v (.valAt ~'this ~'k ~'this)]
diff --git a/test/clojure/test_clojure/protocols.clj b/test/clojure/test_clojure/protocols.clj
index b38f41cdf0..7f678234ea 100644
--- a/test/clojure/test_clojure/protocols.clj
+++ b/test/clojure/test_clojure/protocols.clj
@@ -30,6 +30,15 @@
      (map #(.getName %))
      (sort)))
 
+(defrecord TestRecord [a b])
+(defn r
+  ([a b] (TestRecord. a b))
+  ([a b meta ext] (TestRecord. a b meta ext)))
+(defrecord MapEntry [k v]
+  java.util.Map$Entry
+  (getKey [_] k)
+  (getValue [_] v))
+
 (deftest protocols-test
   (testing "protocol fns throw IllegalArgumentException if no impl matches"
     (is (thrown-with-msg?
@@ -143,9 +152,24 @@
     (is (= (.hashCode (DefrecordObjectMethodsWidgetB. 1)) (.hashCode (DefrecordObjectMethodsWidgetB. 1))))
     (is (not= (.hashCode (DefrecordObjectMethodsWidgetA. 1)) (.hashCode (DefrecordObjectMethodsWidgetB. 1))))))
 
+(deftest defrecord-acts-like-a-map
+  (let [rec (r 1 2)]
+    (is (= (r 1 3 {} {:c 4}) (merge rec {:b 3 :c 4})))))
+
+(deftest defrecord-interfaces-test
+  (testing "IPersistentCollection"
+    (testing ".cons"
+      (let [rec (r 1 2)]
+        (are [x] (= rec (.cons rec x))
+             nil {})
+        (is (= (r 1 3) (.cons rec {:b 3})))
+        (is (= (r 1 4) (.cons rec [:b 4])))
+        (is (= (r 1 5) (.cons rec (MapEntry. :b 5))))))))
+
 ;; 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
+