include hash in default object print-method. read-able print-method for IDerefs

Author: richhickey

src/clj/clojure/core_print.clj

@@ -94,7 +94,7 @@
   (print-args o w)
   (.write w ")"))
 
-(defn- print-object [o, ^Writer w]
+(defn- print-tagged-object [o rep ^Writer w]
   (when (instance? clojure.lang.IMeta o)
     (print-meta o w))
   (.write w "#object[")
@@ -103,9 +103,13 @@
       (print-method (.getName c) w)
       (.write w (.getName c))))
   (.write w " ")
-  (print-method (str o) w)
+  (.write w (format "0x%x " (System/identityHashCode o)))
+  (print-method rep w)
   (.write w "]"))
 
+(defn- print-object [o, ^Writer w]
+  (print-tagged-object o (str o) w))
+
 (defmethod print-method Object [o, ^Writer w]
   (print-object o w))
 
@@ -380,36 +384,51 @@
   (print-dup (.name n) w)
   (.write w ")"))
 
+(defn- deref-as-map [^clojure.lang.IDeref o]
+  (let [pending (and (instance? clojure.lang.IPending o)
+                     (not (.isRealized ^clojure.lang.IPending o)))
+        [ex val]
+        (when-not pending
+          (try [false (deref o)]
+               (catch Throwable e
+                 [true e])))]
+    {:status
+     (cond
+      (or ex
+          (and (instance? clojure.lang.Agent o)
+               (agent-error o)))
+      :failed
+
+      pending
+      :pending
+
+      :else
+      :ready)
+
+     :val val}))
+
 (defmethod print-method clojure.lang.IDeref [o ^Writer w]
-  (print-sequential (format "#<%s@%x%s: "
-                            (.getSimpleName (class o))
-                            (System/identityHashCode o)
-                            (if (and (instance? clojure.lang.Agent o)
-                                     (agent-error o))
-                              " FAILED"
-                              ""))
-                    pr-on, "", ">", (list (if (and (instance? clojure.lang.IPending o)
-                                                   (not (.isRealized ^clojure.lang.IPending o)))
-                                            :pending
-                                            @o)), w))
+  (print-tagged-object o (deref-as-map o) w))
 
 (defmethod print-method StackTraceElement [^StackTraceElement o ^Writer w]
   (print-method [(symbol (.getClassName o)) (symbol (.getMethodName o)) (.getFileName o) (.getLineNumber o)] w))
 
-(defn print-throwable [^Throwable o ^Writer w]
-  (.write w "#error")
+(defn- throwable-as-map [^Throwable o]
   (let [base (fn [^Throwable t]
                {:type (class t)
                 :message (.getLocalizedMessage t)
                 :at (get (.getStackTrace t) 0)})
         via (loop [via [], ^Throwable t o]
               (if t
                 (recur (conj via t) (.getCause t))
-                via))        
-        x {:cause (.getLocalizedMessage ^Throwable (last via))
+                via))] 
+    {:cause (.getLocalizedMessage ^Throwable (last via))
            :via (vec (map base via))
-           :trace (vec (.getStackTrace (or ^Throwable (last via) o)))}] 
-    (print-method x w)))
+           :trace (vec (.getStackTrace (or ^Throwable (last via) o)))}))
+
+(defn- print-throwable [^Throwable o ^Writer w]
+  (.write w "#error")
+  (print-method (throwable-as-map o) w))
 
 (defmethod print-method Throwable [^Throwable o ^Writer w]
   (print-throwable o w))