Mercurial > lasercutter

comparison src/clojure/core_print.clj @ 10:ef7dbbd6452c

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