Various pprint updates: Generalized support for various ref types Added pprint tests for various datatypes Bring private var access in line with the coding standard & all good sense Add support for PersistentQueue objects

Signed-off-by: Stuart Halloway <stu@thinkrelevance.com>

2 files changed, 37 insertions, 24 deletions

diff --git a/src/clj/clojure/pprint/cl_format.clj b/src/clj/clojure/pprint/cl_format.clj
index 71feeeed..f04aa552 100644
--- a/src/clj/clojure/pprint/cl_format.clj
+++ b/src/clj/clojure/pprint/cl_format.clj
@@ -1884,13 +1884,7 @@ format-in can be either a control string or a previously compiled format."
   {:added "1.2"}
   [format-in]
   `(let [format-in# ~format-in
-         my-c-c# (var-get (get (ns-interns (the-ns 'clojure.pprint))
-                               '~'cached-compile))
-         my-e-f# (var-get (get (ns-interns (the-ns 'clojure.pprint))
-                               '~'execute-format))
-         my-i-n# (var-get (get (ns-interns (the-ns 'clojure.pprint))
-                               '~'init-navigator))
-         cf# (if (string? format-in#) (my-c-c# format-in#) format-in#)]
+         cf# (if (string? format-in#) (#'clojure.pprint/cached-compile format-in#) format-in#)]
      (fn [& args#]
-       (let [navigator# (my-i-n# args#)]
-         (my-e-f# cf# navigator#)))))
+       (let [navigator# (#'clojure.pprint/init-navigator args#)]
+         (#'clojure.pprint/execute-format cf# navigator#)))))
diff --git a/src/clj/clojure/pprint/dispatch.clj b/src/clj/clojure/pprint/dispatch.clj
index 47b6b41f..77e145fa 100644
--- a/src/clj/clojure/pprint/dispatch.clj
+++ b/src/clj/clojure/pprint/dispatch.clj
@@ -106,15 +106,36 @@
           (recur (next aseq)))))))
 
 (def ^{:private true} pprint-set (formatter-out "~<#{~;~@{~w~^ ~:_~}~;}~:>"))
-(defn- pprint-ref [ref]
-  (pprint-logical-block  :prefix "#<Ref " :suffix ">"
-    (write-out @ref)))
-(defn- pprint-atom [ref]
-  (pprint-logical-block :prefix "#<Atom " :suffix ">"
-    (write-out @ref)))
-(defn- pprint-agent [ref]
-  (pprint-logical-block :prefix "#<Agent " :suffix ">"
-    (write-out @ref)))
+
+;;; TODO: don't block on promise (currently impossible)
+
+(def ^{:private true} 
+     type-map {"core$future_call" "Future",
+               "core$promise" "Promise"})
+
+(defn- map-ref-type 
+  "Map ugly type names to something simpler"
+  [name]
+  (or (when-let [match (re-find #"^[^$]+\$[^$]+" name)]
+        (type-map match))
+      name))
+
+(defn- pprint-ideref [o]
+  (let [prefix (format "#<%s@%x%s: "
+                       (map-ref-type (.getSimpleName (class o)))
+                       (System/identityHashCode o)
+                       (if (and (instance? clojure.lang.Agent o)
+                                (agent-error o))
+                         " FAILED"
+                         ""))]
+    (pprint-logical-block  :prefix prefix :suffix ">"
+                           (pprint-indent :block (-> (count prefix) (- 2) -))
+                           (pprint-newline :linear)
+                           (write-out (cond 
+                                       (and (future? o) (not (future-done? o))) :pending
+                                       :else @o)))))
+
+(def ^{:private true} pprint-pqueue (formatter-out "~<<-(~;~@{~w~^ ~_~}~;)-<~:>"))
 
 (defn- pprint-simple-default [obj]
   (cond 
@@ -133,9 +154,8 @@
 (use-method simple-dispatch clojure.lang.IPersistentVector pprint-vector)
 (use-method simple-dispatch clojure.lang.IPersistentMap pprint-map)
 (use-method simple-dispatch clojure.lang.IPersistentSet pprint-set)
-(use-method simple-dispatch clojure.lang.Ref pprint-ref)
-(use-method simple-dispatch clojure.lang.Atom pprint-atom)
-(use-method simple-dispatch clojure.lang.Agent pprint-agent)
+(use-method simple-dispatch clojure.lang.PersistentQueue pprint-pqueue)
+(use-method simple-dispatch clojure.lang.IDeref pprint-ideref)
 (use-method simple-dispatch nil pr)
 (use-method simple-dispatch :default pprint-simple-default)
 
@@ -365,9 +385,8 @@
 (use-method code-dispatch clojure.lang.IPersistentVector pprint-vector)
 (use-method code-dispatch clojure.lang.IPersistentMap pprint-map)
 (use-method code-dispatch clojure.lang.IPersistentSet pprint-set)
-(use-method code-dispatch clojure.lang.Ref pprint-ref)
-(use-method code-dispatch clojure.lang.Atom pprint-atom)
-(use-method code-dispatch clojure.lang.Agent pprint-agent)
+(use-method code-dispatch clojure.lang.PersistentQueue pprint-pqueue)
+(use-method code-dispatch clojure.lang.IDeref pprint-ideref)
 (use-method code-dispatch nil pr)
 (use-method code-dispatch :default pprint-simple-default)