1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/core_print.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,320 @@
     1.4 +;   Copyright (c) Rich Hickey. All rights reserved.
     1.5 +;   The use and distribution terms for this software are covered by the
     1.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
     1.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
     1.8 +;   By using this software in any fashion, you are agreeing to be bound by
     1.9 +;   the terms of this license.
    1.10 +;   You must not remove this notice, or any other, from this software.
    1.11 +
    1.12 +(in-ns 'clojure.core)
    1.13 +
    1.14 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; printing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1.15 +
    1.16 +(import '(java.io Writer))
    1.17 +
    1.18 +(def
    1.19 + ^{:doc "*print-length* controls how many items of each collection the
    1.20 +  printer will print. If it is bound to logical false, there is no
    1.21 +  limit. Otherwise, it must be bound to an integer indicating the maximum
    1.22 +  number of items of each collection to print. If a collection contains
    1.23 +  more items, the printer will print items up to the limit followed by
    1.24 +  '...' to represent the remaining items. The root binding is nil
    1.25 +  indicating no limit."
    1.26 +   :added "1.0"}
    1.27 + *print-length* nil)
    1.28 +
    1.29 +(def
    1.30 + ^{:doc "*print-level* controls how many levels deep the printer will
    1.31 +  print nested objects. If it is bound to logical false, there is no
    1.32 +  limit. Otherwise, it must be bound to an integer indicating the maximum
    1.33 +  level to print. Each argument to print is at level 0; if an argument is a
    1.34 +  collection, its items are at level 1; and so on. If an object is a
    1.35 +  collection and is at a level greater than or equal to the value bound to
    1.36 +  *print-level*, the printer prints '#' to represent it. The root binding
    1.37 +  is nil indicating no limit."
    1.38 +   :added "1.0"}
    1.39 +*print-level* nil)
    1.40 +
    1.41 +(defn- print-sequential [^String begin, print-one, ^String sep, ^String end, sequence, ^Writer w]
    1.42 +  (binding [*print-level* (and (not *print-dup*) *print-level* (dec *print-level*))]
    1.43 +    (if (and *print-level* (neg? *print-level*))
    1.44 +      (.write w "#")
    1.45 +      (do
    1.46 +        (.write w begin)
    1.47 +        (when-let [xs (seq sequence)]
    1.48 +          (if (and (not *print-dup*) *print-length*)
    1.49 +            (loop [[x & xs] xs
    1.50 +                   print-length *print-length*]
    1.51 +              (if (zero? print-length)
    1.52 +                (.write w "...")
    1.53 +                (do
    1.54 +                  (print-one x w)
    1.55 +                  (when xs
    1.56 +                    (.write w sep)
    1.57 +                    (recur xs (dec print-length))))))
    1.58 +            (loop [[x & xs] xs]
    1.59 +              (print-one x w)
    1.60 +              (when xs
    1.61 +                (.write w sep)
    1.62 +                (recur xs)))))
    1.63 +        (.write w end)))))
    1.64 +
    1.65 +(defn- print-meta [o, ^Writer w]
    1.66 +  (when-let [m (meta o)]
    1.67 +    (when (and (pos? (count m))
    1.68 +               (or *print-dup*
    1.69 +                   (and *print-meta* *print-readably*)))
    1.70 +      (.write w "^")
    1.71 +      (if (and (= (count m) 1) (:tag m))
    1.72 +          (pr-on (:tag m) w)
    1.73 +          (pr-on m w))
    1.74 +      (.write w " "))))
    1.75 +
    1.76 +(defmethod print-method :default [o, ^Writer w]
    1.77 +  (print-method (vary-meta o #(dissoc % :type)) w))
    1.78 +
    1.79 +(defmethod print-method nil [o, ^Writer w]
    1.80 +  (.write w "nil"))
    1.81 +
    1.82 +(defmethod print-dup nil [o w] (print-method o w))
    1.83 +
    1.84 +(defn print-ctor [o print-args ^Writer w]
    1.85 +  (.write w "#=(")
    1.86 +  (.write w (.getName ^Class (class o)))
    1.87 +  (.write w ". ")
    1.88 +  (print-args o w)
    1.89 +  (.write w ")"))
    1.90 +
    1.91 +(defmethod print-method Object [o, ^Writer w]
    1.92 +  (.write w "#<")
    1.93 +  (.write w (.getSimpleName (class o)))
    1.94 +  (.write w " ")
    1.95 +  (.write w (str o))
    1.96 +  (.write w ">"))
    1.97 +
    1.98 +(defmethod print-method clojure.lang.Keyword [o, ^Writer w]
    1.99 +  (.write w (str o)))
   1.100 +
   1.101 +(defmethod print-dup clojure.lang.Keyword [o w] (print-method o w))
   1.102 +
   1.103 +(defmethod print-method Number [o, ^Writer w]
   1.104 +  (.write w (str o)))
   1.105 +
   1.106 +(defmethod print-dup Number [o, ^Writer w]
   1.107 +  (print-ctor o
   1.108 +              (fn [o w]
   1.109 +                  (print-dup (str o) w))
   1.110 +              w))
   1.111 +
   1.112 +(defmethod print-dup clojure.lang.Fn [o, ^Writer w]
   1.113 +  (print-ctor o (fn [o w]) w))
   1.114 +
   1.115 +(prefer-method print-dup clojure.lang.IPersistentCollection clojure.lang.Fn)
   1.116 +(prefer-method print-dup java.util.Map clojure.lang.Fn)
   1.117 +(prefer-method print-dup java.util.Collection clojure.lang.Fn)
   1.118 +
   1.119 +(defmethod print-method Boolean [o, ^Writer w]
   1.120 +  (.write w (str o)))
   1.121 +
   1.122 +(defmethod print-dup Boolean [o w] (print-method o w))
   1.123 +
   1.124 +(defn print-simple [o, ^Writer w]
   1.125 +  (print-meta o w)
   1.126 +  (.write w (str o)))
   1.127 +
   1.128 +(defmethod print-method clojure.lang.Symbol [o, ^Writer w]
   1.129 +  (print-simple o w))
   1.130 +
   1.131 +(defmethod print-dup clojure.lang.Symbol [o w] (print-method o w))
   1.132 +
   1.133 +(defmethod print-method clojure.lang.Var [o, ^Writer w]
   1.134 +  (print-simple o w))
   1.135 +
   1.136 +(defmethod print-dup clojure.lang.Var [^clojure.lang.Var o, ^Writer w]
   1.137 +  (.write w (str "#=(var " (.name (.ns o)) "/" (.sym o) ")")))
   1.138 +
   1.139 +(defmethod print-method clojure.lang.ISeq [o, ^Writer w]
   1.140 +  (print-meta o w)
   1.141 +  (print-sequential "(" pr-on " " ")" o w))
   1.142 +
   1.143 +(defmethod print-dup clojure.lang.ISeq [o w] (print-method o w))
   1.144 +(defmethod print-dup clojure.lang.IPersistentList [o w] (print-method o w))
   1.145 +(prefer-method print-method clojure.lang.ISeq clojure.lang.IPersistentCollection)
   1.146 +(prefer-method print-dup clojure.lang.ISeq clojure.lang.IPersistentCollection)
   1.147 +(prefer-method print-method clojure.lang.ISeq java.util.Collection)
   1.148 +(prefer-method print-dup clojure.lang.ISeq java.util.Collection)
   1.149 +
   1.150 +
   1.151 +
   1.152 +(defmethod print-dup java.util.Collection [o, ^Writer w]
   1.153 + (print-ctor o #(print-sequential "[" print-dup " " "]" %1 %2) w))
   1.154 +
   1.155 +(defmethod print-dup clojure.lang.IPersistentCollection [o, ^Writer w]
   1.156 +  (print-meta o w)
   1.157 +  (.write w "#=(")
   1.158 +  (.write w (.getName ^Class (class o)))
   1.159 +  (.write w "/create ")
   1.160 +  (print-sequential "[" print-dup " " "]" o w)
   1.161 +  (.write w ")"))
   1.162 +
   1.163 +(prefer-method print-dup clojure.lang.IPersistentCollection java.util.Collection)
   1.164 +
   1.165 +(def ^{:tag String 
   1.166 +       :doc "Returns escape string for char or nil if none"
   1.167 +       :added "1.0"}
   1.168 +  char-escape-string
   1.169 +    {\newline "\\n"
   1.170 +     \tab  "\\t"
   1.171 +     \return "\\r"
   1.172 +     \" "\\\""
   1.173 +     \\  "\\\\"
   1.174 +     \formfeed "\\f"
   1.175 +     \backspace "\\b"})
   1.176 +
   1.177 +(defmethod print-method String [^String s, ^Writer w]
   1.178 +  (if (or *print-dup* *print-readably*)
   1.179 +    (do (.append w \")
   1.180 +      (dotimes [n (count s)]
   1.181 +        (let [c (.charAt s n)
   1.182 +              e (char-escape-string c)]
   1.183 +          (if e (.write w e) (.append w c))))
   1.184 +      (.append w \"))
   1.185 +    (.write w s))
   1.186 +  nil)
   1.187 +
   1.188 +(defmethod print-dup String [s w] (print-method s w))
   1.189 +
   1.190 +(defmethod print-method clojure.lang.IPersistentVector [v, ^Writer w]
   1.191 +  (print-meta v w)
   1.192 +  (print-sequential "[" pr-on " " "]" v w))
   1.193 +
   1.194 +(defn- print-map [m print-one w]
   1.195 +  (print-sequential 
   1.196 +   "{"
   1.197 +   (fn [e  ^Writer w] 
   1.198 +     (do (print-one (key e) w) (.append w \space) (print-one (val e) w)))
   1.199 +   ", "
   1.200 +   "}"
   1.201 +   (seq m) w))
   1.202 +
   1.203 +(defmethod print-method clojure.lang.IPersistentMap [m, ^Writer w]
   1.204 +  (print-meta m w)
   1.205 +  (print-map m pr-on w))
   1.206 +
   1.207 +(defmethod print-dup java.util.Map [m, ^Writer w]
   1.208 +  (print-ctor m #(print-map (seq %1) print-dup %2) w))
   1.209 +
   1.210 +(defmethod print-dup clojure.lang.IPersistentMap [m, ^Writer w]
   1.211 +  (print-meta m w)
   1.212 +  (.write w "#=(")
   1.213 +  (.write w (.getName (class m)))
   1.214 +  (.write w "/create ")
   1.215 +  (print-map m print-dup w)
   1.216 +  (.write w ")"))
   1.217 +
   1.218 +(prefer-method print-dup clojure.lang.IPersistentCollection java.util.Map)
   1.219 +
   1.220 +(defmethod print-method clojure.lang.IPersistentSet [s, ^Writer w]
   1.221 +  (print-meta s w)
   1.222 +  (print-sequential "#{" pr-on " " "}" (seq s) w))
   1.223 +
   1.224 +(def ^{:tag String 
   1.225 +       :doc "Returns name string for char or nil if none"
   1.226 +       :added "1.0"} 
   1.227 + char-name-string
   1.228 +   {\newline "newline"
   1.229 +    \tab "tab"
   1.230 +    \space "space"
   1.231 +    \backspace "backspace"
   1.232 +    \formfeed "formfeed"
   1.233 +    \return "return"})
   1.234 +
   1.235 +(defmethod print-method java.lang.Character [^Character c, ^Writer w]
   1.236 +  (if (or *print-dup* *print-readably*)
   1.237 +    (do (.append w \\)
   1.238 +        (let [n (char-name-string c)]
   1.239 +          (if n (.write w n) (.append w c))))
   1.240 +    (.append w c))
   1.241 +  nil)
   1.242 +
   1.243 +(defmethod print-dup java.lang.Character [c w] (print-method c w))
   1.244 +(defmethod print-dup java.lang.Integer [o w] (print-method o w))
   1.245 +(defmethod print-dup java.lang.Double [o w] (print-method o w))
   1.246 +(defmethod print-dup clojure.lang.Ratio [o w] (print-method o w))
   1.247 +(defmethod print-dup java.math.BigDecimal [o w] (print-method o w))
   1.248 +(defmethod print-dup clojure.lang.PersistentHashMap [o w] (print-method o w))
   1.249 +(defmethod print-dup clojure.lang.PersistentHashSet [o w] (print-method o w))
   1.250 +(defmethod print-dup clojure.lang.PersistentVector [o w] (print-method o w))
   1.251 +(defmethod print-dup clojure.lang.LazilyPersistentVector [o w] (print-method o w))
   1.252 +
   1.253 +(def primitives-classnames
   1.254 +  {Float/TYPE "Float/TYPE"
   1.255 +   Integer/TYPE "Integer/TYPE"
   1.256 +   Long/TYPE "Long/TYPE"
   1.257 +   Boolean/TYPE "Boolean/TYPE"
   1.258 +   Character/TYPE "Character/TYPE"
   1.259 +   Double/TYPE "Double/TYPE"
   1.260 +   Byte/TYPE "Byte/TYPE"
   1.261 +   Short/TYPE "Short/TYPE"})
   1.262 +
   1.263 +(defmethod print-method Class [^Class c, ^Writer w]
   1.264 +  (.write w (.getName c)))
   1.265 +
   1.266 +(defmethod print-dup Class [^Class c, ^Writer w]
   1.267 +  (cond
   1.268 +    (.isPrimitive c) (do
   1.269 +                       (.write w "#=(identity ")
   1.270 +                       (.write w ^String (primitives-classnames c))
   1.271 +                       (.write w ")"))
   1.272 +    (.isArray c) (do
   1.273 +                   (.write w "#=(java.lang.Class/forName \"")
   1.274 +                   (.write w (.getName c))
   1.275 +                   (.write w "\")"))
   1.276 +    :else (do
   1.277 +            (.write w "#=")
   1.278 +            (.write w (.getName c)))))
   1.279 +
   1.280 +(defmethod print-method java.math.BigDecimal [b, ^Writer w]
   1.281 +  (.write w (str b))
   1.282 +  (.write w "M"))
   1.283 +
   1.284 +(defmethod print-method java.util.regex.Pattern [p ^Writer w]
   1.285 +  (.write w "#\"")
   1.286 +  (loop [[^Character c & r :as s] (seq (.pattern ^java.util.regex.Pattern p))
   1.287 +         qmode false]
   1.288 +    (when s
   1.289 +      (cond
   1.290 +        (= c \\) (let [[^Character c2 & r2] r]
   1.291 +                   (.append w \\)
   1.292 +                   (.append w c2)
   1.293 +                   (if qmode
   1.294 +                      (recur r2 (not= c2 \E))
   1.295 +                      (recur r2 (= c2 \Q))))
   1.296 +        (= c \") (do
   1.297 +                   (if qmode
   1.298 +                     (.write w "\\E\\\"\\Q")
   1.299 +                     (.write w "\\\""))
   1.300 +                   (recur r qmode))
   1.301 +        :else    (do
   1.302 +                   (.append w c)
   1.303 +                   (recur r qmode)))))
   1.304 +  (.append w \"))
   1.305 +
   1.306 +(defmethod print-dup java.util.regex.Pattern [p ^Writer w] (print-method p w))
   1.307 +
   1.308 +(defmethod print-dup clojure.lang.Namespace [^clojure.lang.Namespace n ^Writer w]
   1.309 +  (.write w "#=(find-ns ")
   1.310 +  (print-dup (.name n) w)
   1.311 +  (.write w ")"))
   1.312 +
   1.313 +(defmethod print-method clojure.lang.IDeref [o ^Writer w]
   1.314 +  (print-sequential (format "#<%s@%x%s: "
   1.315 +                            (.getSimpleName (class o))
   1.316 +                            (System/identityHashCode o)
   1.317 +                            (if (and (instance? clojure.lang.Agent o)
   1.318 +                                     (agent-error o))
   1.319 +                              " FAILED"
   1.320 +                              ""))
   1.321 +                    pr-on, "", ">", (list (if (and (future? o) (not (future-done? o))) :pending @o)), w))
   1.322 +
   1.323 +(def ^{:private true} print-initialized true)