|
rlm@10
|
1 ; Copyright (c) Rich Hickey. All rights reserved.
|
|
rlm@10
|
2 ; The use and distribution terms for this software are covered by the
|
|
rlm@10
|
3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
|
rlm@10
|
4 ; which can be found in the file epl-v10.html at the root of this distribution.
|
|
rlm@10
|
5 ; By using this software in any fashion, you are agreeing to be bound by
|
|
rlm@10
|
6 ; the terms of this license.
|
|
rlm@10
|
7 ; You must not remove this notice, or any other, from this software.
|
|
rlm@10
|
8
|
|
rlm@10
|
9 (in-ns 'clojure.core)
|
|
rlm@10
|
10
|
|
rlm@10
|
11 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; printing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
12
|
|
rlm@10
|
13 (import '(java.io Writer))
|
|
rlm@10
|
14
|
|
rlm@10
|
15 (def
|
|
rlm@10
|
16 ^{:doc "*print-length* controls how many items of each collection the
|
|
rlm@10
|
17 printer will print. If it is bound to logical false, there is no
|
|
rlm@10
|
18 limit. Otherwise, it must be bound to an integer indicating the maximum
|
|
rlm@10
|
19 number of items of each collection to print. If a collection contains
|
|
rlm@10
|
20 more items, the printer will print items up to the limit followed by
|
|
rlm@10
|
21 '...' to represent the remaining items. The root binding is nil
|
|
rlm@10
|
22 indicating no limit."
|
|
rlm@10
|
23 :added "1.0"}
|
|
rlm@10
|
24 *print-length* nil)
|
|
rlm@10
|
25
|
|
rlm@10
|
26 (def
|
|
rlm@10
|
27 ^{:doc "*print-level* controls how many levels deep the printer will
|
|
rlm@10
|
28 print nested objects. If it is bound to logical false, there is no
|
|
rlm@10
|
29 limit. Otherwise, it must be bound to an integer indicating the maximum
|
|
rlm@10
|
30 level to print. Each argument to print is at level 0; if an argument is a
|
|
rlm@10
|
31 collection, its items are at level 1; and so on. If an object is a
|
|
rlm@10
|
32 collection and is at a level greater than or equal to the value bound to
|
|
rlm@10
|
33 *print-level*, the printer prints '#' to represent it. The root binding
|
|
rlm@10
|
34 is nil indicating no limit."
|
|
rlm@10
|
35 :added "1.0"}
|
|
rlm@10
|
36 *print-level* nil)
|
|
rlm@10
|
37
|
|
rlm@10
|
38 (defn- print-sequential [^String begin, print-one, ^String sep, ^String end, sequence, ^Writer w]
|
|
rlm@10
|
39 (binding [*print-level* (and (not *print-dup*) *print-level* (dec *print-level*))]
|
|
rlm@10
|
40 (if (and *print-level* (neg? *print-level*))
|
|
rlm@10
|
41 (.write w "#")
|
|
rlm@10
|
42 (do
|
|
rlm@10
|
43 (.write w begin)
|
|
rlm@10
|
44 (when-let [xs (seq sequence)]
|
|
rlm@10
|
45 (if (and (not *print-dup*) *print-length*)
|
|
rlm@10
|
46 (loop [[x & xs] xs
|
|
rlm@10
|
47 print-length *print-length*]
|
|
rlm@10
|
48 (if (zero? print-length)
|
|
rlm@10
|
49 (.write w "...")
|
|
rlm@10
|
50 (do
|
|
rlm@10
|
51 (print-one x w)
|
|
rlm@10
|
52 (when xs
|
|
rlm@10
|
53 (.write w sep)
|
|
rlm@10
|
54 (recur xs (dec print-length))))))
|
|
rlm@10
|
55 (loop [[x & xs] xs]
|
|
rlm@10
|
56 (print-one x w)
|
|
rlm@10
|
57 (when xs
|
|
rlm@10
|
58 (.write w sep)
|
|
rlm@10
|
59 (recur xs)))))
|
|
rlm@10
|
60 (.write w end)))))
|
|
rlm@10
|
61
|
|
rlm@10
|
62 (defn- print-meta [o, ^Writer w]
|
|
rlm@10
|
63 (when-let [m (meta o)]
|
|
rlm@10
|
64 (when (and (pos? (count m))
|
|
rlm@10
|
65 (or *print-dup*
|
|
rlm@10
|
66 (and *print-meta* *print-readably*)))
|
|
rlm@10
|
67 (.write w "^")
|
|
rlm@10
|
68 (if (and (= (count m) 1) (:tag m))
|
|
rlm@10
|
69 (pr-on (:tag m) w)
|
|
rlm@10
|
70 (pr-on m w))
|
|
rlm@10
|
71 (.write w " "))))
|
|
rlm@10
|
72
|
|
rlm@10
|
73 (defmethod print-method :default [o, ^Writer w]
|
|
rlm@10
|
74 (print-method (vary-meta o #(dissoc % :type)) w))
|
|
rlm@10
|
75
|
|
rlm@10
|
76 (defmethod print-method nil [o, ^Writer w]
|
|
rlm@10
|
77 (.write w "nil"))
|
|
rlm@10
|
78
|
|
rlm@10
|
79 (defmethod print-dup nil [o w] (print-method o w))
|
|
rlm@10
|
80
|
|
rlm@10
|
81 (defn print-ctor [o print-args ^Writer w]
|
|
rlm@10
|
82 (.write w "#=(")
|
|
rlm@10
|
83 (.write w (.getName ^Class (class o)))
|
|
rlm@10
|
84 (.write w ". ")
|
|
rlm@10
|
85 (print-args o w)
|
|
rlm@10
|
86 (.write w ")"))
|
|
rlm@10
|
87
|
|
rlm@10
|
88 (defmethod print-method Object [o, ^Writer w]
|
|
rlm@10
|
89 (.write w "#<")
|
|
rlm@10
|
90 (.write w (.getSimpleName (class o)))
|
|
rlm@10
|
91 (.write w " ")
|
|
rlm@10
|
92 (.write w (str o))
|
|
rlm@10
|
93 (.write w ">"))
|
|
rlm@10
|
94
|
|
rlm@10
|
95 (defmethod print-method clojure.lang.Keyword [o, ^Writer w]
|
|
rlm@10
|
96 (.write w (str o)))
|
|
rlm@10
|
97
|
|
rlm@10
|
98 (defmethod print-dup clojure.lang.Keyword [o w] (print-method o w))
|
|
rlm@10
|
99
|
|
rlm@10
|
100 (defmethod print-method Number [o, ^Writer w]
|
|
rlm@10
|
101 (.write w (str o)))
|
|
rlm@10
|
102
|
|
rlm@10
|
103 (defmethod print-dup Number [o, ^Writer w]
|
|
rlm@10
|
104 (print-ctor o
|
|
rlm@10
|
105 (fn [o w]
|
|
rlm@10
|
106 (print-dup (str o) w))
|
|
rlm@10
|
107 w))
|
|
rlm@10
|
108
|
|
rlm@10
|
109 (defmethod print-dup clojure.lang.Fn [o, ^Writer w]
|
|
rlm@10
|
110 (print-ctor o (fn [o w]) w))
|
|
rlm@10
|
111
|
|
rlm@10
|
112 (prefer-method print-dup clojure.lang.IPersistentCollection clojure.lang.Fn)
|
|
rlm@10
|
113 (prefer-method print-dup java.util.Map clojure.lang.Fn)
|
|
rlm@10
|
114 (prefer-method print-dup java.util.Collection clojure.lang.Fn)
|
|
rlm@10
|
115
|
|
rlm@10
|
116 (defmethod print-method Boolean [o, ^Writer w]
|
|
rlm@10
|
117 (.write w (str o)))
|
|
rlm@10
|
118
|
|
rlm@10
|
119 (defmethod print-dup Boolean [o w] (print-method o w))
|
|
rlm@10
|
120
|
|
rlm@10
|
121 (defn print-simple [o, ^Writer w]
|
|
rlm@10
|
122 (print-meta o w)
|
|
rlm@10
|
123 (.write w (str o)))
|
|
rlm@10
|
124
|
|
rlm@10
|
125 (defmethod print-method clojure.lang.Symbol [o, ^Writer w]
|
|
rlm@10
|
126 (print-simple o w))
|
|
rlm@10
|
127
|
|
rlm@10
|
128 (defmethod print-dup clojure.lang.Symbol [o w] (print-method o w))
|
|
rlm@10
|
129
|
|
rlm@10
|
130 (defmethod print-method clojure.lang.Var [o, ^Writer w]
|
|
rlm@10
|
131 (print-simple o w))
|
|
rlm@10
|
132
|
|
rlm@10
|
133 (defmethod print-dup clojure.lang.Var [^clojure.lang.Var o, ^Writer w]
|
|
rlm@10
|
134 (.write w (str "#=(var " (.name (.ns o)) "/" (.sym o) ")")))
|
|
rlm@10
|
135
|
|
rlm@10
|
136 (defmethod print-method clojure.lang.ISeq [o, ^Writer w]
|
|
rlm@10
|
137 (print-meta o w)
|
|
rlm@10
|
138 (print-sequential "(" pr-on " " ")" o w))
|
|
rlm@10
|
139
|
|
rlm@10
|
140 (defmethod print-dup clojure.lang.ISeq [o w] (print-method o w))
|
|
rlm@10
|
141 (defmethod print-dup clojure.lang.IPersistentList [o w] (print-method o w))
|
|
rlm@10
|
142 (prefer-method print-method clojure.lang.ISeq clojure.lang.IPersistentCollection)
|
|
rlm@10
|
143 (prefer-method print-dup clojure.lang.ISeq clojure.lang.IPersistentCollection)
|
|
rlm@10
|
144 (prefer-method print-method clojure.lang.ISeq java.util.Collection)
|
|
rlm@10
|
145 (prefer-method print-dup clojure.lang.ISeq java.util.Collection)
|
|
rlm@10
|
146
|
|
rlm@10
|
147
|
|
rlm@10
|
148
|
|
rlm@10
|
149 (defmethod print-dup java.util.Collection [o, ^Writer w]
|
|
rlm@10
|
150 (print-ctor o #(print-sequential "[" print-dup " " "]" %1 %2) w))
|
|
rlm@10
|
151
|
|
rlm@10
|
152 (defmethod print-dup clojure.lang.IPersistentCollection [o, ^Writer w]
|
|
rlm@10
|
153 (print-meta o w)
|
|
rlm@10
|
154 (.write w "#=(")
|
|
rlm@10
|
155 (.write w (.getName ^Class (class o)))
|
|
rlm@10
|
156 (.write w "/create ")
|
|
rlm@10
|
157 (print-sequential "[" print-dup " " "]" o w)
|
|
rlm@10
|
158 (.write w ")"))
|
|
rlm@10
|
159
|
|
rlm@10
|
160 (prefer-method print-dup clojure.lang.IPersistentCollection java.util.Collection)
|
|
rlm@10
|
161
|
|
rlm@10
|
162 (def ^{:tag String
|
|
rlm@10
|
163 :doc "Returns escape string for char or nil if none"
|
|
rlm@10
|
164 :added "1.0"}
|
|
rlm@10
|
165 char-escape-string
|
|
rlm@10
|
166 {\newline "\\n"
|
|
rlm@10
|
167 \tab "\\t"
|
|
rlm@10
|
168 \return "\\r"
|
|
rlm@10
|
169 \" "\\\""
|
|
rlm@10
|
170 \\ "\\\\"
|
|
rlm@10
|
171 \formfeed "\\f"
|
|
rlm@10
|
172 \backspace "\\b"})
|
|
rlm@10
|
173
|
|
rlm@10
|
174 (defmethod print-method String [^String s, ^Writer w]
|
|
rlm@10
|
175 (if (or *print-dup* *print-readably*)
|
|
rlm@10
|
176 (do (.append w \")
|
|
rlm@10
|
177 (dotimes [n (count s)]
|
|
rlm@10
|
178 (let [c (.charAt s n)
|
|
rlm@10
|
179 e (char-escape-string c)]
|
|
rlm@10
|
180 (if e (.write w e) (.append w c))))
|
|
rlm@10
|
181 (.append w \"))
|
|
rlm@10
|
182 (.write w s))
|
|
rlm@10
|
183 nil)
|
|
rlm@10
|
184
|
|
rlm@10
|
185 (defmethod print-dup String [s w] (print-method s w))
|
|
rlm@10
|
186
|
|
rlm@10
|
187 (defmethod print-method clojure.lang.IPersistentVector [v, ^Writer w]
|
|
rlm@10
|
188 (print-meta v w)
|
|
rlm@10
|
189 (print-sequential "[" pr-on " " "]" v w))
|
|
rlm@10
|
190
|
|
rlm@10
|
191 (defn- print-map [m print-one w]
|
|
rlm@10
|
192 (print-sequential
|
|
rlm@10
|
193 "{"
|
|
rlm@10
|
194 (fn [e ^Writer w]
|
|
rlm@10
|
195 (do (print-one (key e) w) (.append w \space) (print-one (val e) w)))
|
|
rlm@10
|
196 ", "
|
|
rlm@10
|
197 "}"
|
|
rlm@10
|
198 (seq m) w))
|
|
rlm@10
|
199
|
|
rlm@10
|
200 (defmethod print-method clojure.lang.IPersistentMap [m, ^Writer w]
|
|
rlm@10
|
201 (print-meta m w)
|
|
rlm@10
|
202 (print-map m pr-on w))
|
|
rlm@10
|
203
|
|
rlm@10
|
204 (defmethod print-dup java.util.Map [m, ^Writer w]
|
|
rlm@10
|
205 (print-ctor m #(print-map (seq %1) print-dup %2) w))
|
|
rlm@10
|
206
|
|
rlm@10
|
207 (defmethod print-dup clojure.lang.IPersistentMap [m, ^Writer w]
|
|
rlm@10
|
208 (print-meta m w)
|
|
rlm@10
|
209 (.write w "#=(")
|
|
rlm@10
|
210 (.write w (.getName (class m)))
|
|
rlm@10
|
211 (.write w "/create ")
|
|
rlm@10
|
212 (print-map m print-dup w)
|
|
rlm@10
|
213 (.write w ")"))
|
|
rlm@10
|
214
|
|
rlm@10
|
215 (prefer-method print-dup clojure.lang.IPersistentCollection java.util.Map)
|
|
rlm@10
|
216
|
|
rlm@10
|
217 (defmethod print-method clojure.lang.IPersistentSet [s, ^Writer w]
|
|
rlm@10
|
218 (print-meta s w)
|
|
rlm@10
|
219 (print-sequential "#{" pr-on " " "}" (seq s) w))
|
|
rlm@10
|
220
|
|
rlm@10
|
221 (def ^{:tag String
|
|
rlm@10
|
222 :doc "Returns name string for char or nil if none"
|
|
rlm@10
|
223 :added "1.0"}
|
|
rlm@10
|
224 char-name-string
|
|
rlm@10
|
225 {\newline "newline"
|
|
rlm@10
|
226 \tab "tab"
|
|
rlm@10
|
227 \space "space"
|
|
rlm@10
|
228 \backspace "backspace"
|
|
rlm@10
|
229 \formfeed "formfeed"
|
|
rlm@10
|
230 \return "return"})
|
|
rlm@10
|
231
|
|
rlm@10
|
232 (defmethod print-method java.lang.Character [^Character c, ^Writer w]
|
|
rlm@10
|
233 (if (or *print-dup* *print-readably*)
|
|
rlm@10
|
234 (do (.append w \\)
|
|
rlm@10
|
235 (let [n (char-name-string c)]
|
|
rlm@10
|
236 (if n (.write w n) (.append w c))))
|
|
rlm@10
|
237 (.append w c))
|
|
rlm@10
|
238 nil)
|
|
rlm@10
|
239
|
|
rlm@10
|
240 (defmethod print-dup java.lang.Character [c w] (print-method c w))
|
|
rlm@10
|
241 (defmethod print-dup java.lang.Integer [o w] (print-method o w))
|
|
rlm@10
|
242 (defmethod print-dup java.lang.Double [o w] (print-method o w))
|
|
rlm@10
|
243 (defmethod print-dup clojure.lang.Ratio [o w] (print-method o w))
|
|
rlm@10
|
244 (defmethod print-dup java.math.BigDecimal [o w] (print-method o w))
|
|
rlm@10
|
245 (defmethod print-dup clojure.lang.PersistentHashMap [o w] (print-method o w))
|
|
rlm@10
|
246 (defmethod print-dup clojure.lang.PersistentHashSet [o w] (print-method o w))
|
|
rlm@10
|
247 (defmethod print-dup clojure.lang.PersistentVector [o w] (print-method o w))
|
|
rlm@10
|
248 (defmethod print-dup clojure.lang.LazilyPersistentVector [o w] (print-method o w))
|
|
rlm@10
|
249
|
|
rlm@10
|
250 (def primitives-classnames
|
|
rlm@10
|
251 {Float/TYPE "Float/TYPE"
|
|
rlm@10
|
252 Integer/TYPE "Integer/TYPE"
|
|
rlm@10
|
253 Long/TYPE "Long/TYPE"
|
|
rlm@10
|
254 Boolean/TYPE "Boolean/TYPE"
|
|
rlm@10
|
255 Character/TYPE "Character/TYPE"
|
|
rlm@10
|
256 Double/TYPE "Double/TYPE"
|
|
rlm@10
|
257 Byte/TYPE "Byte/TYPE"
|
|
rlm@10
|
258 Short/TYPE "Short/TYPE"})
|
|
rlm@10
|
259
|
|
rlm@10
|
260 (defmethod print-method Class [^Class c, ^Writer w]
|
|
rlm@10
|
261 (.write w (.getName c)))
|
|
rlm@10
|
262
|
|
rlm@10
|
263 (defmethod print-dup Class [^Class c, ^Writer w]
|
|
rlm@10
|
264 (cond
|
|
rlm@10
|
265 (.isPrimitive c) (do
|
|
rlm@10
|
266 (.write w "#=(identity ")
|
|
rlm@10
|
267 (.write w ^String (primitives-classnames c))
|
|
rlm@10
|
268 (.write w ")"))
|
|
rlm@10
|
269 (.isArray c) (do
|
|
rlm@10
|
270 (.write w "#=(java.lang.Class/forName \"")
|
|
rlm@10
|
271 (.write w (.getName c))
|
|
rlm@10
|
272 (.write w "\")"))
|
|
rlm@10
|
273 :else (do
|
|
rlm@10
|
274 (.write w "#=")
|
|
rlm@10
|
275 (.write w (.getName c)))))
|
|
rlm@10
|
276
|
|
rlm@10
|
277 (defmethod print-method java.math.BigDecimal [b, ^Writer w]
|
|
rlm@10
|
278 (.write w (str b))
|
|
rlm@10
|
279 (.write w "M"))
|
|
rlm@10
|
280
|
|
rlm@10
|
281 (defmethod print-method java.util.regex.Pattern [p ^Writer w]
|
|
rlm@10
|
282 (.write w "#\"")
|
|
rlm@10
|
283 (loop [[^Character c & r :as s] (seq (.pattern ^java.util.regex.Pattern p))
|
|
rlm@10
|
284 qmode false]
|
|
rlm@10
|
285 (when s
|
|
rlm@10
|
286 (cond
|
|
rlm@10
|
287 (= c \\) (let [[^Character c2 & r2] r]
|
|
rlm@10
|
288 (.append w \\)
|
|
rlm@10
|
289 (.append w c2)
|
|
rlm@10
|
290 (if qmode
|
|
rlm@10
|
291 (recur r2 (not= c2 \E))
|
|
rlm@10
|
292 (recur r2 (= c2 \Q))))
|
|
rlm@10
|
293 (= c \") (do
|
|
rlm@10
|
294 (if qmode
|
|
rlm@10
|
295 (.write w "\\E\\\"\\Q")
|
|
rlm@10
|
296 (.write w "\\\""))
|
|
rlm@10
|
297 (recur r qmode))
|
|
rlm@10
|
298 :else (do
|
|
rlm@10
|
299 (.append w c)
|
|
rlm@10
|
300 (recur r qmode)))))
|
|
rlm@10
|
301 (.append w \"))
|
|
rlm@10
|
302
|
|
rlm@10
|
303 (defmethod print-dup java.util.regex.Pattern [p ^Writer w] (print-method p w))
|
|
rlm@10
|
304
|
|
rlm@10
|
305 (defmethod print-dup clojure.lang.Namespace [^clojure.lang.Namespace n ^Writer w]
|
|
rlm@10
|
306 (.write w "#=(find-ns ")
|
|
rlm@10
|
307 (print-dup (.name n) w)
|
|
rlm@10
|
308 (.write w ")"))
|
|
rlm@10
|
309
|
|
rlm@10
|
310 (defmethod print-method clojure.lang.IDeref [o ^Writer w]
|
|
rlm@10
|
311 (print-sequential (format "#<%s@%x%s: "
|
|
rlm@10
|
312 (.getSimpleName (class o))
|
|
rlm@10
|
313 (System/identityHashCode o)
|
|
rlm@10
|
314 (if (and (instance? clojure.lang.Agent o)
|
|
rlm@10
|
315 (agent-error o))
|
|
rlm@10
|
316 " FAILED"
|
|
rlm@10
|
317 ""))
|
|
rlm@10
|
318 pr-on, "", ">", (list (if (and (future? o) (not (future-done? o))) :pending @o)), w))
|
|
rlm@10
|
319
|
|
rlm@10
|
320 (def ^{:private true} print-initialized true)
|
