rlm@10: ;   Copyright (c) Rich Hickey. All rights reserved.
rlm@10: ;   The use and distribution terms for this software are covered by the
rlm@10: ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
rlm@10: ;   which can be found in the file epl-v10.html at the root of this distribution.
rlm@10: ;   By using this software in any fashion, you are agreeing to be bound by
rlm@10: ;   the terms of this license.
rlm@10: ;   You must not remove this notice, or any other, from this software.
rlm@10: 
rlm@10: (in-ns 'clojure.core)
rlm@10: 
rlm@10: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; printing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
rlm@10: 
rlm@10: (import '(java.io Writer))
rlm@10: 
rlm@10: (def
rlm@10:  ^{:doc "*print-length* controls how many items of each collection the
rlm@10:   printer will print. If it is bound to logical false, there is no
rlm@10:   limit. Otherwise, it must be bound to an integer indicating the maximum
rlm@10:   number of items of each collection to print. If a collection contains
rlm@10:   more items, the printer will print items up to the limit followed by
rlm@10:   '...' to represent the remaining items. The root binding is nil
rlm@10:   indicating no limit."
rlm@10:    :added "1.0"}
rlm@10:  *print-length* nil)
rlm@10: 
rlm@10: (def
rlm@10:  ^{:doc "*print-level* controls how many levels deep the printer will
rlm@10:   print nested objects. If it is bound to logical false, there is no
rlm@10:   limit. Otherwise, it must be bound to an integer indicating the maximum
rlm@10:   level to print. Each argument to print is at level 0; if an argument is a
rlm@10:   collection, its items are at level 1; and so on. If an object is a
rlm@10:   collection and is at a level greater than or equal to the value bound to
rlm@10:   *print-level*, the printer prints '#' to represent it. The root binding
rlm@10:   is nil indicating no limit."
rlm@10:    :added "1.0"}
rlm@10: *print-level* nil)
rlm@10: 
rlm@10: (defn- print-sequential [^String begin, print-one, ^String sep, ^String end, sequence, ^Writer w]
rlm@10:   (binding [*print-level* (and (not *print-dup*) *print-level* (dec *print-level*))]
rlm@10:     (if (and *print-level* (neg? *print-level*))
rlm@10:       (.write w "#")
rlm@10:       (do
rlm@10:         (.write w begin)
rlm@10:         (when-let [xs (seq sequence)]
rlm@10:           (if (and (not *print-dup*) *print-length*)
rlm@10:             (loop [[x & xs] xs
rlm@10:                    print-length *print-length*]
rlm@10:               (if (zero? print-length)
rlm@10:                 (.write w "...")
rlm@10:                 (do
rlm@10:                   (print-one x w)
rlm@10:                   (when xs
rlm@10:                     (.write w sep)
rlm@10:                     (recur xs (dec print-length))))))
rlm@10:             (loop [[x & xs] xs]
rlm@10:               (print-one x w)
rlm@10:               (when xs
rlm@10:                 (.write w sep)
rlm@10:                 (recur xs)))))
rlm@10:         (.write w end)))))
rlm@10: 
rlm@10: (defn- print-meta [o, ^Writer w]
rlm@10:   (when-let [m (meta o)]
rlm@10:     (when (and (pos? (count m))
rlm@10:                (or *print-dup*
rlm@10:                    (and *print-meta* *print-readably*)))
rlm@10:       (.write w "^")
rlm@10:       (if (and (= (count m) 1) (:tag m))
rlm@10:           (pr-on (:tag m) w)
rlm@10:           (pr-on m w))
rlm@10:       (.write w " "))))
rlm@10: 
rlm@10: (defmethod print-method :default [o, ^Writer w]
rlm@10:   (print-method (vary-meta o #(dissoc % :type)) w))
rlm@10: 
rlm@10: (defmethod print-method nil [o, ^Writer w]
rlm@10:   (.write w "nil"))
rlm@10: 
rlm@10: (defmethod print-dup nil [o w] (print-method o w))
rlm@10: 
rlm@10: (defn print-ctor [o print-args ^Writer w]
rlm@10:   (.write w "#=(")
rlm@10:   (.write w (.getName ^Class (class o)))
rlm@10:   (.write w ". ")
rlm@10:   (print-args o w)
rlm@10:   (.write w ")"))
rlm@10: 
rlm@10: (defmethod print-method Object [o, ^Writer w]
rlm@10:   (.write w "#<")
rlm@10:   (.write w (.getSimpleName (class o)))
rlm@10:   (.write w " ")
rlm@10:   (.write w (str o))
rlm@10:   (.write w ">"))
rlm@10: 
rlm@10: (defmethod print-method clojure.lang.Keyword [o, ^Writer w]
rlm@10:   (.write w (str o)))
rlm@10: 
rlm@10: (defmethod print-dup clojure.lang.Keyword [o w] (print-method o w))
rlm@10: 
rlm@10: (defmethod print-method Number [o, ^Writer w]
rlm@10:   (.write w (str o)))
rlm@10: 
rlm@10: (defmethod print-dup Number [o, ^Writer w]
rlm@10:   (print-ctor o
rlm@10:               (fn [o w]
rlm@10:                   (print-dup (str o) w))
rlm@10:               w))
rlm@10: 
rlm@10: (defmethod print-dup clojure.lang.Fn [o, ^Writer w]
rlm@10:   (print-ctor o (fn [o w]) w))
rlm@10: 
rlm@10: (prefer-method print-dup clojure.lang.IPersistentCollection clojure.lang.Fn)
rlm@10: (prefer-method print-dup java.util.Map clojure.lang.Fn)
rlm@10: (prefer-method print-dup java.util.Collection clojure.lang.Fn)
rlm@10: 
rlm@10: (defmethod print-method Boolean [o, ^Writer w]
rlm@10:   (.write w (str o)))
rlm@10: 
rlm@10: (defmethod print-dup Boolean [o w] (print-method o w))
rlm@10: 
rlm@10: (defn print-simple [o, ^Writer w]
rlm@10:   (print-meta o w)
rlm@10:   (.write w (str o)))
rlm@10: 
rlm@10: (defmethod print-method clojure.lang.Symbol [o, ^Writer w]
rlm@10:   (print-simple o w))
rlm@10: 
rlm@10: (defmethod print-dup clojure.lang.Symbol [o w] (print-method o w))
rlm@10: 
rlm@10: (defmethod print-method clojure.lang.Var [o, ^Writer w]
rlm@10:   (print-simple o w))
rlm@10: 
rlm@10: (defmethod print-dup clojure.lang.Var [^clojure.lang.Var o, ^Writer w]
rlm@10:   (.write w (str "#=(var " (.name (.ns o)) "/" (.sym o) ")")))
rlm@10: 
rlm@10: (defmethod print-method clojure.lang.ISeq [o, ^Writer w]
rlm@10:   (print-meta o w)
rlm@10:   (print-sequential "(" pr-on " " ")" o w))
rlm@10: 
rlm@10: (defmethod print-dup clojure.lang.ISeq [o w] (print-method o w))
rlm@10: (defmethod print-dup clojure.lang.IPersistentList [o w] (print-method o w))
rlm@10: (prefer-method print-method clojure.lang.ISeq clojure.lang.IPersistentCollection)
rlm@10: (prefer-method print-dup clojure.lang.ISeq clojure.lang.IPersistentCollection)
rlm@10: (prefer-method print-method clojure.lang.ISeq java.util.Collection)
rlm@10: (prefer-method print-dup clojure.lang.ISeq java.util.Collection)
rlm@10: 
rlm@10: 
rlm@10: 
rlm@10: (defmethod print-dup java.util.Collection [o, ^Writer w]
rlm@10:  (print-ctor o #(print-sequential "[" print-dup " " "]" %1 %2) w))
rlm@10: 
rlm@10: (defmethod print-dup clojure.lang.IPersistentCollection [o, ^Writer w]
rlm@10:   (print-meta o w)
rlm@10:   (.write w "#=(")
rlm@10:   (.write w (.getName ^Class (class o)))
rlm@10:   (.write w "/create ")
rlm@10:   (print-sequential "[" print-dup " " "]" o w)
rlm@10:   (.write w ")"))
rlm@10: 
rlm@10: (prefer-method print-dup clojure.lang.IPersistentCollection java.util.Collection)
rlm@10: 
rlm@10: (def ^{:tag String 
rlm@10:        :doc "Returns escape string for char or nil if none"
rlm@10:        :added "1.0"}
rlm@10:   char-escape-string
rlm@10:     {\newline "\\n"
rlm@10:      \tab  "\\t"
rlm@10:      \return "\\r"
rlm@10:      \" "\\\""
rlm@10:      \\  "\\\\"
rlm@10:      \formfeed "\\f"
rlm@10:      \backspace "\\b"})
rlm@10: 
rlm@10: (defmethod print-method String [^String s, ^Writer w]
rlm@10:   (if (or *print-dup* *print-readably*)
rlm@10:     (do (.append w \")
rlm@10:       (dotimes [n (count s)]
rlm@10:         (let [c (.charAt s n)
rlm@10:               e (char-escape-string c)]
rlm@10:           (if e (.write w e) (.append w c))))
rlm@10:       (.append w \"))
rlm@10:     (.write w s))
rlm@10:   nil)
rlm@10: 
rlm@10: (defmethod print-dup String [s w] (print-method s w))
rlm@10: 
rlm@10: (defmethod print-method clojure.lang.IPersistentVector [v, ^Writer w]
rlm@10:   (print-meta v w)
rlm@10:   (print-sequential "[" pr-on " " "]" v w))
rlm@10: 
rlm@10: (defn- print-map [m print-one w]
rlm@10:   (print-sequential 
rlm@10:    "{"
rlm@10:    (fn [e  ^Writer w] 
rlm@10:      (do (print-one (key e) w) (.append w \space) (print-one (val e) w)))
rlm@10:    ", "
rlm@10:    "}"
rlm@10:    (seq m) w))
rlm@10: 
rlm@10: (defmethod print-method clojure.lang.IPersistentMap [m, ^Writer w]
rlm@10:   (print-meta m w)
rlm@10:   (print-map m pr-on w))
rlm@10: 
rlm@10: (defmethod print-dup java.util.Map [m, ^Writer w]
rlm@10:   (print-ctor m #(print-map (seq %1) print-dup %2) w))
rlm@10: 
rlm@10: (defmethod print-dup clojure.lang.IPersistentMap [m, ^Writer w]
rlm@10:   (print-meta m w)
rlm@10:   (.write w "#=(")
rlm@10:   (.write w (.getName (class m)))
rlm@10:   (.write w "/create ")
rlm@10:   (print-map m print-dup w)
rlm@10:   (.write w ")"))
rlm@10: 
rlm@10: (prefer-method print-dup clojure.lang.IPersistentCollection java.util.Map)
rlm@10: 
rlm@10: (defmethod print-method clojure.lang.IPersistentSet [s, ^Writer w]
rlm@10:   (print-meta s w)
rlm@10:   (print-sequential "#{" pr-on " " "}" (seq s) w))
rlm@10: 
rlm@10: (def ^{:tag String 
rlm@10:        :doc "Returns name string for char or nil if none"
rlm@10:        :added "1.0"} 
rlm@10:  char-name-string
rlm@10:    {\newline "newline"
rlm@10:     \tab "tab"
rlm@10:     \space "space"
rlm@10:     \backspace "backspace"
rlm@10:     \formfeed "formfeed"
rlm@10:     \return "return"})
rlm@10: 
rlm@10: (defmethod print-method java.lang.Character [^Character c, ^Writer w]
rlm@10:   (if (or *print-dup* *print-readably*)
rlm@10:     (do (.append w \\)
rlm@10:         (let [n (char-name-string c)]
rlm@10:           (if n (.write w n) (.append w c))))
rlm@10:     (.append w c))
rlm@10:   nil)
rlm@10: 
rlm@10: (defmethod print-dup java.lang.Character [c w] (print-method c w))
rlm@10: (defmethod print-dup java.lang.Integer [o w] (print-method o w))
rlm@10: (defmethod print-dup java.lang.Double [o w] (print-method o w))
rlm@10: (defmethod print-dup clojure.lang.Ratio [o w] (print-method o w))
rlm@10: (defmethod print-dup java.math.BigDecimal [o w] (print-method o w))
rlm@10: (defmethod print-dup clojure.lang.PersistentHashMap [o w] (print-method o w))
rlm@10: (defmethod print-dup clojure.lang.PersistentHashSet [o w] (print-method o w))
rlm@10: (defmethod print-dup clojure.lang.PersistentVector [o w] (print-method o w))
rlm@10: (defmethod print-dup clojure.lang.LazilyPersistentVector [o w] (print-method o w))
rlm@10: 
rlm@10: (def primitives-classnames
rlm@10:   {Float/TYPE "Float/TYPE"
rlm@10:    Integer/TYPE "Integer/TYPE"
rlm@10:    Long/TYPE "Long/TYPE"
rlm@10:    Boolean/TYPE "Boolean/TYPE"
rlm@10:    Character/TYPE "Character/TYPE"
rlm@10:    Double/TYPE "Double/TYPE"
rlm@10:    Byte/TYPE "Byte/TYPE"
rlm@10:    Short/TYPE "Short/TYPE"})
rlm@10: 
rlm@10: (defmethod print-method Class [^Class c, ^Writer w]
rlm@10:   (.write w (.getName c)))
rlm@10: 
rlm@10: (defmethod print-dup Class [^Class c, ^Writer w]
rlm@10:   (cond
rlm@10:     (.isPrimitive c) (do
rlm@10:                        (.write w "#=(identity ")
rlm@10:                        (.write w ^String (primitives-classnames c))
rlm@10:                        (.write w ")"))
rlm@10:     (.isArray c) (do
rlm@10:                    (.write w "#=(java.lang.Class/forName \"")
rlm@10:                    (.write w (.getName c))
rlm@10:                    (.write w "\")"))
rlm@10:     :else (do
rlm@10:             (.write w "#=")
rlm@10:             (.write w (.getName c)))))
rlm@10: 
rlm@10: (defmethod print-method java.math.BigDecimal [b, ^Writer w]
rlm@10:   (.write w (str b))
rlm@10:   (.write w "M"))
rlm@10: 
rlm@10: (defmethod print-method java.util.regex.Pattern [p ^Writer w]
rlm@10:   (.write w "#\"")
rlm@10:   (loop [[^Character c & r :as s] (seq (.pattern ^java.util.regex.Pattern p))
rlm@10:          qmode false]
rlm@10:     (when s
rlm@10:       (cond
rlm@10:         (= c \\) (let [[^Character c2 & r2] r]
rlm@10:                    (.append w \\)
rlm@10:                    (.append w c2)
rlm@10:                    (if qmode
rlm@10:                       (recur r2 (not= c2 \E))
rlm@10:                       (recur r2 (= c2 \Q))))
rlm@10:         (= c \") (do
rlm@10:                    (if qmode
rlm@10:                      (.write w "\\E\\\"\\Q")
rlm@10:                      (.write w "\\\""))
rlm@10:                    (recur r qmode))
rlm@10:         :else    (do
rlm@10:                    (.append w c)
rlm@10:                    (recur r qmode)))))
rlm@10:   (.append w \"))
rlm@10: 
rlm@10: (defmethod print-dup java.util.regex.Pattern [p ^Writer w] (print-method p w))
rlm@10: 
rlm@10: (defmethod print-dup clojure.lang.Namespace [^clojure.lang.Namespace n ^Writer w]
rlm@10:   (.write w "#=(find-ns ")
rlm@10:   (print-dup (.name n) w)
rlm@10:   (.write w ")"))
rlm@10: 
rlm@10: (defmethod print-method clojure.lang.IDeref [o ^Writer w]
rlm@10:   (print-sequential (format "#<%s@%x%s: "
rlm@10:                             (.getSimpleName (class o))
rlm@10:                             (System/identityHashCode o)
rlm@10:                             (if (and (instance? clojure.lang.Agent o)
rlm@10:                                      (agent-error o))
rlm@10:                               " FAILED"
rlm@10:                               ""))
rlm@10:                     pr-on, "", ">", (list (if (and (future? o) (not (future-done? o))) :pending @o)), w))
rlm@10: 
rlm@10: (def ^{:private true} print-initialized true)