|
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 (ns clojure.core)
|
|
rlm@10
|
10
|
|
rlm@10
|
11 (def unquote)
|
|
rlm@10
|
12 (def unquote-splicing)
|
|
rlm@10
|
13
|
|
rlm@10
|
14 (def
|
|
rlm@10
|
15 ^{:arglists '([& items])
|
|
rlm@10
|
16 :doc "Creates a new list containing the items."
|
|
rlm@10
|
17 :added "1.0"}
|
|
rlm@10
|
18 list (. clojure.lang.PersistentList creator))
|
|
rlm@10
|
19
|
|
rlm@10
|
20 (def
|
|
rlm@10
|
21 ^{:arglists '([x seq])
|
|
rlm@10
|
22 :doc "Returns a new seq where x is the first element and seq is
|
|
rlm@10
|
23 the rest."
|
|
rlm@10
|
24 :added "1.0"}
|
|
rlm@10
|
25
|
|
rlm@10
|
26 cons (fn* cons [x seq] (. clojure.lang.RT (cons x seq))))
|
|
rlm@10
|
27
|
|
rlm@10
|
28 ;during bootstrap we don't have destructuring let, loop or fn, will redefine later
|
|
rlm@10
|
29 (def
|
|
rlm@10
|
30 ^{:macro true
|
|
rlm@10
|
31 :added "1.0"}
|
|
rlm@10
|
32 let (fn* let [&form &env & decl] (cons 'let* decl)))
|
|
rlm@10
|
33
|
|
rlm@10
|
34 (def
|
|
rlm@10
|
35 ^{:macro true
|
|
rlm@10
|
36 :added "1.0"}
|
|
rlm@10
|
37 loop (fn* loop [&form &env & decl] (cons 'loop* decl)))
|
|
rlm@10
|
38
|
|
rlm@10
|
39 (def
|
|
rlm@10
|
40 ^{:macro true
|
|
rlm@10
|
41 :added "1.0"}
|
|
rlm@10
|
42 fn (fn* fn [&form &env & decl]
|
|
rlm@10
|
43 (.withMeta ^clojure.lang.IObj (cons 'fn* decl)
|
|
rlm@10
|
44 (.meta ^clojure.lang.IMeta &form))))
|
|
rlm@10
|
45
|
|
rlm@10
|
46 (def
|
|
rlm@10
|
47 ^{:arglists '([coll])
|
|
rlm@10
|
48 :doc "Returns the first item in the collection. Calls seq on its
|
|
rlm@10
|
49 argument. If coll is nil, returns nil."
|
|
rlm@10
|
50 :added "1.0"}
|
|
rlm@10
|
51 first (fn first [coll] (. clojure.lang.RT (first coll))))
|
|
rlm@10
|
52
|
|
rlm@10
|
53 (def
|
|
rlm@10
|
54 ^{:arglists '([coll])
|
|
rlm@10
|
55 :tag clojure.lang.ISeq
|
|
rlm@10
|
56 :doc "Returns a seq of the items after the first. Calls seq on its
|
|
rlm@10
|
57 argument. If there are no more items, returns nil."
|
|
rlm@10
|
58 :added "1.0"}
|
|
rlm@10
|
59 next (fn next [x] (. clojure.lang.RT (next x))))
|
|
rlm@10
|
60
|
|
rlm@10
|
61 (def
|
|
rlm@10
|
62 ^{:arglists '([coll])
|
|
rlm@10
|
63 :tag clojure.lang.ISeq
|
|
rlm@10
|
64 :doc "Returns a possibly empty seq of the items after the first. Calls seq on its
|
|
rlm@10
|
65 argument."
|
|
rlm@10
|
66 :added "1.0"}
|
|
rlm@10
|
67 rest (fn rest [x] (. clojure.lang.RT (more x))))
|
|
rlm@10
|
68
|
|
rlm@10
|
69 (def
|
|
rlm@10
|
70 ^{:arglists '([coll x] [coll x & xs])
|
|
rlm@10
|
71 :doc "conj[oin]. Returns a new collection with the xs
|
|
rlm@10
|
72 'added'. (conj nil item) returns (item). The 'addition' may
|
|
rlm@10
|
73 happen at different 'places' depending on the concrete type."
|
|
rlm@10
|
74 :added "1.0"}
|
|
rlm@10
|
75 conj (fn conj
|
|
rlm@10
|
76 ([coll x] (. clojure.lang.RT (conj coll x)))
|
|
rlm@10
|
77 ([coll x & xs]
|
|
rlm@10
|
78 (if xs
|
|
rlm@10
|
79 (recur (conj coll x) (first xs) (next xs))
|
|
rlm@10
|
80 (conj coll x)))))
|
|
rlm@10
|
81
|
|
rlm@10
|
82 (def
|
|
rlm@10
|
83 ^{:doc "Same as (first (next x))"
|
|
rlm@10
|
84 :arglists '([x])
|
|
rlm@10
|
85 :added "1.0"}
|
|
rlm@10
|
86 second (fn second [x] (first (next x))))
|
|
rlm@10
|
87
|
|
rlm@10
|
88 (def
|
|
rlm@10
|
89 ^{:doc "Same as (first (first x))"
|
|
rlm@10
|
90 :arglists '([x])
|
|
rlm@10
|
91 :added "1.0"}
|
|
rlm@10
|
92 ffirst (fn ffirst [x] (first (first x))))
|
|
rlm@10
|
93
|
|
rlm@10
|
94 (def
|
|
rlm@10
|
95 ^{:doc "Same as (next (first x))"
|
|
rlm@10
|
96 :arglists '([x])
|
|
rlm@10
|
97 :added "1.0"}
|
|
rlm@10
|
98 nfirst (fn nfirst [x] (next (first x))))
|
|
rlm@10
|
99
|
|
rlm@10
|
100 (def
|
|
rlm@10
|
101 ^{:doc "Same as (first (next x))"
|
|
rlm@10
|
102 :arglists '([x])
|
|
rlm@10
|
103 :added "1.0"}
|
|
rlm@10
|
104 fnext (fn fnext [x] (first (next x))))
|
|
rlm@10
|
105
|
|
rlm@10
|
106 (def
|
|
rlm@10
|
107 ^{:doc "Same as (next (next x))"
|
|
rlm@10
|
108 :arglists '([x])
|
|
rlm@10
|
109 :added "1.0"}
|
|
rlm@10
|
110 nnext (fn nnext [x] (next (next x))))
|
|
rlm@10
|
111
|
|
rlm@10
|
112 (def
|
|
rlm@10
|
113 ^{:arglists '([coll])
|
|
rlm@10
|
114 :doc "Returns a seq on the collection. If the collection is
|
|
rlm@10
|
115 empty, returns nil. (seq nil) returns nil. seq also works on
|
|
rlm@10
|
116 Strings, native Java arrays (of reference types) and any objects
|
|
rlm@10
|
117 that implement Iterable."
|
|
rlm@10
|
118 :tag clojure.lang.ISeq
|
|
rlm@10
|
119 :added "1.0"}
|
|
rlm@10
|
120 seq (fn seq [coll] (. clojure.lang.RT (seq coll))))
|
|
rlm@10
|
121
|
|
rlm@10
|
122 (def
|
|
rlm@10
|
123 ^{:arglists '([^Class c x])
|
|
rlm@10
|
124 :doc "Evaluates x and tests if it is an instance of the class
|
|
rlm@10
|
125 c. Returns true or false"
|
|
rlm@10
|
126 :added "1.0"}
|
|
rlm@10
|
127 instance? (fn instance? [^Class c x] (. c (isInstance x))))
|
|
rlm@10
|
128
|
|
rlm@10
|
129 (def
|
|
rlm@10
|
130 ^{:arglists '([x])
|
|
rlm@10
|
131 :doc "Return true if x implements ISeq"
|
|
rlm@10
|
132 :added "1.0"}
|
|
rlm@10
|
133 seq? (fn seq? [x] (instance? clojure.lang.ISeq x)))
|
|
rlm@10
|
134
|
|
rlm@10
|
135 (def
|
|
rlm@10
|
136 ^{:arglists '([x])
|
|
rlm@10
|
137 :doc "Return true if x is a Character"
|
|
rlm@10
|
138 :added "1.0"}
|
|
rlm@10
|
139 char? (fn char? [x] (instance? Character x)))
|
|
rlm@10
|
140
|
|
rlm@10
|
141 (def
|
|
rlm@10
|
142 ^{:arglists '([x])
|
|
rlm@10
|
143 :doc "Return true if x is a String"
|
|
rlm@10
|
144 :added "1.0"}
|
|
rlm@10
|
145 string? (fn string? [x] (instance? String x)))
|
|
rlm@10
|
146
|
|
rlm@10
|
147 (def
|
|
rlm@10
|
148 ^{:arglists '([x])
|
|
rlm@10
|
149 :doc "Return true if x implements IPersistentMap"
|
|
rlm@10
|
150 :added "1.0"}
|
|
rlm@10
|
151 map? (fn map? [x] (instance? clojure.lang.IPersistentMap x)))
|
|
rlm@10
|
152
|
|
rlm@10
|
153 (def
|
|
rlm@10
|
154 ^{:arglists '([x])
|
|
rlm@10
|
155 :doc "Return true if x implements IPersistentVector"
|
|
rlm@10
|
156 :added "1.0"}
|
|
rlm@10
|
157 vector? (fn vector? [x] (instance? clojure.lang.IPersistentVector x)))
|
|
rlm@10
|
158
|
|
rlm@10
|
159 (def
|
|
rlm@10
|
160 ^{:arglists '([map key val] [map key val & kvs])
|
|
rlm@10
|
161 :doc "assoc[iate]. When applied to a map, returns a new map of the
|
|
rlm@10
|
162 same (hashed/sorted) type, that contains the mapping of key(s) to
|
|
rlm@10
|
163 val(s). When applied to a vector, returns a new vector that
|
|
rlm@10
|
164 contains val at index. Note - index must be <= (count vector)."
|
|
rlm@10
|
165 :added "1.0"}
|
|
rlm@10
|
166 assoc
|
|
rlm@10
|
167 (fn assoc
|
|
rlm@10
|
168 ([map key val] (. clojure.lang.RT (assoc map key val)))
|
|
rlm@10
|
169 ([map key val & kvs]
|
|
rlm@10
|
170 (let [ret (assoc map key val)]
|
|
rlm@10
|
171 (if kvs
|
|
rlm@10
|
172 (recur ret (first kvs) (second kvs) (nnext kvs))
|
|
rlm@10
|
173 ret)))))
|
|
rlm@10
|
174
|
|
rlm@10
|
175 ;;;;;;;;;;;;;;;;; metadata ;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
176 (def
|
|
rlm@10
|
177 ^{:arglists '([obj])
|
|
rlm@10
|
178 :doc "Returns the metadata of obj, returns nil if there is no metadata."
|
|
rlm@10
|
179 :added "1.0"}
|
|
rlm@10
|
180 meta (fn meta [x]
|
|
rlm@10
|
181 (if (instance? clojure.lang.IMeta x)
|
|
rlm@10
|
182 (. ^clojure.lang.IMeta x (meta)))))
|
|
rlm@10
|
183
|
|
rlm@10
|
184 (def
|
|
rlm@10
|
185 ^{:arglists '([^clojure.lang.IObj obj m])
|
|
rlm@10
|
186 :doc "Returns an object of the same type and value as obj, with
|
|
rlm@10
|
187 map m as its metadata."
|
|
rlm@10
|
188 :added "1.0"}
|
|
rlm@10
|
189 with-meta (fn with-meta [^clojure.lang.IObj x m]
|
|
rlm@10
|
190 (. x (withMeta m))))
|
|
rlm@10
|
191
|
|
rlm@10
|
192 (def ^{:private true :dynamic true}
|
|
rlm@10
|
193 assert-valid-fdecl (fn [fdecl]))
|
|
rlm@10
|
194
|
|
rlm@10
|
195 (def
|
|
rlm@10
|
196 ^{:private true}
|
|
rlm@10
|
197 sigs
|
|
rlm@10
|
198 (fn [fdecl]
|
|
rlm@10
|
199 (assert-valid-fdecl fdecl)
|
|
rlm@10
|
200 (let [asig
|
|
rlm@10
|
201 (fn [fdecl]
|
|
rlm@10
|
202 (let [arglist (first fdecl)
|
|
rlm@10
|
203 ;elide implicit macro args
|
|
rlm@10
|
204 arglist (if (clojure.lang.Util/equals '&form (first arglist))
|
|
rlm@10
|
205 (clojure.lang.RT/subvec arglist 2 (clojure.lang.RT/count arglist))
|
|
rlm@10
|
206 arglist)
|
|
rlm@10
|
207 body (next fdecl)]
|
|
rlm@10
|
208 (if (map? (first body))
|
|
rlm@10
|
209 (if (next body)
|
|
rlm@10
|
210 (with-meta arglist (conj (if (meta arglist) (meta arglist) {}) (first body)))
|
|
rlm@10
|
211 arglist)
|
|
rlm@10
|
212 arglist)))]
|
|
rlm@10
|
213 (if (seq? (first fdecl))
|
|
rlm@10
|
214 (loop [ret [] fdecls fdecl]
|
|
rlm@10
|
215 (if fdecls
|
|
rlm@10
|
216 (recur (conj ret (asig (first fdecls))) (next fdecls))
|
|
rlm@10
|
217 (seq ret)))
|
|
rlm@10
|
218 (list (asig fdecl))))))
|
|
rlm@10
|
219
|
|
rlm@10
|
220
|
|
rlm@10
|
221 (def
|
|
rlm@10
|
222 ^{:arglists '([coll])
|
|
rlm@10
|
223 :doc "Return the last item in coll, in linear time"
|
|
rlm@10
|
224 :added "1.0"}
|
|
rlm@10
|
225 last (fn last [s]
|
|
rlm@10
|
226 (if (next s)
|
|
rlm@10
|
227 (recur (next s))
|
|
rlm@10
|
228 (first s))))
|
|
rlm@10
|
229
|
|
rlm@10
|
230 (def
|
|
rlm@10
|
231 ^{:arglists '([coll])
|
|
rlm@10
|
232 :doc "Return a seq of all but the last item in coll, in linear time"
|
|
rlm@10
|
233 :added "1.0"}
|
|
rlm@10
|
234 butlast (fn butlast [s]
|
|
rlm@10
|
235 (loop [ret [] s s]
|
|
rlm@10
|
236 (if (next s)
|
|
rlm@10
|
237 (recur (conj ret (first s)) (next s))
|
|
rlm@10
|
238 (seq ret)))))
|
|
rlm@10
|
239
|
|
rlm@10
|
240 (def
|
|
rlm@10
|
241
|
|
rlm@10
|
242 ^{:doc "Same as (def name (fn [params* ] exprs*)) or (def
|
|
rlm@10
|
243 name (fn ([params* ] exprs*)+)) with any doc-string or attrs added
|
|
rlm@10
|
244 to the var metadata"
|
|
rlm@10
|
245 :arglists '([name doc-string? attr-map? [params*] body]
|
|
rlm@10
|
246 [name doc-string? attr-map? ([params*] body)+ attr-map?])
|
|
rlm@10
|
247 :added "1.0"}
|
|
rlm@10
|
248 defn (fn defn [&form &env name & fdecl]
|
|
rlm@10
|
249 (let [m (if (string? (first fdecl))
|
|
rlm@10
|
250 {:doc (first fdecl)}
|
|
rlm@10
|
251 {})
|
|
rlm@10
|
252 fdecl (if (string? (first fdecl))
|
|
rlm@10
|
253 (next fdecl)
|
|
rlm@10
|
254 fdecl)
|
|
rlm@10
|
255 m (if (map? (first fdecl))
|
|
rlm@10
|
256 (conj m (first fdecl))
|
|
rlm@10
|
257 m)
|
|
rlm@10
|
258 fdecl (if (map? (first fdecl))
|
|
rlm@10
|
259 (next fdecl)
|
|
rlm@10
|
260 fdecl)
|
|
rlm@10
|
261 fdecl (if (vector? (first fdecl))
|
|
rlm@10
|
262 (list fdecl)
|
|
rlm@10
|
263 fdecl)
|
|
rlm@10
|
264 m (if (map? (last fdecl))
|
|
rlm@10
|
265 (conj m (last fdecl))
|
|
rlm@10
|
266 m)
|
|
rlm@10
|
267 fdecl (if (map? (last fdecl))
|
|
rlm@10
|
268 (butlast fdecl)
|
|
rlm@10
|
269 fdecl)
|
|
rlm@10
|
270 m (conj {:arglists (list 'quote (sigs fdecl))} m)
|
|
rlm@10
|
271 m (let [inline (:inline m)
|
|
rlm@10
|
272 ifn (first inline)
|
|
rlm@10
|
273 iname (second inline)]
|
|
rlm@10
|
274 ;; same as: (if (and (= 'fn ifn) (not (symbol? iname))) ...)
|
|
rlm@10
|
275 (if (if (clojure.lang.Util/equiv 'fn ifn)
|
|
rlm@10
|
276 (if (instance? clojure.lang.Symbol iname) false true))
|
|
rlm@10
|
277 ;; inserts the same fn name to the inline fn if it does not have one
|
|
rlm@10
|
278 (assoc m :inline (cons ifn (cons (clojure.lang.Symbol/intern (.concat (.getName name) "__inliner"))
|
|
rlm@10
|
279 (next inline))))
|
|
rlm@10
|
280 m))
|
|
rlm@10
|
281 m (conj (if (meta name) (meta name) {}) m)]
|
|
rlm@10
|
282 (list 'def (with-meta name m)
|
|
rlm@10
|
283 (list '.withMeta (cons `fn (cons name fdecl)) (list '.meta (list 'var name)))))))
|
|
rlm@10
|
284
|
|
rlm@10
|
285 (. (var defn) (setMacro))
|
|
rlm@10
|
286
|
|
rlm@10
|
287 (defn cast
|
|
rlm@10
|
288 "Throws a ClassCastException if x is not a c, else returns x."
|
|
rlm@10
|
289 {:added "1.0"}
|
|
rlm@10
|
290 [^Class c x]
|
|
rlm@10
|
291 (. c (cast x)))
|
|
rlm@10
|
292
|
|
rlm@10
|
293 (defn to-array
|
|
rlm@10
|
294 "Returns an array of Objects containing the contents of coll, which
|
|
rlm@10
|
295 can be any Collection. Maps to java.util.Collection.toArray()."
|
|
rlm@10
|
296 {:tag "[Ljava.lang.Object;"
|
|
rlm@10
|
297 :added "1.0"}
|
|
rlm@10
|
298 [coll] (. clojure.lang.RT (toArray coll)))
|
|
rlm@10
|
299
|
|
rlm@10
|
300 (defn vector
|
|
rlm@10
|
301 "Creates a new vector containing the args."
|
|
rlm@10
|
302 {:added "1.0"}
|
|
rlm@10
|
303 ([] [])
|
|
rlm@10
|
304 ([a] [a])
|
|
rlm@10
|
305 ([a b] [a b])
|
|
rlm@10
|
306 ([a b c] [a b c])
|
|
rlm@10
|
307 ([a b c d] [a b c d])
|
|
rlm@10
|
308 ([a b c d & args]
|
|
rlm@10
|
309 (. clojure.lang.LazilyPersistentVector (create (cons a (cons b (cons c (cons d args))))))))
|
|
rlm@10
|
310
|
|
rlm@10
|
311 (defn vec
|
|
rlm@10
|
312 "Creates a new vector containing the contents of coll."
|
|
rlm@10
|
313 {:added "1.0"}
|
|
rlm@10
|
314 ([coll]
|
|
rlm@10
|
315 (if (instance? java.util.Collection coll)
|
|
rlm@10
|
316 (clojure.lang.LazilyPersistentVector/create coll)
|
|
rlm@10
|
317 (. clojure.lang.LazilyPersistentVector (createOwning (to-array coll))))))
|
|
rlm@10
|
318
|
|
rlm@10
|
319 (defn hash-map
|
|
rlm@10
|
320 "keyval => key val
|
|
rlm@10
|
321 Returns a new hash map with supplied mappings."
|
|
rlm@10
|
322 {:added "1.0"}
|
|
rlm@10
|
323 ([] {})
|
|
rlm@10
|
324 ([& keyvals]
|
|
rlm@10
|
325 (. clojure.lang.PersistentHashMap (createWithCheck keyvals))))
|
|
rlm@10
|
326
|
|
rlm@10
|
327 (defn hash-set
|
|
rlm@10
|
328 "Returns a new hash set with supplied keys."
|
|
rlm@10
|
329 {:added "1.0"}
|
|
rlm@10
|
330 ([] #{})
|
|
rlm@10
|
331 ([& keys]
|
|
rlm@10
|
332 (clojure.lang.PersistentHashSet/createWithCheck keys)))
|
|
rlm@10
|
333
|
|
rlm@10
|
334 (defn sorted-map
|
|
rlm@10
|
335 "keyval => key val
|
|
rlm@10
|
336 Returns a new sorted map with supplied mappings."
|
|
rlm@10
|
337 {:added "1.0"}
|
|
rlm@10
|
338 ([& keyvals]
|
|
rlm@10
|
339 (clojure.lang.PersistentTreeMap/create keyvals)))
|
|
rlm@10
|
340
|
|
rlm@10
|
341 (defn sorted-map-by
|
|
rlm@10
|
342 "keyval => key val
|
|
rlm@10
|
343 Returns a new sorted map with supplied mappings, using the supplied comparator."
|
|
rlm@10
|
344 {:added "1.0"}
|
|
rlm@10
|
345 ([comparator & keyvals]
|
|
rlm@10
|
346 (clojure.lang.PersistentTreeMap/create comparator keyvals)))
|
|
rlm@10
|
347
|
|
rlm@10
|
348 (defn sorted-set
|
|
rlm@10
|
349 "Returns a new sorted set with supplied keys."
|
|
rlm@10
|
350 {:added "1.0"}
|
|
rlm@10
|
351 ([& keys]
|
|
rlm@10
|
352 (clojure.lang.PersistentTreeSet/create keys)))
|
|
rlm@10
|
353
|
|
rlm@10
|
354 (defn sorted-set-by
|
|
rlm@10
|
355 "Returns a new sorted set with supplied keys, using the supplied comparator."
|
|
rlm@10
|
356 {:added "1.1"}
|
|
rlm@10
|
357 ([comparator & keys]
|
|
rlm@10
|
358 (clojure.lang.PersistentTreeSet/create comparator keys)))
|
|
rlm@10
|
359
|
|
rlm@10
|
360
|
|
rlm@10
|
361 ;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
362 (defn nil?
|
|
rlm@10
|
363 "Returns true if x is nil, false otherwise."
|
|
rlm@10
|
364 {:tag Boolean
|
|
rlm@10
|
365 :added "1.0"}
|
|
rlm@10
|
366 [x] (clojure.lang.Util/identical x nil))
|
|
rlm@10
|
367
|
|
rlm@10
|
368 (def
|
|
rlm@10
|
369
|
|
rlm@10
|
370 ^{:doc "Like defn, but the resulting function name is declared as a
|
|
rlm@10
|
371 macro and will be used as a macro by the compiler when it is
|
|
rlm@10
|
372 called."
|
|
rlm@10
|
373 :arglists '([name doc-string? attr-map? [params*] body]
|
|
rlm@10
|
374 [name doc-string? attr-map? ([params*] body)+ attr-map?])
|
|
rlm@10
|
375 :added "1.0"}
|
|
rlm@10
|
376 defmacro (fn [&form &env
|
|
rlm@10
|
377 name & args]
|
|
rlm@10
|
378 (let [prefix (loop [p (list name) args args]
|
|
rlm@10
|
379 (let [f (first args)]
|
|
rlm@10
|
380 (if (string? f)
|
|
rlm@10
|
381 (recur (cons f p) (next args))
|
|
rlm@10
|
382 (if (map? f)
|
|
rlm@10
|
383 (recur (cons f p) (next args))
|
|
rlm@10
|
384 p))))
|
|
rlm@10
|
385 fdecl (loop [fd args]
|
|
rlm@10
|
386 (if (string? (first fd))
|
|
rlm@10
|
387 (recur (next fd))
|
|
rlm@10
|
388 (if (map? (first fd))
|
|
rlm@10
|
389 (recur (next fd))
|
|
rlm@10
|
390 fd)))
|
|
rlm@10
|
391 fdecl (if (vector? (first fdecl))
|
|
rlm@10
|
392 (list fdecl)
|
|
rlm@10
|
393 fdecl)
|
|
rlm@10
|
394 add-implicit-args (fn [fd]
|
|
rlm@10
|
395 (let [args (first fd)]
|
|
rlm@10
|
396 (cons (vec (cons '&form (cons '&env args))) (next fd))))
|
|
rlm@10
|
397 add-args (fn [acc ds]
|
|
rlm@10
|
398 (if (nil? ds)
|
|
rlm@10
|
399 acc
|
|
rlm@10
|
400 (let [d (first ds)]
|
|
rlm@10
|
401 (if (map? d)
|
|
rlm@10
|
402 (conj acc d)
|
|
rlm@10
|
403 (recur (conj acc (add-implicit-args d)) (next ds))))))
|
|
rlm@10
|
404 fdecl (seq (add-args [] fdecl))
|
|
rlm@10
|
405 decl (loop [p prefix d fdecl]
|
|
rlm@10
|
406 (if p
|
|
rlm@10
|
407 (recur (next p) (cons (first p) d))
|
|
rlm@10
|
408 d))]
|
|
rlm@10
|
409 (list 'do
|
|
rlm@10
|
410 (cons `defn decl)
|
|
rlm@10
|
411 (list '. (list 'var name) '(setMacro))
|
|
rlm@10
|
412 (list 'var name)))))
|
|
rlm@10
|
413
|
|
rlm@10
|
414
|
|
rlm@10
|
415 (. (var defmacro) (setMacro))
|
|
rlm@10
|
416
|
|
rlm@10
|
417 (defmacro when
|
|
rlm@10
|
418 "Evaluates test. If logical true, evaluates body in an implicit do."
|
|
rlm@10
|
419 {:added "1.0"}
|
|
rlm@10
|
420 [test & body]
|
|
rlm@10
|
421 (list 'if test (cons 'do body)))
|
|
rlm@10
|
422
|
|
rlm@10
|
423 (defmacro when-not
|
|
rlm@10
|
424 "Evaluates test. If logical false, evaluates body in an implicit do."
|
|
rlm@10
|
425 {:added "1.0"}
|
|
rlm@10
|
426 [test & body]
|
|
rlm@10
|
427 (list 'if test nil (cons 'do body)))
|
|
rlm@10
|
428
|
|
rlm@10
|
429 (defn false?
|
|
rlm@10
|
430 "Returns true if x is the value false, false otherwise."
|
|
rlm@10
|
431 {:tag Boolean,
|
|
rlm@10
|
432 :added "1.0"}
|
|
rlm@10
|
433 [x] (clojure.lang.Util/identical x false))
|
|
rlm@10
|
434
|
|
rlm@10
|
435 (defn true?
|
|
rlm@10
|
436 "Returns true if x is the value true, false otherwise."
|
|
rlm@10
|
437 {:tag Boolean,
|
|
rlm@10
|
438 :added "1.0"}
|
|
rlm@10
|
439 [x] (clojure.lang.Util/identical x true))
|
|
rlm@10
|
440
|
|
rlm@10
|
441 (defn not
|
|
rlm@10
|
442 "Returns true if x is logical false, false otherwise."
|
|
rlm@10
|
443 {:tag Boolean
|
|
rlm@10
|
444 :added "1.0"}
|
|
rlm@10
|
445 [x] (if x false true))
|
|
rlm@10
|
446
|
|
rlm@10
|
447 (defn str
|
|
rlm@10
|
448 "With no args, returns the empty string. With one arg x, returns
|
|
rlm@10
|
449 x.toString(). (str nil) returns the empty string. With more than
|
|
rlm@10
|
450 one arg, returns the concatenation of the str values of the args."
|
|
rlm@10
|
451 {:tag String
|
|
rlm@10
|
452 :added "1.0"}
|
|
rlm@10
|
453 ([] "")
|
|
rlm@10
|
454 ([^Object x]
|
|
rlm@10
|
455 (if (nil? x) "" (. x (toString))))
|
|
rlm@10
|
456 ([x & ys]
|
|
rlm@10
|
457 ((fn [^StringBuilder sb more]
|
|
rlm@10
|
458 (if more
|
|
rlm@10
|
459 (recur (. sb (append (str (first more)))) (next more))
|
|
rlm@10
|
460 (str sb)))
|
|
rlm@10
|
461 (new StringBuilder ^String (str x)) ys)))
|
|
rlm@10
|
462
|
|
rlm@10
|
463
|
|
rlm@10
|
464 (defn symbol?
|
|
rlm@10
|
465 "Return true if x is a Symbol"
|
|
rlm@10
|
466 {:added "1.0"}
|
|
rlm@10
|
467 [x] (instance? clojure.lang.Symbol x))
|
|
rlm@10
|
468
|
|
rlm@10
|
469 (defn keyword?
|
|
rlm@10
|
470 "Return true if x is a Keyword"
|
|
rlm@10
|
471 {:added "1.0"}
|
|
rlm@10
|
472 [x] (instance? clojure.lang.Keyword x))
|
|
rlm@10
|
473
|
|
rlm@10
|
474 (defn symbol
|
|
rlm@10
|
475 "Returns a Symbol with the given namespace and name."
|
|
rlm@10
|
476 {:tag clojure.lang.Symbol
|
|
rlm@10
|
477 :added "1.0"}
|
|
rlm@10
|
478 ([name] (if (symbol? name) name (clojure.lang.Symbol/intern name)))
|
|
rlm@10
|
479 ([ns name] (clojure.lang.Symbol/intern ns name)))
|
|
rlm@10
|
480
|
|
rlm@10
|
481 (defn gensym
|
|
rlm@10
|
482 "Returns a new symbol with a unique name. If a prefix string is
|
|
rlm@10
|
483 supplied, the name is prefix# where # is some unique number. If
|
|
rlm@10
|
484 prefix is not supplied, the prefix is 'G__'."
|
|
rlm@10
|
485 {:added "1.0"}
|
|
rlm@10
|
486 ([] (gensym "G__"))
|
|
rlm@10
|
487 ([prefix-string] (. clojure.lang.Symbol (intern (str prefix-string (str (. clojure.lang.RT (nextID))))))))
|
|
rlm@10
|
488
|
|
rlm@10
|
489 (defmacro cond
|
|
rlm@10
|
490 "Takes a set of test/expr pairs. It evaluates each test one at a
|
|
rlm@10
|
491 time. If a test returns logical true, cond evaluates and returns
|
|
rlm@10
|
492 the value of the corresponding expr and doesn't evaluate any of the
|
|
rlm@10
|
493 other tests or exprs. (cond) returns nil."
|
|
rlm@10
|
494 {:added "1.0"}
|
|
rlm@10
|
495 [& clauses]
|
|
rlm@10
|
496 (when clauses
|
|
rlm@10
|
497 (list 'if (first clauses)
|
|
rlm@10
|
498 (if (next clauses)
|
|
rlm@10
|
499 (second clauses)
|
|
rlm@10
|
500 (throw (IllegalArgumentException.
|
|
rlm@10
|
501 "cond requires an even number of forms")))
|
|
rlm@10
|
502 (cons 'clojure.core/cond (next (next clauses))))))
|
|
rlm@10
|
503
|
|
rlm@10
|
504 (defn keyword
|
|
rlm@10
|
505 "Returns a Keyword with the given namespace and name. Do not use :
|
|
rlm@10
|
506 in the keyword strings, it will be added automatically."
|
|
rlm@10
|
507 {:tag clojure.lang.Keyword
|
|
rlm@10
|
508 :added "1.0"}
|
|
rlm@10
|
509 ([name] (cond (keyword? name) name
|
|
rlm@10
|
510 (symbol? name) (clojure.lang.Keyword/intern ^clojure.lang.Symbol name)
|
|
rlm@10
|
511 (string? name) (clojure.lang.Keyword/intern ^String name)))
|
|
rlm@10
|
512 ([ns name] (clojure.lang.Keyword/intern ns name)))
|
|
rlm@10
|
513
|
|
rlm@10
|
514 (defn spread
|
|
rlm@10
|
515 {:private true}
|
|
rlm@10
|
516 [arglist]
|
|
rlm@10
|
517 (cond
|
|
rlm@10
|
518 (nil? arglist) nil
|
|
rlm@10
|
519 (nil? (next arglist)) (seq (first arglist))
|
|
rlm@10
|
520 :else (cons (first arglist) (spread (next arglist)))))
|
|
rlm@10
|
521
|
|
rlm@10
|
522 (defn list*
|
|
rlm@10
|
523 "Creates a new list containing the items prepended to the rest, the
|
|
rlm@10
|
524 last of which will be treated as a sequence."
|
|
rlm@10
|
525 {:added "1.0"}
|
|
rlm@10
|
526 ([args] (seq args))
|
|
rlm@10
|
527 ([a args] (cons a args))
|
|
rlm@10
|
528 ([a b args] (cons a (cons b args)))
|
|
rlm@10
|
529 ([a b c args] (cons a (cons b (cons c args))))
|
|
rlm@10
|
530 ([a b c d & more]
|
|
rlm@10
|
531 (cons a (cons b (cons c (cons d (spread more)))))))
|
|
rlm@10
|
532
|
|
rlm@10
|
533 (defn apply
|
|
rlm@10
|
534 "Applies fn f to the argument list formed by prepending args to argseq."
|
|
rlm@10
|
535 {:arglists '([f args* argseq])
|
|
rlm@10
|
536 :added "1.0"}
|
|
rlm@10
|
537 ([^clojure.lang.IFn f args]
|
|
rlm@10
|
538 (. f (applyTo (seq args))))
|
|
rlm@10
|
539 ([^clojure.lang.IFn f x args]
|
|
rlm@10
|
540 (. f (applyTo (list* x args))))
|
|
rlm@10
|
541 ([^clojure.lang.IFn f x y args]
|
|
rlm@10
|
542 (. f (applyTo (list* x y args))))
|
|
rlm@10
|
543 ([^clojure.lang.IFn f x y z args]
|
|
rlm@10
|
544 (. f (applyTo (list* x y z args))))
|
|
rlm@10
|
545 ([^clojure.lang.IFn f a b c d & args]
|
|
rlm@10
|
546 (. f (applyTo (cons a (cons b (cons c (cons d (spread args)))))))))
|
|
rlm@10
|
547
|
|
rlm@10
|
548 (defn vary-meta
|
|
rlm@10
|
549 "Returns an object of the same type and value as obj, with
|
|
rlm@10
|
550 (apply f (meta obj) args) as its metadata."
|
|
rlm@10
|
551 {:added "1.0"}
|
|
rlm@10
|
552 [obj f & args]
|
|
rlm@10
|
553 (with-meta obj (apply f (meta obj) args)))
|
|
rlm@10
|
554
|
|
rlm@10
|
555 (defmacro lazy-seq
|
|
rlm@10
|
556 "Takes a body of expressions that returns an ISeq or nil, and yields
|
|
rlm@10
|
557 a Seqable object that will invoke the body only the first time seq
|
|
rlm@10
|
558 is called, and will cache the result and return it on all subsequent
|
|
rlm@10
|
559 seq calls."
|
|
rlm@10
|
560 {:added "1.0"}
|
|
rlm@10
|
561 [& body]
|
|
rlm@10
|
562 (list 'new 'clojure.lang.LazySeq (list* '^{:once true} fn* [] body)))
|
|
rlm@10
|
563
|
|
rlm@10
|
564 (defn ^clojure.lang.ChunkBuffer chunk-buffer [capacity]
|
|
rlm@10
|
565 (clojure.lang.ChunkBuffer. capacity))
|
|
rlm@10
|
566
|
|
rlm@10
|
567 (defn chunk-append [^clojure.lang.ChunkBuffer b x]
|
|
rlm@10
|
568 (.add b x))
|
|
rlm@10
|
569
|
|
rlm@10
|
570 (defn chunk [^clojure.lang.ChunkBuffer b]
|
|
rlm@10
|
571 (.chunk b))
|
|
rlm@10
|
572
|
|
rlm@10
|
573 (defn ^clojure.lang.IChunk chunk-first [^clojure.lang.IChunkedSeq s]
|
|
rlm@10
|
574 (.chunkedFirst s))
|
|
rlm@10
|
575
|
|
rlm@10
|
576 (defn ^clojure.lang.ISeq chunk-rest [^clojure.lang.IChunkedSeq s]
|
|
rlm@10
|
577 (.chunkedMore s))
|
|
rlm@10
|
578
|
|
rlm@10
|
579 (defn ^clojure.lang.ISeq chunk-next [^clojure.lang.IChunkedSeq s]
|
|
rlm@10
|
580 (.chunkedNext s))
|
|
rlm@10
|
581
|
|
rlm@10
|
582 (defn chunk-cons [chunk rest]
|
|
rlm@10
|
583 (if (clojure.lang.Numbers/isZero (clojure.lang.RT/count chunk))
|
|
rlm@10
|
584 rest
|
|
rlm@10
|
585 (clojure.lang.ChunkedCons. chunk rest)))
|
|
rlm@10
|
586
|
|
rlm@10
|
587 (defn chunked-seq? [s]
|
|
rlm@10
|
588 (instance? clojure.lang.IChunkedSeq s))
|
|
rlm@10
|
589
|
|
rlm@10
|
590 (defn concat
|
|
rlm@10
|
591 "Returns a lazy seq representing the concatenation of the elements in the supplied colls."
|
|
rlm@10
|
592 {:added "1.0"}
|
|
rlm@10
|
593 ([] (lazy-seq nil))
|
|
rlm@10
|
594 ([x] (lazy-seq x))
|
|
rlm@10
|
595 ([x y]
|
|
rlm@10
|
596 (lazy-seq
|
|
rlm@10
|
597 (let [s (seq x)]
|
|
rlm@10
|
598 (if s
|
|
rlm@10
|
599 (if (chunked-seq? s)
|
|
rlm@10
|
600 (chunk-cons (chunk-first s) (concat (chunk-rest s) y))
|
|
rlm@10
|
601 (cons (first s) (concat (rest s) y)))
|
|
rlm@10
|
602 y))))
|
|
rlm@10
|
603 ([x y & zs]
|
|
rlm@10
|
604 (let [cat (fn cat [xys zs]
|
|
rlm@10
|
605 (lazy-seq
|
|
rlm@10
|
606 (let [xys (seq xys)]
|
|
rlm@10
|
607 (if xys
|
|
rlm@10
|
608 (if (chunked-seq? xys)
|
|
rlm@10
|
609 (chunk-cons (chunk-first xys)
|
|
rlm@10
|
610 (cat (chunk-rest xys) zs))
|
|
rlm@10
|
611 (cons (first xys) (cat (rest xys) zs)))
|
|
rlm@10
|
612 (when zs
|
|
rlm@10
|
613 (cat (first zs) (next zs)))))))]
|
|
rlm@10
|
614 (cat (concat x y) zs))))
|
|
rlm@10
|
615
|
|
rlm@10
|
616 ;;;;;;;;;;;;;;;;at this point all the support for syntax-quote exists;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
617 (defmacro delay
|
|
rlm@10
|
618 "Takes a body of expressions and yields a Delay object that will
|
|
rlm@10
|
619 invoke the body only the first time it is forced (with force or deref/@), and
|
|
rlm@10
|
620 will cache the result and return it on all subsequent force
|
|
rlm@10
|
621 calls."
|
|
rlm@10
|
622 {:added "1.0"}
|
|
rlm@10
|
623 [& body]
|
|
rlm@10
|
624 (list 'new 'clojure.lang.Delay (list* `^{:once true} fn* [] body)))
|
|
rlm@10
|
625
|
|
rlm@10
|
626 (defn delay?
|
|
rlm@10
|
627 "returns true if x is a Delay created with delay"
|
|
rlm@10
|
628 {:added "1.0"}
|
|
rlm@10
|
629 [x] (instance? clojure.lang.Delay x))
|
|
rlm@10
|
630
|
|
rlm@10
|
631 (defn force
|
|
rlm@10
|
632 "If x is a Delay, returns the (possibly cached) value of its expression, else returns x"
|
|
rlm@10
|
633 {:added "1.0"}
|
|
rlm@10
|
634 [x] (. clojure.lang.Delay (force x)))
|
|
rlm@10
|
635
|
|
rlm@10
|
636 (defmacro if-not
|
|
rlm@10
|
637 "Evaluates test. If logical false, evaluates and returns then expr,
|
|
rlm@10
|
638 otherwise else expr, if supplied, else nil."
|
|
rlm@10
|
639 {:added "1.0"}
|
|
rlm@10
|
640 ([test then] `(if-not ~test ~then nil))
|
|
rlm@10
|
641 ([test then else]
|
|
rlm@10
|
642 `(if (not ~test) ~then ~else)))
|
|
rlm@10
|
643
|
|
rlm@10
|
644 (defn identical?
|
|
rlm@10
|
645 "Tests if 2 arguments are the same object"
|
|
rlm@10
|
646 {:inline (fn [x y] `(. clojure.lang.Util identical ~x ~y))
|
|
rlm@10
|
647 :inline-arities #{2}
|
|
rlm@10
|
648 :added "1.0"}
|
|
rlm@10
|
649 ([x y] (clojure.lang.Util/identical x y)))
|
|
rlm@10
|
650
|
|
rlm@10
|
651 (defn =
|
|
rlm@10
|
652 "Equality. Returns true if x equals y, false if not. Same as
|
|
rlm@10
|
653 Java x.equals(y) except it also works for nil, and compares
|
|
rlm@10
|
654 numbers and collections in a type-independent manner. Clojure's immutable data
|
|
rlm@10
|
655 structures define equals() (and thus =) as a value, not an identity,
|
|
rlm@10
|
656 comparison."
|
|
rlm@10
|
657 {:inline (fn [x y] `(. clojure.lang.Util equiv ~x ~y))
|
|
rlm@10
|
658 :inline-arities #{2}
|
|
rlm@10
|
659 :added "1.0"}
|
|
rlm@10
|
660 ([x] true)
|
|
rlm@10
|
661 ([x y] (clojure.lang.Util/equiv x y))
|
|
rlm@10
|
662 ([x y & more]
|
|
rlm@10
|
663 (if (= x y)
|
|
rlm@10
|
664 (if (next more)
|
|
rlm@10
|
665 (recur y (first more) (next more))
|
|
rlm@10
|
666 (= y (first more)))
|
|
rlm@10
|
667 false)))
|
|
rlm@10
|
668
|
|
rlm@10
|
669 (defn not=
|
|
rlm@10
|
670 "Same as (not (= obj1 obj2))"
|
|
rlm@10
|
671 {:tag Boolean
|
|
rlm@10
|
672 :added "1.0"}
|
|
rlm@10
|
673 ([x] false)
|
|
rlm@10
|
674 ([x y] (not (= x y)))
|
|
rlm@10
|
675 ([x y & more]
|
|
rlm@10
|
676 (not (apply = x y more))))
|
|
rlm@10
|
677
|
|
rlm@10
|
678
|
|
rlm@10
|
679
|
|
rlm@10
|
680 (defn compare
|
|
rlm@10
|
681 "Comparator. Returns a negative number, zero, or a positive number
|
|
rlm@10
|
682 when x is logically 'less than', 'equal to', or 'greater than'
|
|
rlm@10
|
683 y. Same as Java x.compareTo(y) except it also works for nil, and
|
|
rlm@10
|
684 compares numbers and collections in a type-independent manner. x
|
|
rlm@10
|
685 must implement Comparable"
|
|
rlm@10
|
686 {
|
|
rlm@10
|
687 :inline (fn [x y] `(. clojure.lang.Util compare ~x ~y))
|
|
rlm@10
|
688 :added "1.0"}
|
|
rlm@10
|
689 [x y] (. clojure.lang.Util (compare x y)))
|
|
rlm@10
|
690
|
|
rlm@10
|
691 (defmacro and
|
|
rlm@10
|
692 "Evaluates exprs one at a time, from left to right. If a form
|
|
rlm@10
|
693 returns logical false (nil or false), and returns that value and
|
|
rlm@10
|
694 doesn't evaluate any of the other expressions, otherwise it returns
|
|
rlm@10
|
695 the value of the last expr. (and) returns true."
|
|
rlm@10
|
696 {:added "1.0"}
|
|
rlm@10
|
697 ([] true)
|
|
rlm@10
|
698 ([x] x)
|
|
rlm@10
|
699 ([x & next]
|
|
rlm@10
|
700 `(let [and# ~x]
|
|
rlm@10
|
701 (if and# (and ~@next) and#))))
|
|
rlm@10
|
702
|
|
rlm@10
|
703 (defmacro or
|
|
rlm@10
|
704 "Evaluates exprs one at a time, from left to right. If a form
|
|
rlm@10
|
705 returns a logical true value, or returns that value and doesn't
|
|
rlm@10
|
706 evaluate any of the other expressions, otherwise it returns the
|
|
rlm@10
|
707 value of the last expression. (or) returns nil."
|
|
rlm@10
|
708 {:added "1.0"}
|
|
rlm@10
|
709 ([] nil)
|
|
rlm@10
|
710 ([x] x)
|
|
rlm@10
|
711 ([x & next]
|
|
rlm@10
|
712 `(let [or# ~x]
|
|
rlm@10
|
713 (if or# or# (or ~@next)))))
|
|
rlm@10
|
714
|
|
rlm@10
|
715 ;;;;;;;;;;;;;;;;;;; sequence fns ;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
716 (defn zero?
|
|
rlm@10
|
717 "Returns true if num is zero, else false"
|
|
rlm@10
|
718 {
|
|
rlm@10
|
719 :inline (fn [x] `(. clojure.lang.Numbers (isZero ~x)))
|
|
rlm@10
|
720 :added "1.0"}
|
|
rlm@10
|
721 [x] (. clojure.lang.Numbers (isZero x)))
|
|
rlm@10
|
722
|
|
rlm@10
|
723 (defn count
|
|
rlm@10
|
724 "Returns the number of items in the collection. (count nil) returns
|
|
rlm@10
|
725 0. Also works on strings, arrays, and Java Collections and Maps"
|
|
rlm@10
|
726 {
|
|
rlm@10
|
727 :inline (fn [x] `(. clojure.lang.RT (count ~x)))
|
|
rlm@10
|
728 :added "1.0"}
|
|
rlm@10
|
729 [coll] (clojure.lang.RT/count coll))
|
|
rlm@10
|
730
|
|
rlm@10
|
731 (defn int
|
|
rlm@10
|
732 "Coerce to int"
|
|
rlm@10
|
733 {
|
|
rlm@10
|
734 :inline (fn [x] `(. clojure.lang.RT (intCast ~x)))
|
|
rlm@10
|
735 :added "1.0"}
|
|
rlm@10
|
736 [x] (. clojure.lang.RT (intCast x)))
|
|
rlm@10
|
737
|
|
rlm@10
|
738 (defn nth
|
|
rlm@10
|
739 "Returns the value at the index. get returns nil if index out of
|
|
rlm@10
|
740 bounds, nth throws an exception unless not-found is supplied. nth
|
|
rlm@10
|
741 also works for strings, Java arrays, regex Matchers and Lists, and,
|
|
rlm@10
|
742 in O(n) time, for sequences."
|
|
rlm@10
|
743 {:inline (fn [c i & nf] `(. clojure.lang.RT (nth ~c ~i ~@nf)))
|
|
rlm@10
|
744 :inline-arities #{2 3}
|
|
rlm@10
|
745 :added "1.0"}
|
|
rlm@10
|
746 ([coll index] (. clojure.lang.RT (nth coll index)))
|
|
rlm@10
|
747 ([coll index not-found] (. clojure.lang.RT (nth coll index not-found))))
|
|
rlm@10
|
748
|
|
rlm@10
|
749 (defn <
|
|
rlm@10
|
750 "Returns non-nil if nums are in monotonically increasing order,
|
|
rlm@10
|
751 otherwise false."
|
|
rlm@10
|
752 {:inline (fn [x y] `(. clojure.lang.Numbers (lt ~x ~y)))
|
|
rlm@10
|
753 :inline-arities #{2}
|
|
rlm@10
|
754 :added "1.0"}
|
|
rlm@10
|
755 ([x] true)
|
|
rlm@10
|
756 ([x y] (. clojure.lang.Numbers (lt x y)))
|
|
rlm@10
|
757 ([x y & more]
|
|
rlm@10
|
758 (if (< x y)
|
|
rlm@10
|
759 (if (next more)
|
|
rlm@10
|
760 (recur y (first more) (next more))
|
|
rlm@10
|
761 (< y (first more)))
|
|
rlm@10
|
762 false)))
|
|
rlm@10
|
763
|
|
rlm@10
|
764 (defn inc
|
|
rlm@10
|
765 "Returns a number one greater than num."
|
|
rlm@10
|
766 {:inline (fn [x] `(. clojure.lang.Numbers (inc ~x)))
|
|
rlm@10
|
767 :added "1.0"}
|
|
rlm@10
|
768 [x] (. clojure.lang.Numbers (inc x)))
|
|
rlm@10
|
769
|
|
rlm@10
|
770 ;; reduce is defined again later after InternalReduce loads
|
|
rlm@10
|
771 (def
|
|
rlm@10
|
772 ^{:arglists '([f coll] [f val coll])
|
|
rlm@10
|
773 :doc "f should be a function of 2 arguments. If val is not supplied,
|
|
rlm@10
|
774 returns the result of applying f to the first 2 items in coll, then
|
|
rlm@10
|
775 applying f to that result and the 3rd item, etc. If coll contains no
|
|
rlm@10
|
776 items, f must accept no arguments as well, and reduce returns the
|
|
rlm@10
|
777 result of calling f with no arguments. If coll has only 1 item, it
|
|
rlm@10
|
778 is returned and f is not called. If val is supplied, returns the
|
|
rlm@10
|
779 result of applying f to val and the first item in coll, then
|
|
rlm@10
|
780 applying f to that result and the 2nd item, etc. If coll contains no
|
|
rlm@10
|
781 items, returns val and f is not called."
|
|
rlm@10
|
782 :added "1.0"}
|
|
rlm@10
|
783 reduce
|
|
rlm@10
|
784 (fn r
|
|
rlm@10
|
785 ([f coll]
|
|
rlm@10
|
786 (let [s (seq coll)]
|
|
rlm@10
|
787 (if s
|
|
rlm@10
|
788 (r f (first s) (next s))
|
|
rlm@10
|
789 (f))))
|
|
rlm@10
|
790 ([f val coll]
|
|
rlm@10
|
791 (let [s (seq coll)]
|
|
rlm@10
|
792 (if s
|
|
rlm@10
|
793 (if (chunked-seq? s)
|
|
rlm@10
|
794 (recur f
|
|
rlm@10
|
795 (.reduce (chunk-first s) f val)
|
|
rlm@10
|
796 (chunk-next s))
|
|
rlm@10
|
797 (recur f (f val (first s)) (next s)))
|
|
rlm@10
|
798 val)))))
|
|
rlm@10
|
799
|
|
rlm@10
|
800 (defn reverse
|
|
rlm@10
|
801 "Returns a seq of the items in coll in reverse order. Not lazy."
|
|
rlm@10
|
802 {:added "1.0"}
|
|
rlm@10
|
803 [coll]
|
|
rlm@10
|
804 (reduce conj () coll))
|
|
rlm@10
|
805
|
|
rlm@10
|
806 ;;math stuff
|
|
rlm@10
|
807 (defn +
|
|
rlm@10
|
808 "Returns the sum of nums. (+) returns 0."
|
|
rlm@10
|
809 {:inline (fn [x y] `(. clojure.lang.Numbers (add ~x ~y)))
|
|
rlm@10
|
810 :inline-arities #{2}
|
|
rlm@10
|
811 :added "1.0"}
|
|
rlm@10
|
812 ([] 0)
|
|
rlm@10
|
813 ([x] (cast Number x))
|
|
rlm@10
|
814 ([x y] (. clojure.lang.Numbers (add x y)))
|
|
rlm@10
|
815 ([x y & more]
|
|
rlm@10
|
816 (reduce + (+ x y) more)))
|
|
rlm@10
|
817
|
|
rlm@10
|
818 (defn *
|
|
rlm@10
|
819 "Returns the product of nums. (*) returns 1."
|
|
rlm@10
|
820 {:inline (fn [x y] `(. clojure.lang.Numbers (multiply ~x ~y)))
|
|
rlm@10
|
821 :inline-arities #{2}
|
|
rlm@10
|
822 :added "1.0"}
|
|
rlm@10
|
823 ([] 1)
|
|
rlm@10
|
824 ([x] (cast Number x))
|
|
rlm@10
|
825 ([x y] (. clojure.lang.Numbers (multiply x y)))
|
|
rlm@10
|
826 ([x y & more]
|
|
rlm@10
|
827 (reduce * (* x y) more)))
|
|
rlm@10
|
828
|
|
rlm@10
|
829 (defn /
|
|
rlm@10
|
830 "If no denominators are supplied, returns 1/numerator,
|
|
rlm@10
|
831 else returns numerator divided by all of the denominators."
|
|
rlm@10
|
832 {:inline (fn [x y] `(. clojure.lang.Numbers (divide ~x ~y)))
|
|
rlm@10
|
833 :inline-arities #{2}
|
|
rlm@10
|
834 :added "1.0"}
|
|
rlm@10
|
835 ([x] (/ 1 x))
|
|
rlm@10
|
836 ([x y] (. clojure.lang.Numbers (divide x y)))
|
|
rlm@10
|
837 ([x y & more]
|
|
rlm@10
|
838 (reduce / (/ x y) more)))
|
|
rlm@10
|
839
|
|
rlm@10
|
840 (defn -
|
|
rlm@10
|
841 "If no ys are supplied, returns the negation of x, else subtracts
|
|
rlm@10
|
842 the ys from x and returns the result."
|
|
rlm@10
|
843 {:inline (fn [& args] `(. clojure.lang.Numbers (minus ~@args)))
|
|
rlm@10
|
844 :inline-arities #{1 2}
|
|
rlm@10
|
845 :added "1.0"}
|
|
rlm@10
|
846 ([x] (. clojure.lang.Numbers (minus x)))
|
|
rlm@10
|
847 ([x y] (. clojure.lang.Numbers (minus x y)))
|
|
rlm@10
|
848 ([x y & more]
|
|
rlm@10
|
849 (reduce - (- x y) more)))
|
|
rlm@10
|
850
|
|
rlm@10
|
851 (defn <=
|
|
rlm@10
|
852 "Returns non-nil if nums are in monotonically non-decreasing order,
|
|
rlm@10
|
853 otherwise false."
|
|
rlm@10
|
854 {:inline (fn [x y] `(. clojure.lang.Numbers (lte ~x ~y)))
|
|
rlm@10
|
855 :inline-arities #{2}
|
|
rlm@10
|
856 :added "1.0"}
|
|
rlm@10
|
857 ([x] true)
|
|
rlm@10
|
858 ([x y] (. clojure.lang.Numbers (lte x y)))
|
|
rlm@10
|
859 ([x y & more]
|
|
rlm@10
|
860 (if (<= x y)
|
|
rlm@10
|
861 (if (next more)
|
|
rlm@10
|
862 (recur y (first more) (next more))
|
|
rlm@10
|
863 (<= y (first more)))
|
|
rlm@10
|
864 false)))
|
|
rlm@10
|
865
|
|
rlm@10
|
866 (defn >
|
|
rlm@10
|
867 "Returns non-nil if nums are in monotonically decreasing order,
|
|
rlm@10
|
868 otherwise false."
|
|
rlm@10
|
869 {:inline (fn [x y] `(. clojure.lang.Numbers (gt ~x ~y)))
|
|
rlm@10
|
870 :inline-arities #{2}
|
|
rlm@10
|
871 :added "1.0"}
|
|
rlm@10
|
872 ([x] true)
|
|
rlm@10
|
873 ([x y] (. clojure.lang.Numbers (gt x y)))
|
|
rlm@10
|
874 ([x y & more]
|
|
rlm@10
|
875 (if (> x y)
|
|
rlm@10
|
876 (if (next more)
|
|
rlm@10
|
877 (recur y (first more) (next more))
|
|
rlm@10
|
878 (> y (first more)))
|
|
rlm@10
|
879 false)))
|
|
rlm@10
|
880
|
|
rlm@10
|
881 (defn >=
|
|
rlm@10
|
882 "Returns non-nil if nums are in monotonically non-increasing order,
|
|
rlm@10
|
883 otherwise false."
|
|
rlm@10
|
884 {:inline (fn [x y] `(. clojure.lang.Numbers (gte ~x ~y)))
|
|
rlm@10
|
885 :inline-arities #{2}
|
|
rlm@10
|
886 :added "1.0"}
|
|
rlm@10
|
887 ([x] true)
|
|
rlm@10
|
888 ([x y] (. clojure.lang.Numbers (gte x y)))
|
|
rlm@10
|
889 ([x y & more]
|
|
rlm@10
|
890 (if (>= x y)
|
|
rlm@10
|
891 (if (next more)
|
|
rlm@10
|
892 (recur y (first more) (next more))
|
|
rlm@10
|
893 (>= y (first more)))
|
|
rlm@10
|
894 false)))
|
|
rlm@10
|
895
|
|
rlm@10
|
896 (defn ==
|
|
rlm@10
|
897 "Returns non-nil if nums all have the same value, otherwise false"
|
|
rlm@10
|
898 {:inline (fn [x y] `(. clojure.lang.Numbers (equiv ~x ~y)))
|
|
rlm@10
|
899 :inline-arities #{2}
|
|
rlm@10
|
900 :added "1.0"}
|
|
rlm@10
|
901 ([x] true)
|
|
rlm@10
|
902 ([x y] (. clojure.lang.Numbers (equiv x y)))
|
|
rlm@10
|
903 ([x y & more]
|
|
rlm@10
|
904 (if (== x y)
|
|
rlm@10
|
905 (if (next more)
|
|
rlm@10
|
906 (recur y (first more) (next more))
|
|
rlm@10
|
907 (== y (first more)))
|
|
rlm@10
|
908 false)))
|
|
rlm@10
|
909
|
|
rlm@10
|
910 (defn max
|
|
rlm@10
|
911 "Returns the greatest of the nums."
|
|
rlm@10
|
912 {:added "1.0"}
|
|
rlm@10
|
913 ([x] x)
|
|
rlm@10
|
914 ([x y] (if (> x y) x y))
|
|
rlm@10
|
915 ([x y & more]
|
|
rlm@10
|
916 (reduce max (max x y) more)))
|
|
rlm@10
|
917
|
|
rlm@10
|
918 (defn min
|
|
rlm@10
|
919 "Returns the least of the nums."
|
|
rlm@10
|
920 {:added "1.0"}
|
|
rlm@10
|
921 ([x] x)
|
|
rlm@10
|
922 ([x y] (if (< x y) x y))
|
|
rlm@10
|
923 ([x y & more]
|
|
rlm@10
|
924 (reduce min (min x y) more)))
|
|
rlm@10
|
925
|
|
rlm@10
|
926 (defn dec
|
|
rlm@10
|
927 "Returns a number one less than num."
|
|
rlm@10
|
928 {:inline (fn [x] `(. clojure.lang.Numbers (dec ~x)))
|
|
rlm@10
|
929 :added "1.0"}
|
|
rlm@10
|
930 [x] (. clojure.lang.Numbers (dec x)))
|
|
rlm@10
|
931
|
|
rlm@10
|
932 (defn unchecked-inc
|
|
rlm@10
|
933 "Returns a number one greater than x, an int or long.
|
|
rlm@10
|
934 Note - uses a primitive operator subject to overflow."
|
|
rlm@10
|
935 {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_inc ~x)))
|
|
rlm@10
|
936 :added "1.0"}
|
|
rlm@10
|
937 [x] (. clojure.lang.Numbers (unchecked_inc x)))
|
|
rlm@10
|
938
|
|
rlm@10
|
939 (defn unchecked-dec
|
|
rlm@10
|
940 "Returns a number one less than x, an int or long.
|
|
rlm@10
|
941 Note - uses a primitive operator subject to overflow."
|
|
rlm@10
|
942 {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_dec ~x)))
|
|
rlm@10
|
943 :added "1.0"}
|
|
rlm@10
|
944 [x] (. clojure.lang.Numbers (unchecked_dec x)))
|
|
rlm@10
|
945
|
|
rlm@10
|
946 (defn unchecked-negate
|
|
rlm@10
|
947 "Returns the negation of x, an int or long.
|
|
rlm@10
|
948 Note - uses a primitive operator subject to overflow."
|
|
rlm@10
|
949 {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_negate ~x)))
|
|
rlm@10
|
950 :added "1.0"}
|
|
rlm@10
|
951 [x] (. clojure.lang.Numbers (unchecked_negate x)))
|
|
rlm@10
|
952
|
|
rlm@10
|
953 (defn unchecked-add
|
|
rlm@10
|
954 "Returns the sum of x and y, both int or long.
|
|
rlm@10
|
955 Note - uses a primitive operator subject to overflow."
|
|
rlm@10
|
956 {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_add ~x ~y)))
|
|
rlm@10
|
957 :added "1.0"}
|
|
rlm@10
|
958 [x y] (. clojure.lang.Numbers (unchecked_add x y)))
|
|
rlm@10
|
959
|
|
rlm@10
|
960 (defn unchecked-subtract
|
|
rlm@10
|
961 "Returns the difference of x and y, both int or long.
|
|
rlm@10
|
962 Note - uses a primitive operator subject to overflow."
|
|
rlm@10
|
963 {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_subtract ~x ~y)))
|
|
rlm@10
|
964 :added "1.0"}
|
|
rlm@10
|
965 [x y] (. clojure.lang.Numbers (unchecked_subtract x y)))
|
|
rlm@10
|
966
|
|
rlm@10
|
967 (defn unchecked-multiply
|
|
rlm@10
|
968 "Returns the product of x and y, both int or long.
|
|
rlm@10
|
969 Note - uses a primitive operator subject to overflow."
|
|
rlm@10
|
970 {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_multiply ~x ~y)))
|
|
rlm@10
|
971 :added "1.0"}
|
|
rlm@10
|
972 [x y] (. clojure.lang.Numbers (unchecked_multiply x y)))
|
|
rlm@10
|
973
|
|
rlm@10
|
974 (defn unchecked-divide
|
|
rlm@10
|
975 "Returns the division of x by y, both int or long.
|
|
rlm@10
|
976 Note - uses a primitive operator subject to truncation."
|
|
rlm@10
|
977 {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_divide ~x ~y)))
|
|
rlm@10
|
978 :added "1.0"}
|
|
rlm@10
|
979 [x y] (. clojure.lang.Numbers (unchecked_divide x y)))
|
|
rlm@10
|
980
|
|
rlm@10
|
981 (defn unchecked-remainder
|
|
rlm@10
|
982 "Returns the remainder of division of x by y, both int or long.
|
|
rlm@10
|
983 Note - uses a primitive operator subject to truncation."
|
|
rlm@10
|
984 {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_remainder ~x ~y)))
|
|
rlm@10
|
985 :added "1.0"}
|
|
rlm@10
|
986 [x y] (. clojure.lang.Numbers (unchecked_remainder x y)))
|
|
rlm@10
|
987
|
|
rlm@10
|
988 (defn pos?
|
|
rlm@10
|
989 "Returns true if num is greater than zero, else false"
|
|
rlm@10
|
990 {
|
|
rlm@10
|
991 :inline (fn [x] `(. clojure.lang.Numbers (isPos ~x)))
|
|
rlm@10
|
992 :added "1.0"}
|
|
rlm@10
|
993 [x] (. clojure.lang.Numbers (isPos x)))
|
|
rlm@10
|
994
|
|
rlm@10
|
995 (defn neg?
|
|
rlm@10
|
996 "Returns true if num is less than zero, else false"
|
|
rlm@10
|
997 {
|
|
rlm@10
|
998 :inline (fn [x] `(. clojure.lang.Numbers (isNeg ~x)))
|
|
rlm@10
|
999 :added "1.0"}
|
|
rlm@10
|
1000 [x] (. clojure.lang.Numbers (isNeg x)))
|
|
rlm@10
|
1001
|
|
rlm@10
|
1002 (defn quot
|
|
rlm@10
|
1003 "quot[ient] of dividing numerator by denominator."
|
|
rlm@10
|
1004 {:added "1.0"}
|
|
rlm@10
|
1005 [num div]
|
|
rlm@10
|
1006 (. clojure.lang.Numbers (quotient num div)))
|
|
rlm@10
|
1007
|
|
rlm@10
|
1008 (defn rem
|
|
rlm@10
|
1009 "remainder of dividing numerator by denominator."
|
|
rlm@10
|
1010 {:added "1.0"}
|
|
rlm@10
|
1011 [num div]
|
|
rlm@10
|
1012 (. clojure.lang.Numbers (remainder num div)))
|
|
rlm@10
|
1013
|
|
rlm@10
|
1014 (defn rationalize
|
|
rlm@10
|
1015 "returns the rational value of num"
|
|
rlm@10
|
1016 {:added "1.0"}
|
|
rlm@10
|
1017 [num]
|
|
rlm@10
|
1018 (. clojure.lang.Numbers (rationalize num)))
|
|
rlm@10
|
1019
|
|
rlm@10
|
1020 ;;Bit ops
|
|
rlm@10
|
1021
|
|
rlm@10
|
1022 (defn bit-not
|
|
rlm@10
|
1023 "Bitwise complement"
|
|
rlm@10
|
1024 {:inline (fn [x] `(. clojure.lang.Numbers (not ~x)))
|
|
rlm@10
|
1025 :added "1.0"}
|
|
rlm@10
|
1026 [x] (. clojure.lang.Numbers not x))
|
|
rlm@10
|
1027
|
|
rlm@10
|
1028
|
|
rlm@10
|
1029 (defn bit-and
|
|
rlm@10
|
1030 "Bitwise and"
|
|
rlm@10
|
1031 {:inline (fn [x y] `(. clojure.lang.Numbers (and ~x ~y)))
|
|
rlm@10
|
1032 :added "1.0"}
|
|
rlm@10
|
1033 [x y] (. clojure.lang.Numbers and x y))
|
|
rlm@10
|
1034
|
|
rlm@10
|
1035 (defn bit-or
|
|
rlm@10
|
1036 "Bitwise or"
|
|
rlm@10
|
1037 {:inline (fn [x y] `(. clojure.lang.Numbers (or ~x ~y)))
|
|
rlm@10
|
1038 :added "1.0"}
|
|
rlm@10
|
1039 [x y] (. clojure.lang.Numbers or x y))
|
|
rlm@10
|
1040
|
|
rlm@10
|
1041 (defn bit-xor
|
|
rlm@10
|
1042 "Bitwise exclusive or"
|
|
rlm@10
|
1043 {:inline (fn [x y] `(. clojure.lang.Numbers (xor ~x ~y)))
|
|
rlm@10
|
1044 :added "1.0"}
|
|
rlm@10
|
1045 [x y] (. clojure.lang.Numbers xor x y))
|
|
rlm@10
|
1046
|
|
rlm@10
|
1047 (defn bit-and-not
|
|
rlm@10
|
1048 "Bitwise and with complement"
|
|
rlm@10
|
1049 {:added "1.0"}
|
|
rlm@10
|
1050 [x y] (. clojure.lang.Numbers andNot x y))
|
|
rlm@10
|
1051
|
|
rlm@10
|
1052
|
|
rlm@10
|
1053 (defn bit-clear
|
|
rlm@10
|
1054 "Clear bit at index n"
|
|
rlm@10
|
1055 {:added "1.0"}
|
|
rlm@10
|
1056 [x n] (. clojure.lang.Numbers clearBit x n))
|
|
rlm@10
|
1057
|
|
rlm@10
|
1058 (defn bit-set
|
|
rlm@10
|
1059 "Set bit at index n"
|
|
rlm@10
|
1060 {:added "1.0"}
|
|
rlm@10
|
1061 [x n] (. clojure.lang.Numbers setBit x n))
|
|
rlm@10
|
1062
|
|
rlm@10
|
1063 (defn bit-flip
|
|
rlm@10
|
1064 "Flip bit at index n"
|
|
rlm@10
|
1065 {:added "1.0"}
|
|
rlm@10
|
1066 [x n] (. clojure.lang.Numbers flipBit x n))
|
|
rlm@10
|
1067
|
|
rlm@10
|
1068 (defn bit-test
|
|
rlm@10
|
1069 "Test bit at index n"
|
|
rlm@10
|
1070 {:added "1.0"}
|
|
rlm@10
|
1071 [x n] (. clojure.lang.Numbers testBit x n))
|
|
rlm@10
|
1072
|
|
rlm@10
|
1073
|
|
rlm@10
|
1074 (defn bit-shift-left
|
|
rlm@10
|
1075 "Bitwise shift left"
|
|
rlm@10
|
1076 {:inline (fn [x n] `(. clojure.lang.Numbers (shiftLeft ~x ~n)))
|
|
rlm@10
|
1077 :added "1.0"}
|
|
rlm@10
|
1078 [x n] (. clojure.lang.Numbers shiftLeft x n))
|
|
rlm@10
|
1079
|
|
rlm@10
|
1080 (defn bit-shift-right
|
|
rlm@10
|
1081 "Bitwise shift right"
|
|
rlm@10
|
1082 {:inline (fn [x n] `(. clojure.lang.Numbers (shiftRight ~x ~n)))
|
|
rlm@10
|
1083 :added "1.0"}
|
|
rlm@10
|
1084 [x n] (. clojure.lang.Numbers shiftRight x n))
|
|
rlm@10
|
1085
|
|
rlm@10
|
1086 (defn even?
|
|
rlm@10
|
1087 "Returns true if n is even, throws an exception if n is not an integer"
|
|
rlm@10
|
1088 {:added "1.0"}
|
|
rlm@10
|
1089 [n] (zero? (bit-and n 1)))
|
|
rlm@10
|
1090
|
|
rlm@10
|
1091 (defn odd?
|
|
rlm@10
|
1092 "Returns true if n is odd, throws an exception if n is not an integer"
|
|
rlm@10
|
1093 {:added "1.0"}
|
|
rlm@10
|
1094 [n] (not (even? n)))
|
|
rlm@10
|
1095
|
|
rlm@10
|
1096
|
|
rlm@10
|
1097 ;;
|
|
rlm@10
|
1098
|
|
rlm@10
|
1099 (defn complement
|
|
rlm@10
|
1100 "Takes a fn f and returns a fn that takes the same arguments as f,
|
|
rlm@10
|
1101 has the same effects, if any, and returns the opposite truth value."
|
|
rlm@10
|
1102 {:added "1.0"}
|
|
rlm@10
|
1103 [f]
|
|
rlm@10
|
1104 (fn
|
|
rlm@10
|
1105 ([] (not (f)))
|
|
rlm@10
|
1106 ([x] (not (f x)))
|
|
rlm@10
|
1107 ([x y] (not (f x y)))
|
|
rlm@10
|
1108 ([x y & zs] (not (apply f x y zs)))))
|
|
rlm@10
|
1109
|
|
rlm@10
|
1110 (defn constantly
|
|
rlm@10
|
1111 "Returns a function that takes any number of arguments and returns x."
|
|
rlm@10
|
1112 {:added "1.0"}
|
|
rlm@10
|
1113 [x] (fn [& args] x))
|
|
rlm@10
|
1114
|
|
rlm@10
|
1115 (defn identity
|
|
rlm@10
|
1116 "Returns its argument."
|
|
rlm@10
|
1117 {:added "1.0"}
|
|
rlm@10
|
1118 [x] x)
|
|
rlm@10
|
1119
|
|
rlm@10
|
1120 ;;Collection stuff
|
|
rlm@10
|
1121
|
|
rlm@10
|
1122
|
|
rlm@10
|
1123
|
|
rlm@10
|
1124
|
|
rlm@10
|
1125
|
|
rlm@10
|
1126 ;;list stuff
|
|
rlm@10
|
1127 (defn peek
|
|
rlm@10
|
1128 "For a list or queue, same as first, for a vector, same as, but much
|
|
rlm@10
|
1129 more efficient than, last. If the collection is empty, returns nil."
|
|
rlm@10
|
1130 {:added "1.0"}
|
|
rlm@10
|
1131 [coll] (. clojure.lang.RT (peek coll)))
|
|
rlm@10
|
1132
|
|
rlm@10
|
1133 (defn pop
|
|
rlm@10
|
1134 "For a list or queue, returns a new list/queue without the first
|
|
rlm@10
|
1135 item, for a vector, returns a new vector without the last item. If
|
|
rlm@10
|
1136 the collection is empty, throws an exception. Note - not the same
|
|
rlm@10
|
1137 as next/butlast."
|
|
rlm@10
|
1138 {:added "1.0"}
|
|
rlm@10
|
1139 [coll] (. clojure.lang.RT (pop coll)))
|
|
rlm@10
|
1140
|
|
rlm@10
|
1141 ;;map stuff
|
|
rlm@10
|
1142
|
|
rlm@10
|
1143 (defn contains?
|
|
rlm@10
|
1144 "Returns true if key is present in the given collection, otherwise
|
|
rlm@10
|
1145 returns false. Note that for numerically indexed collections like
|
|
rlm@10
|
1146 vectors and Java arrays, this tests if the numeric key is within the
|
|
rlm@10
|
1147 range of indexes. 'contains?' operates constant or logarithmic time;
|
|
rlm@10
|
1148 it will not perform a linear search for a value. See also 'some'."
|
|
rlm@10
|
1149 {:added "1.0"}
|
|
rlm@10
|
1150 [coll key] (. clojure.lang.RT (contains coll key)))
|
|
rlm@10
|
1151
|
|
rlm@10
|
1152 (defn get
|
|
rlm@10
|
1153 "Returns the value mapped to key, not-found or nil if key not present."
|
|
rlm@10
|
1154 {:inline (fn [m k & nf] `(. clojure.lang.RT (get ~m ~k ~@nf)))
|
|
rlm@10
|
1155 :inline-arities #{2 3}
|
|
rlm@10
|
1156 :added "1.0"}
|
|
rlm@10
|
1157 ([map key]
|
|
rlm@10
|
1158 (. clojure.lang.RT (get map key)))
|
|
rlm@10
|
1159 ([map key not-found]
|
|
rlm@10
|
1160 (. clojure.lang.RT (get map key not-found))))
|
|
rlm@10
|
1161
|
|
rlm@10
|
1162 (defn dissoc
|
|
rlm@10
|
1163 "dissoc[iate]. Returns a new map of the same (hashed/sorted) type,
|
|
rlm@10
|
1164 that does not contain a mapping for key(s)."
|
|
rlm@10
|
1165 {:added "1.0"}
|
|
rlm@10
|
1166 ([map] map)
|
|
rlm@10
|
1167 ([map key]
|
|
rlm@10
|
1168 (. clojure.lang.RT (dissoc map key)))
|
|
rlm@10
|
1169 ([map key & ks]
|
|
rlm@10
|
1170 (let [ret (dissoc map key)]
|
|
rlm@10
|
1171 (if ks
|
|
rlm@10
|
1172 (recur ret (first ks) (next ks))
|
|
rlm@10
|
1173 ret))))
|
|
rlm@10
|
1174
|
|
rlm@10
|
1175 (defn disj
|
|
rlm@10
|
1176 "disj[oin]. Returns a new set of the same (hashed/sorted) type, that
|
|
rlm@10
|
1177 does not contain key(s)."
|
|
rlm@10
|
1178 {:added "1.0"}
|
|
rlm@10
|
1179 ([set] set)
|
|
rlm@10
|
1180 ([^clojure.lang.IPersistentSet set key]
|
|
rlm@10
|
1181 (when set
|
|
rlm@10
|
1182 (. set (disjoin key))))
|
|
rlm@10
|
1183 ([set key & ks]
|
|
rlm@10
|
1184 (when set
|
|
rlm@10
|
1185 (let [ret (disj set key)]
|
|
rlm@10
|
1186 (if ks
|
|
rlm@10
|
1187 (recur ret (first ks) (next ks))
|
|
rlm@10
|
1188 ret)))))
|
|
rlm@10
|
1189
|
|
rlm@10
|
1190 (defn find
|
|
rlm@10
|
1191 "Returns the map entry for key, or nil if key not present."
|
|
rlm@10
|
1192 {:added "1.0"}
|
|
rlm@10
|
1193 [map key] (. clojure.lang.RT (find map key)))
|
|
rlm@10
|
1194
|
|
rlm@10
|
1195 (defn select-keys
|
|
rlm@10
|
1196 "Returns a map containing only those entries in map whose key is in keys"
|
|
rlm@10
|
1197 {:added "1.0"}
|
|
rlm@10
|
1198 [map keyseq]
|
|
rlm@10
|
1199 (loop [ret {} keys (seq keyseq)]
|
|
rlm@10
|
1200 (if keys
|
|
rlm@10
|
1201 (let [entry (. clojure.lang.RT (find map (first keys)))]
|
|
rlm@10
|
1202 (recur
|
|
rlm@10
|
1203 (if entry
|
|
rlm@10
|
1204 (conj ret entry)
|
|
rlm@10
|
1205 ret)
|
|
rlm@10
|
1206 (next keys)))
|
|
rlm@10
|
1207 ret)))
|
|
rlm@10
|
1208
|
|
rlm@10
|
1209 (defn keys
|
|
rlm@10
|
1210 "Returns a sequence of the map's keys."
|
|
rlm@10
|
1211 {:added "1.0"}
|
|
rlm@10
|
1212 [map] (. clojure.lang.RT (keys map)))
|
|
rlm@10
|
1213
|
|
rlm@10
|
1214 (defn vals
|
|
rlm@10
|
1215 "Returns a sequence of the map's values."
|
|
rlm@10
|
1216 {:added "1.0"}
|
|
rlm@10
|
1217 [map] (. clojure.lang.RT (vals map)))
|
|
rlm@10
|
1218
|
|
rlm@10
|
1219 (defn key
|
|
rlm@10
|
1220 "Returns the key of the map entry."
|
|
rlm@10
|
1221 {:added "1.0"}
|
|
rlm@10
|
1222 [^java.util.Map$Entry e]
|
|
rlm@10
|
1223 (. e (getKey)))
|
|
rlm@10
|
1224
|
|
rlm@10
|
1225 (defn val
|
|
rlm@10
|
1226 "Returns the value in the map entry."
|
|
rlm@10
|
1227 {:added "1.0"}
|
|
rlm@10
|
1228 [^java.util.Map$Entry e]
|
|
rlm@10
|
1229 (. e (getValue)))
|
|
rlm@10
|
1230
|
|
rlm@10
|
1231 (defn rseq
|
|
rlm@10
|
1232 "Returns, in constant time, a seq of the items in rev (which
|
|
rlm@10
|
1233 can be a vector or sorted-map), in reverse order. If rev is empty returns nil"
|
|
rlm@10
|
1234 {:added "1.0"}
|
|
rlm@10
|
1235 [^clojure.lang.Reversible rev]
|
|
rlm@10
|
1236 (. rev (rseq)))
|
|
rlm@10
|
1237
|
|
rlm@10
|
1238 (defn name
|
|
rlm@10
|
1239 "Returns the name String of a string, symbol or keyword."
|
|
rlm@10
|
1240 {:tag String
|
|
rlm@10
|
1241 :added "1.0"}
|
|
rlm@10
|
1242 [^clojure.lang.Named x]
|
|
rlm@10
|
1243 (if (string? x) x (. x (getName))))
|
|
rlm@10
|
1244
|
|
rlm@10
|
1245 (defn namespace
|
|
rlm@10
|
1246 "Returns the namespace String of a symbol or keyword, or nil if not present."
|
|
rlm@10
|
1247 {:tag String
|
|
rlm@10
|
1248 :added "1.0"}
|
|
rlm@10
|
1249 [^clojure.lang.Named x]
|
|
rlm@10
|
1250 (. x (getNamespace)))
|
|
rlm@10
|
1251
|
|
rlm@10
|
1252 (defmacro locking
|
|
rlm@10
|
1253 "Executes exprs in an implicit do, while holding the monitor of x.
|
|
rlm@10
|
1254 Will release the monitor of x in all circumstances."
|
|
rlm@10
|
1255 {:added "1.0"}
|
|
rlm@10
|
1256 [x & body]
|
|
rlm@10
|
1257 `(let [lockee# ~x]
|
|
rlm@10
|
1258 (try
|
|
rlm@10
|
1259 (monitor-enter lockee#)
|
|
rlm@10
|
1260 ~@body
|
|
rlm@10
|
1261 (finally
|
|
rlm@10
|
1262 (monitor-exit lockee#)))))
|
|
rlm@10
|
1263
|
|
rlm@10
|
1264 (defmacro ..
|
|
rlm@10
|
1265 "form => fieldName-symbol or (instanceMethodName-symbol args*)
|
|
rlm@10
|
1266
|
|
rlm@10
|
1267 Expands into a member access (.) of the first member on the first
|
|
rlm@10
|
1268 argument, followed by the next member on the result, etc. For
|
|
rlm@10
|
1269 instance:
|
|
rlm@10
|
1270
|
|
rlm@10
|
1271 (.. System (getProperties) (get \"os.name\"))
|
|
rlm@10
|
1272
|
|
rlm@10
|
1273 expands to:
|
|
rlm@10
|
1274
|
|
rlm@10
|
1275 (. (. System (getProperties)) (get \"os.name\"))
|
|
rlm@10
|
1276
|
|
rlm@10
|
1277 but is easier to write, read, and understand."
|
|
rlm@10
|
1278 {:added "1.0"}
|
|
rlm@10
|
1279 ([x form] `(. ~x ~form))
|
|
rlm@10
|
1280 ([x form & more] `(.. (. ~x ~form) ~@more)))
|
|
rlm@10
|
1281
|
|
rlm@10
|
1282 (defmacro ->
|
|
rlm@10
|
1283 "Threads the expr through the forms. Inserts x as the
|
|
rlm@10
|
1284 second item in the first form, making a list of it if it is not a
|
|
rlm@10
|
1285 list already. If there are more forms, inserts the first form as the
|
|
rlm@10
|
1286 second item in second form, etc."
|
|
rlm@10
|
1287 {:added "1.0"}
|
|
rlm@10
|
1288 ([x] x)
|
|
rlm@10
|
1289 ([x form] (if (seq? form)
|
|
rlm@10
|
1290 (with-meta `(~(first form) ~x ~@(next form)) (meta form))
|
|
rlm@10
|
1291 (list form x)))
|
|
rlm@10
|
1292 ([x form & more] `(-> (-> ~x ~form) ~@more)))
|
|
rlm@10
|
1293
|
|
rlm@10
|
1294 (defmacro ->>
|
|
rlm@10
|
1295 "Threads the expr through the forms. Inserts x as the
|
|
rlm@10
|
1296 last item in the first form, making a list of it if it is not a
|
|
rlm@10
|
1297 list already. If there are more forms, inserts the first form as the
|
|
rlm@10
|
1298 last item in second form, etc."
|
|
rlm@10
|
1299 {:added "1.1"}
|
|
rlm@10
|
1300 ([x form] (if (seq? form)
|
|
rlm@10
|
1301 (with-meta `(~(first form) ~@(next form) ~x) (meta form))
|
|
rlm@10
|
1302 (list form x)))
|
|
rlm@10
|
1303 ([x form & more] `(->> (->> ~x ~form) ~@more)))
|
|
rlm@10
|
1304
|
|
rlm@10
|
1305 ;;multimethods
|
|
rlm@10
|
1306 (def global-hierarchy)
|
|
rlm@10
|
1307
|
|
rlm@10
|
1308 (defmacro defmulti
|
|
rlm@10
|
1309 "Creates a new multimethod with the associated dispatch function.
|
|
rlm@10
|
1310 The docstring and attribute-map are optional.
|
|
rlm@10
|
1311
|
|
rlm@10
|
1312 Options are key-value pairs and may be one of:
|
|
rlm@10
|
1313 :default the default dispatch value, defaults to :default
|
|
rlm@10
|
1314 :hierarchy the isa? hierarchy to use for dispatching
|
|
rlm@10
|
1315 defaults to the global hierarchy"
|
|
rlm@10
|
1316 {:arglists '([name docstring? attr-map? dispatch-fn & options])
|
|
rlm@10
|
1317 :added "1.0"}
|
|
rlm@10
|
1318 [mm-name & options]
|
|
rlm@10
|
1319 (let [docstring (if (string? (first options))
|
|
rlm@10
|
1320 (first options)
|
|
rlm@10
|
1321 nil)
|
|
rlm@10
|
1322 options (if (string? (first options))
|
|
rlm@10
|
1323 (next options)
|
|
rlm@10
|
1324 options)
|
|
rlm@10
|
1325 m (if (map? (first options))
|
|
rlm@10
|
1326 (first options)
|
|
rlm@10
|
1327 {})
|
|
rlm@10
|
1328 options (if (map? (first options))
|
|
rlm@10
|
1329 (next options)
|
|
rlm@10
|
1330 options)
|
|
rlm@10
|
1331 dispatch-fn (first options)
|
|
rlm@10
|
1332 options (next options)
|
|
rlm@10
|
1333 m (assoc m :tag 'clojure.lang.MultiFn)
|
|
rlm@10
|
1334 m (if docstring
|
|
rlm@10
|
1335 (assoc m :doc docstring)
|
|
rlm@10
|
1336 m)
|
|
rlm@10
|
1337 m (if (meta mm-name)
|
|
rlm@10
|
1338 (conj (meta mm-name) m)
|
|
rlm@10
|
1339 m)]
|
|
rlm@10
|
1340 (when (= (count options) 1)
|
|
rlm@10
|
1341 (throw (Exception. "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)")))
|
|
rlm@10
|
1342 (let [options (apply hash-map options)
|
|
rlm@10
|
1343 default (get options :default :default)
|
|
rlm@10
|
1344 hierarchy (get options :hierarchy #'global-hierarchy)]
|
|
rlm@10
|
1345 `(let [v# (def ~mm-name)]
|
|
rlm@10
|
1346 (when-not (and (.hasRoot v#) (instance? clojure.lang.MultiFn (deref v#)))
|
|
rlm@10
|
1347 (def ~(with-meta mm-name m)
|
|
rlm@10
|
1348 (new clojure.lang.MultiFn ~(name mm-name) ~dispatch-fn ~default ~hierarchy)))))))
|
|
rlm@10
|
1349
|
|
rlm@10
|
1350 (defmacro defmethod
|
|
rlm@10
|
1351 "Creates and installs a new method of multimethod associated with dispatch-value. "
|
|
rlm@10
|
1352 {:added "1.0"}
|
|
rlm@10
|
1353 [multifn dispatch-val & fn-tail]
|
|
rlm@10
|
1354 `(. ~(with-meta multifn {:tag 'clojure.lang.MultiFn}) addMethod ~dispatch-val (fn ~@fn-tail)))
|
|
rlm@10
|
1355
|
|
rlm@10
|
1356 (defn remove-all-methods
|
|
rlm@10
|
1357 "Removes all of the methods of multimethod."
|
|
rlm@10
|
1358 {:added "1.2"}
|
|
rlm@10
|
1359 [^clojure.lang.MultiFn multifn]
|
|
rlm@10
|
1360 (.reset multifn))
|
|
rlm@10
|
1361
|
|
rlm@10
|
1362 (defn remove-method
|
|
rlm@10
|
1363 "Removes the method of multimethod associated with dispatch-value."
|
|
rlm@10
|
1364 {:added "1.0"}
|
|
rlm@10
|
1365 [^clojure.lang.MultiFn multifn dispatch-val]
|
|
rlm@10
|
1366 (. multifn removeMethod dispatch-val))
|
|
rlm@10
|
1367
|
|
rlm@10
|
1368 (defn prefer-method
|
|
rlm@10
|
1369 "Causes the multimethod to prefer matches of dispatch-val-x over dispatch-val-y
|
|
rlm@10
|
1370 when there is a conflict"
|
|
rlm@10
|
1371 {:added "1.0"}
|
|
rlm@10
|
1372 [^clojure.lang.MultiFn multifn dispatch-val-x dispatch-val-y]
|
|
rlm@10
|
1373 (. multifn preferMethod dispatch-val-x dispatch-val-y))
|
|
rlm@10
|
1374
|
|
rlm@10
|
1375 (defn methods
|
|
rlm@10
|
1376 "Given a multimethod, returns a map of dispatch values -> dispatch fns"
|
|
rlm@10
|
1377 {:added "1.0"}
|
|
rlm@10
|
1378 [^clojure.lang.MultiFn multifn] (.getMethodTable multifn))
|
|
rlm@10
|
1379
|
|
rlm@10
|
1380 (defn get-method
|
|
rlm@10
|
1381 "Given a multimethod and a dispatch value, returns the dispatch fn
|
|
rlm@10
|
1382 that would apply to that value, or nil if none apply and no default"
|
|
rlm@10
|
1383 {:added "1.0"}
|
|
rlm@10
|
1384 [^clojure.lang.MultiFn multifn dispatch-val] (.getMethod multifn dispatch-val))
|
|
rlm@10
|
1385
|
|
rlm@10
|
1386 (defn prefers
|
|
rlm@10
|
1387 "Given a multimethod, returns a map of preferred value -> set of other values"
|
|
rlm@10
|
1388 {:added "1.0"}
|
|
rlm@10
|
1389 [^clojure.lang.MultiFn multifn] (.getPreferTable multifn))
|
|
rlm@10
|
1390
|
|
rlm@10
|
1391 ;;;;;;;;; var stuff
|
|
rlm@10
|
1392
|
|
rlm@10
|
1393 (defmacro ^{:private true} assert-args [fnname & pairs]
|
|
rlm@10
|
1394 `(do (when-not ~(first pairs)
|
|
rlm@10
|
1395 (throw (IllegalArgumentException.
|
|
rlm@10
|
1396 ~(str fnname " requires " (second pairs)))))
|
|
rlm@10
|
1397 ~(let [more (nnext pairs)]
|
|
rlm@10
|
1398 (when more
|
|
rlm@10
|
1399 (list* `assert-args fnname more)))))
|
|
rlm@10
|
1400
|
|
rlm@10
|
1401 (defmacro if-let
|
|
rlm@10
|
1402 "bindings => binding-form test
|
|
rlm@10
|
1403
|
|
rlm@10
|
1404 If test is true, evaluates then with binding-form bound to the value of
|
|
rlm@10
|
1405 test, if not, yields else"
|
|
rlm@10
|
1406 {:added "1.0"}
|
|
rlm@10
|
1407 ([bindings then]
|
|
rlm@10
|
1408 `(if-let ~bindings ~then nil))
|
|
rlm@10
|
1409 ([bindings then else & oldform]
|
|
rlm@10
|
1410 (assert-args if-let
|
|
rlm@10
|
1411 (and (vector? bindings) (nil? oldform)) "a vector for its binding"
|
|
rlm@10
|
1412 (= 2 (count bindings)) "exactly 2 forms in binding vector")
|
|
rlm@10
|
1413 (let [form (bindings 0) tst (bindings 1)]
|
|
rlm@10
|
1414 `(let [temp# ~tst]
|
|
rlm@10
|
1415 (if temp#
|
|
rlm@10
|
1416 (let [~form temp#]
|
|
rlm@10
|
1417 ~then)
|
|
rlm@10
|
1418 ~else)))))
|
|
rlm@10
|
1419
|
|
rlm@10
|
1420 (defmacro when-let
|
|
rlm@10
|
1421 "bindings => binding-form test
|
|
rlm@10
|
1422
|
|
rlm@10
|
1423 When test is true, evaluates body with binding-form bound to the value of test"
|
|
rlm@10
|
1424 {:added "1.0"}
|
|
rlm@10
|
1425 [bindings & body]
|
|
rlm@10
|
1426 (assert-args when-let
|
|
rlm@10
|
1427 (vector? bindings) "a vector for its binding"
|
|
rlm@10
|
1428 (= 2 (count bindings)) "exactly 2 forms in binding vector")
|
|
rlm@10
|
1429 (let [form (bindings 0) tst (bindings 1)]
|
|
rlm@10
|
1430 `(let [temp# ~tst]
|
|
rlm@10
|
1431 (when temp#
|
|
rlm@10
|
1432 (let [~form temp#]
|
|
rlm@10
|
1433 ~@body)))))
|
|
rlm@10
|
1434
|
|
rlm@10
|
1435 (defn push-thread-bindings
|
|
rlm@10
|
1436 "WARNING: This is a low-level function. Prefer high-level macros like
|
|
rlm@10
|
1437 binding where ever possible.
|
|
rlm@10
|
1438
|
|
rlm@10
|
1439 Takes a map of Var/value pairs. Binds each Var to the associated value for
|
|
rlm@10
|
1440 the current thread. Each call *MUST* be accompanied by a matching call to
|
|
rlm@10
|
1441 pop-thread-bindings wrapped in a try-finally!
|
|
rlm@10
|
1442
|
|
rlm@10
|
1443 (push-thread-bindings bindings)
|
|
rlm@10
|
1444 (try
|
|
rlm@10
|
1445 ...
|
|
rlm@10
|
1446 (finally
|
|
rlm@10
|
1447 (pop-thread-bindings)))"
|
|
rlm@10
|
1448 {:added "1.1"}
|
|
rlm@10
|
1449 [bindings]
|
|
rlm@10
|
1450 (clojure.lang.Var/pushThreadBindings bindings))
|
|
rlm@10
|
1451
|
|
rlm@10
|
1452 (defn pop-thread-bindings
|
|
rlm@10
|
1453 "Pop one set of bindings pushed with push-binding before. It is an error to
|
|
rlm@10
|
1454 pop bindings without pushing before."
|
|
rlm@10
|
1455 {:added "1.1"}
|
|
rlm@10
|
1456 []
|
|
rlm@10
|
1457 (clojure.lang.Var/popThreadBindings))
|
|
rlm@10
|
1458
|
|
rlm@10
|
1459 (defn get-thread-bindings
|
|
rlm@10
|
1460 "Get a map with the Var/value pairs which is currently in effect for the
|
|
rlm@10
|
1461 current thread."
|
|
rlm@10
|
1462 {:added "1.1"}
|
|
rlm@10
|
1463 []
|
|
rlm@10
|
1464 (clojure.lang.Var/getThreadBindings))
|
|
rlm@10
|
1465
|
|
rlm@10
|
1466 (defmacro binding
|
|
rlm@10
|
1467 "binding => var-symbol init-expr
|
|
rlm@10
|
1468
|
|
rlm@10
|
1469 Creates new bindings for the (already-existing) vars, with the
|
|
rlm@10
|
1470 supplied initial values, executes the exprs in an implicit do, then
|
|
rlm@10
|
1471 re-establishes the bindings that existed before. The new bindings
|
|
rlm@10
|
1472 are made in parallel (unlike let); all init-exprs are evaluated
|
|
rlm@10
|
1473 before the vars are bound to their new values."
|
|
rlm@10
|
1474 {:added "1.0"}
|
|
rlm@10
|
1475 [bindings & body]
|
|
rlm@10
|
1476 (assert-args binding
|
|
rlm@10
|
1477 (vector? bindings) "a vector for its binding"
|
|
rlm@10
|
1478 (even? (count bindings)) "an even number of forms in binding vector")
|
|
rlm@10
|
1479 (let [var-ize (fn [var-vals]
|
|
rlm@10
|
1480 (loop [ret [] vvs (seq var-vals)]
|
|
rlm@10
|
1481 (if vvs
|
|
rlm@10
|
1482 (recur (conj (conj ret `(var ~(first vvs))) (second vvs))
|
|
rlm@10
|
1483 (next (next vvs)))
|
|
rlm@10
|
1484 (seq ret))))]
|
|
rlm@10
|
1485 `(let []
|
|
rlm@10
|
1486 (push-thread-bindings (hash-map ~@(var-ize bindings)))
|
|
rlm@10
|
1487 (try
|
|
rlm@10
|
1488 ~@body
|
|
rlm@10
|
1489 (finally
|
|
rlm@10
|
1490 (pop-thread-bindings))))))
|
|
rlm@10
|
1491
|
|
rlm@10
|
1492 (defn with-bindings*
|
|
rlm@10
|
1493 "Takes a map of Var/value pairs. Installs for the given Vars the associated
|
|
rlm@10
|
1494 values as thread-local bindings. Then calls f with the supplied arguments.
|
|
rlm@10
|
1495 Pops the installed bindings after f returned. Returns whatever f returns."
|
|
rlm@10
|
1496 {:added "1.1"}
|
|
rlm@10
|
1497 [binding-map f & args]
|
|
rlm@10
|
1498 (push-thread-bindings binding-map)
|
|
rlm@10
|
1499 (try
|
|
rlm@10
|
1500 (apply f args)
|
|
rlm@10
|
1501 (finally
|
|
rlm@10
|
1502 (pop-thread-bindings))))
|
|
rlm@10
|
1503
|
|
rlm@10
|
1504 (defmacro with-bindings
|
|
rlm@10
|
1505 "Takes a map of Var/value pairs. Installs for the given Vars the associated
|
|
rlm@10
|
1506 values as thread-local bindings. The executes body. Pops the installed
|
|
rlm@10
|
1507 bindings after body was evaluated. Returns the value of body."
|
|
rlm@10
|
1508 {:added "1.1"}
|
|
rlm@10
|
1509 [binding-map & body]
|
|
rlm@10
|
1510 `(with-bindings* ~binding-map (fn [] ~@body)))
|
|
rlm@10
|
1511
|
|
rlm@10
|
1512 (defn bound-fn*
|
|
rlm@10
|
1513 "Returns a function, which will install the same bindings in effect as in
|
|
rlm@10
|
1514 the thread at the time bound-fn* was called and then call f with any given
|
|
rlm@10
|
1515 arguments. This may be used to define a helper function which runs on a
|
|
rlm@10
|
1516 different thread, but needs the same bindings in place."
|
|
rlm@10
|
1517 {:added "1.1"}
|
|
rlm@10
|
1518 [f]
|
|
rlm@10
|
1519 (let [bindings (get-thread-bindings)]
|
|
rlm@10
|
1520 (fn [& args]
|
|
rlm@10
|
1521 (apply with-bindings* bindings f args))))
|
|
rlm@10
|
1522
|
|
rlm@10
|
1523 (defmacro bound-fn
|
|
rlm@10
|
1524 "Returns a function defined by the given fntail, which will install the
|
|
rlm@10
|
1525 same bindings in effect as in the thread at the time bound-fn was called.
|
|
rlm@10
|
1526 This may be used to define a helper function which runs on a different
|
|
rlm@10
|
1527 thread, but needs the same bindings in place."
|
|
rlm@10
|
1528 {:added "1.1"}
|
|
rlm@10
|
1529 [& fntail]
|
|
rlm@10
|
1530 `(bound-fn* (fn ~@fntail)))
|
|
rlm@10
|
1531
|
|
rlm@10
|
1532 (defn find-var
|
|
rlm@10
|
1533 "Returns the global var named by the namespace-qualified symbol, or
|
|
rlm@10
|
1534 nil if no var with that name."
|
|
rlm@10
|
1535 {:added "1.0"}
|
|
rlm@10
|
1536 [sym] (. clojure.lang.Var (find sym)))
|
|
rlm@10
|
1537
|
|
rlm@10
|
1538 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Refs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
1539 (defn ^{:private true}
|
|
rlm@10
|
1540 setup-reference [^clojure.lang.ARef r options]
|
|
rlm@10
|
1541 (let [opts (apply hash-map options)]
|
|
rlm@10
|
1542 (when (:meta opts)
|
|
rlm@10
|
1543 (.resetMeta r (:meta opts)))
|
|
rlm@10
|
1544 (when (:validator opts)
|
|
rlm@10
|
1545 (.setValidator r (:validator opts)))
|
|
rlm@10
|
1546 r))
|
|
rlm@10
|
1547
|
|
rlm@10
|
1548 (defn agent
|
|
rlm@10
|
1549 "Creates and returns an agent with an initial value of state and
|
|
rlm@10
|
1550 zero or more options (in any order):
|
|
rlm@10
|
1551
|
|
rlm@10
|
1552 :meta metadata-map
|
|
rlm@10
|
1553
|
|
rlm@10
|
1554 :validator validate-fn
|
|
rlm@10
|
1555
|
|
rlm@10
|
1556 :error-handler handler-fn
|
|
rlm@10
|
1557
|
|
rlm@10
|
1558 :error-mode mode-keyword
|
|
rlm@10
|
1559
|
|
rlm@10
|
1560 If metadata-map is supplied, it will be come the metadata on the
|
|
rlm@10
|
1561 agent. validate-fn must be nil or a side-effect-free fn of one
|
|
rlm@10
|
1562 argument, which will be passed the intended new state on any state
|
|
rlm@10
|
1563 change. If the new state is unacceptable, the validate-fn should
|
|
rlm@10
|
1564 return false or throw an exception. handler-fn is called if an
|
|
rlm@10
|
1565 action throws an exception or if validate-fn rejects a new state --
|
|
rlm@10
|
1566 see set-error-handler! for details. The mode-keyword may be either
|
|
rlm@10
|
1567 :continue (the default if an error-handler is given) or :fail (the
|
|
rlm@10
|
1568 default if no error-handler is given) -- see set-error-mode! for
|
|
rlm@10
|
1569 details."
|
|
rlm@10
|
1570 {:added "1.0"}
|
|
rlm@10
|
1571 ([state & options]
|
|
rlm@10
|
1572 (let [a (new clojure.lang.Agent state)
|
|
rlm@10
|
1573 opts (apply hash-map options)]
|
|
rlm@10
|
1574 (setup-reference a options)
|
|
rlm@10
|
1575 (when (:error-handler opts)
|
|
rlm@10
|
1576 (.setErrorHandler a (:error-handler opts)))
|
|
rlm@10
|
1577 (.setErrorMode a (or (:error-mode opts)
|
|
rlm@10
|
1578 (if (:error-handler opts) :continue :fail)))
|
|
rlm@10
|
1579 a)))
|
|
rlm@10
|
1580
|
|
rlm@10
|
1581 (defn send
|
|
rlm@10
|
1582 "Dispatch an action to an agent. Returns the agent immediately.
|
|
rlm@10
|
1583 Subsequently, in a thread from a thread pool, the state of the agent
|
|
rlm@10
|
1584 will be set to the value of:
|
|
rlm@10
|
1585
|
|
rlm@10
|
1586 (apply action-fn state-of-agent args)"
|
|
rlm@10
|
1587 {:added "1.0"}
|
|
rlm@10
|
1588 [^clojure.lang.Agent a f & args]
|
|
rlm@10
|
1589 (. a (dispatch f args false)))
|
|
rlm@10
|
1590
|
|
rlm@10
|
1591 (defn send-off
|
|
rlm@10
|
1592 "Dispatch a potentially blocking action to an agent. Returns the
|
|
rlm@10
|
1593 agent immediately. Subsequently, in a separate thread, the state of
|
|
rlm@10
|
1594 the agent will be set to the value of:
|
|
rlm@10
|
1595
|
|
rlm@10
|
1596 (apply action-fn state-of-agent args)"
|
|
rlm@10
|
1597 {:added "1.0"}
|
|
rlm@10
|
1598 [^clojure.lang.Agent a f & args]
|
|
rlm@10
|
1599 (. a (dispatch f args true)))
|
|
rlm@10
|
1600
|
|
rlm@10
|
1601 (defn release-pending-sends
|
|
rlm@10
|
1602 "Normally, actions sent directly or indirectly during another action
|
|
rlm@10
|
1603 are held until the action completes (changes the agent's
|
|
rlm@10
|
1604 state). This function can be used to dispatch any pending sent
|
|
rlm@10
|
1605 actions immediately. This has no impact on actions sent during a
|
|
rlm@10
|
1606 transaction, which are still held until commit. If no action is
|
|
rlm@10
|
1607 occurring, does nothing. Returns the number of actions dispatched."
|
|
rlm@10
|
1608 {:added "1.0"}
|
|
rlm@10
|
1609 [] (clojure.lang.Agent/releasePendingSends))
|
|
rlm@10
|
1610
|
|
rlm@10
|
1611 (defn add-watch
|
|
rlm@10
|
1612 "Alpha - subject to change.
|
|
rlm@10
|
1613 Adds a watch function to an agent/atom/var/ref reference. The watch
|
|
rlm@10
|
1614 fn must be a fn of 4 args: a key, the reference, its old-state, its
|
|
rlm@10
|
1615 new-state. Whenever the reference's state might have been changed,
|
|
rlm@10
|
1616 any registered watches will have their functions called. The watch fn
|
|
rlm@10
|
1617 will be called synchronously, on the agent's thread if an agent,
|
|
rlm@10
|
1618 before any pending sends if agent or ref. Note that an atom's or
|
|
rlm@10
|
1619 ref's state may have changed again prior to the fn call, so use
|
|
rlm@10
|
1620 old/new-state rather than derefing the reference. Note also that watch
|
|
rlm@10
|
1621 fns may be called from multiple threads simultaneously. Var watchers
|
|
rlm@10
|
1622 are triggered only by root binding changes, not thread-local
|
|
rlm@10
|
1623 set!s. Keys must be unique per reference, and can be used to remove
|
|
rlm@10
|
1624 the watch with remove-watch, but are otherwise considered opaque by
|
|
rlm@10
|
1625 the watch mechanism."
|
|
rlm@10
|
1626 {:added "1.0"}
|
|
rlm@10
|
1627 [^clojure.lang.IRef reference key fn] (.addWatch reference key fn))
|
|
rlm@10
|
1628
|
|
rlm@10
|
1629 (defn remove-watch
|
|
rlm@10
|
1630 "Alpha - subject to change.
|
|
rlm@10
|
1631 Removes a watch (set by add-watch) from a reference"
|
|
rlm@10
|
1632 {:added "1.0"}
|
|
rlm@10
|
1633 [^clojure.lang.IRef reference key]
|
|
rlm@10
|
1634 (.removeWatch reference key))
|
|
rlm@10
|
1635
|
|
rlm@10
|
1636 (defn agent-error
|
|
rlm@10
|
1637 "Returns the exception thrown during an asynchronous action of the
|
|
rlm@10
|
1638 agent if the agent is failed. Returns nil if the agent is not
|
|
rlm@10
|
1639 failed."
|
|
rlm@10
|
1640 {:added "1.2"}
|
|
rlm@10
|
1641 [^clojure.lang.Agent a] (.getError a))
|
|
rlm@10
|
1642
|
|
rlm@10
|
1643 (defn restart-agent
|
|
rlm@10
|
1644 "When an agent is failed, changes the agent state to new-state and
|
|
rlm@10
|
1645 then un-fails the agent so that sends are allowed again. If
|
|
rlm@10
|
1646 a :clear-actions true option is given, any actions queued on the
|
|
rlm@10
|
1647 agent that were being held while it was failed will be discarded,
|
|
rlm@10
|
1648 otherwise those held actions will proceed. The new-state must pass
|
|
rlm@10
|
1649 the validator if any, or restart will throw an exception and the
|
|
rlm@10
|
1650 agent will remain failed with its old state and error. Watchers, if
|
|
rlm@10
|
1651 any, will NOT be notified of the new state. Throws an exception if
|
|
rlm@10
|
1652 the agent is not failed."
|
|
rlm@10
|
1653 {:added "1.2"}
|
|
rlm@10
|
1654 [^clojure.lang.Agent a, new-state & options]
|
|
rlm@10
|
1655 (let [opts (apply hash-map options)]
|
|
rlm@10
|
1656 (.restart a new-state (if (:clear-actions opts) true false))))
|
|
rlm@10
|
1657
|
|
rlm@10
|
1658 (defn set-error-handler!
|
|
rlm@10
|
1659 "Sets the error-handler of agent a to handler-fn. If an action
|
|
rlm@10
|
1660 being run by the agent throws an exception or doesn't pass the
|
|
rlm@10
|
1661 validator fn, handler-fn will be called with two arguments: the
|
|
rlm@10
|
1662 agent and the exception."
|
|
rlm@10
|
1663 {:added "1.2"}
|
|
rlm@10
|
1664 [^clojure.lang.Agent a, handler-fn]
|
|
rlm@10
|
1665 (.setErrorHandler a handler-fn))
|
|
rlm@10
|
1666
|
|
rlm@10
|
1667 (defn error-handler
|
|
rlm@10
|
1668 "Returns the error-handler of agent a, or nil if there is none.
|
|
rlm@10
|
1669 See set-error-handler!"
|
|
rlm@10
|
1670 {:added "1.2"}
|
|
rlm@10
|
1671 [^clojure.lang.Agent a]
|
|
rlm@10
|
1672 (.getErrorHandler a))
|
|
rlm@10
|
1673
|
|
rlm@10
|
1674 (defn set-error-mode!
|
|
rlm@10
|
1675 "Sets the error-mode of agent a to mode-keyword, which must be
|
|
rlm@10
|
1676 either :fail or :continue. If an action being run by the agent
|
|
rlm@10
|
1677 throws an exception or doesn't pass the validator fn, an
|
|
rlm@10
|
1678 error-handler may be called (see set-error-handler!), after which,
|
|
rlm@10
|
1679 if the mode is :continue, the agent will continue as if neither the
|
|
rlm@10
|
1680 action that caused the error nor the error itself ever happened.
|
|
rlm@10
|
1681
|
|
rlm@10
|
1682 If the mode is :fail, the agent will become failed and will stop
|
|
rlm@10
|
1683 accepting new 'send' and 'send-off' actions, and any previously
|
|
rlm@10
|
1684 queued actions will be held until a 'restart-agent'. Deref will
|
|
rlm@10
|
1685 still work, returning the state of the agent before the error."
|
|
rlm@10
|
1686 {:added "1.2"}
|
|
rlm@10
|
1687 [^clojure.lang.Agent a, mode-keyword]
|
|
rlm@10
|
1688 (.setErrorMode a mode-keyword))
|
|
rlm@10
|
1689
|
|
rlm@10
|
1690 (defn error-mode
|
|
rlm@10
|
1691 "Returns the error-mode of agent a. See set-error-mode!"
|
|
rlm@10
|
1692 {:added "1.2"}
|
|
rlm@10
|
1693 [^clojure.lang.Agent a]
|
|
rlm@10
|
1694 (.getErrorMode a))
|
|
rlm@10
|
1695
|
|
rlm@10
|
1696 (defn agent-errors
|
|
rlm@10
|
1697 "DEPRECATED: Use 'agent-error' instead.
|
|
rlm@10
|
1698 Returns a sequence of the exceptions thrown during asynchronous
|
|
rlm@10
|
1699 actions of the agent."
|
|
rlm@10
|
1700 {:added "1.0"
|
|
rlm@10
|
1701 :deprecated "1.2"}
|
|
rlm@10
|
1702 [a]
|
|
rlm@10
|
1703 (when-let [e (agent-error a)]
|
|
rlm@10
|
1704 (list e)))
|
|
rlm@10
|
1705
|
|
rlm@10
|
1706 (defn clear-agent-errors
|
|
rlm@10
|
1707 "DEPRECATED: Use 'restart-agent' instead.
|
|
rlm@10
|
1708 Clears any exceptions thrown during asynchronous actions of the
|
|
rlm@10
|
1709 agent, allowing subsequent actions to occur."
|
|
rlm@10
|
1710 {:added "1.0"
|
|
rlm@10
|
1711 :deprecated "1.2"}
|
|
rlm@10
|
1712 [^clojure.lang.Agent a] (restart-agent a (.deref a)))
|
|
rlm@10
|
1713
|
|
rlm@10
|
1714 (defn shutdown-agents
|
|
rlm@10
|
1715 "Initiates a shutdown of the thread pools that back the agent
|
|
rlm@10
|
1716 system. Running actions will complete, but no new actions will be
|
|
rlm@10
|
1717 accepted"
|
|
rlm@10
|
1718 {:added "1.0"}
|
|
rlm@10
|
1719 [] (. clojure.lang.Agent shutdown))
|
|
rlm@10
|
1720
|
|
rlm@10
|
1721 (defn ref
|
|
rlm@10
|
1722 "Creates and returns a Ref with an initial value of x and zero or
|
|
rlm@10
|
1723 more options (in any order):
|
|
rlm@10
|
1724
|
|
rlm@10
|
1725 :meta metadata-map
|
|
rlm@10
|
1726
|
|
rlm@10
|
1727 :validator validate-fn
|
|
rlm@10
|
1728
|
|
rlm@10
|
1729 :min-history (default 0)
|
|
rlm@10
|
1730 :max-history (default 10)
|
|
rlm@10
|
1731
|
|
rlm@10
|
1732 If metadata-map is supplied, it will be come the metadata on the
|
|
rlm@10
|
1733 ref. validate-fn must be nil or a side-effect-free fn of one
|
|
rlm@10
|
1734 argument, which will be passed the intended new state on any state
|
|
rlm@10
|
1735 change. If the new state is unacceptable, the validate-fn should
|
|
rlm@10
|
1736 return false or throw an exception. validate-fn will be called on
|
|
rlm@10
|
1737 transaction commit, when all refs have their final values.
|
|
rlm@10
|
1738
|
|
rlm@10
|
1739 Normally refs accumulate history dynamically as needed to deal with
|
|
rlm@10
|
1740 read demands. If you know in advance you will need history you can
|
|
rlm@10
|
1741 set :min-history to ensure it will be available when first needed (instead
|
|
rlm@10
|
1742 of after a read fault). History is limited, and the limit can be set
|
|
rlm@10
|
1743 with :max-history."
|
|
rlm@10
|
1744 {:added "1.0"}
|
|
rlm@10
|
1745 ([x] (new clojure.lang.Ref x))
|
|
rlm@10
|
1746 ([x & options]
|
|
rlm@10
|
1747 (let [r ^clojure.lang.Ref (setup-reference (ref x) options)
|
|
rlm@10
|
1748 opts (apply hash-map options)]
|
|
rlm@10
|
1749 (when (:max-history opts)
|
|
rlm@10
|
1750 (.setMaxHistory r (:max-history opts)))
|
|
rlm@10
|
1751 (when (:min-history opts)
|
|
rlm@10
|
1752 (.setMinHistory r (:min-history opts)))
|
|
rlm@10
|
1753 r)))
|
|
rlm@10
|
1754
|
|
rlm@10
|
1755 (defn deref
|
|
rlm@10
|
1756 "Also reader macro: @ref/@agent/@var/@atom/@delay/@future. Within a transaction,
|
|
rlm@10
|
1757 returns the in-transaction-value of ref, else returns the
|
|
rlm@10
|
1758 most-recently-committed value of ref. When applied to a var, agent
|
|
rlm@10
|
1759 or atom, returns its current state. When applied to a delay, forces
|
|
rlm@10
|
1760 it if not already forced. When applied to a future, will block if
|
|
rlm@10
|
1761 computation not complete"
|
|
rlm@10
|
1762 {:added "1.0"}
|
|
rlm@10
|
1763 [^clojure.lang.IDeref ref] (.deref ref))
|
|
rlm@10
|
1764
|
|
rlm@10
|
1765 (defn atom
|
|
rlm@10
|
1766 "Creates and returns an Atom with an initial value of x and zero or
|
|
rlm@10
|
1767 more options (in any order):
|
|
rlm@10
|
1768
|
|
rlm@10
|
1769 :meta metadata-map
|
|
rlm@10
|
1770
|
|
rlm@10
|
1771 :validator validate-fn
|
|
rlm@10
|
1772
|
|
rlm@10
|
1773 If metadata-map is supplied, it will be come the metadata on the
|
|
rlm@10
|
1774 atom. validate-fn must be nil or a side-effect-free fn of one
|
|
rlm@10
|
1775 argument, which will be passed the intended new state on any state
|
|
rlm@10
|
1776 change. If the new state is unacceptable, the validate-fn should
|
|
rlm@10
|
1777 return false or throw an exception."
|
|
rlm@10
|
1778 {:added "1.0"}
|
|
rlm@10
|
1779 ([x] (new clojure.lang.Atom x))
|
|
rlm@10
|
1780 ([x & options] (setup-reference (atom x) options)))
|
|
rlm@10
|
1781
|
|
rlm@10
|
1782 (defn swap!
|
|
rlm@10
|
1783 "Atomically swaps the value of atom to be:
|
|
rlm@10
|
1784 (apply f current-value-of-atom args). Note that f may be called
|
|
rlm@10
|
1785 multiple times, and thus should be free of side effects. Returns
|
|
rlm@10
|
1786 the value that was swapped in."
|
|
rlm@10
|
1787 {:added "1.0"}
|
|
rlm@10
|
1788 ([^clojure.lang.Atom atom f] (.swap atom f))
|
|
rlm@10
|
1789 ([^clojure.lang.Atom atom f x] (.swap atom f x))
|
|
rlm@10
|
1790 ([^clojure.lang.Atom atom f x y] (.swap atom f x y))
|
|
rlm@10
|
1791 ([^clojure.lang.Atom atom f x y & args] (.swap atom f x y args)))
|
|
rlm@10
|
1792
|
|
rlm@10
|
1793 (defn compare-and-set!
|
|
rlm@10
|
1794 "Atomically sets the value of atom to newval if and only if the
|
|
rlm@10
|
1795 current value of the atom is identical to oldval. Returns true if
|
|
rlm@10
|
1796 set happened, else false"
|
|
rlm@10
|
1797 {:added "1.0"}
|
|
rlm@10
|
1798 [^clojure.lang.Atom atom oldval newval] (.compareAndSet atom oldval newval))
|
|
rlm@10
|
1799
|
|
rlm@10
|
1800 (defn reset!
|
|
rlm@10
|
1801 "Sets the value of atom to newval without regard for the
|
|
rlm@10
|
1802 current value. Returns newval."
|
|
rlm@10
|
1803 {:added "1.0"}
|
|
rlm@10
|
1804 [^clojure.lang.Atom atom newval] (.reset atom newval))
|
|
rlm@10
|
1805
|
|
rlm@10
|
1806 (defn set-validator!
|
|
rlm@10
|
1807 "Sets the validator-fn for a var/ref/agent/atom. validator-fn must be nil or a
|
|
rlm@10
|
1808 side-effect-free fn of one argument, which will be passed the intended
|
|
rlm@10
|
1809 new state on any state change. If the new state is unacceptable, the
|
|
rlm@10
|
1810 validator-fn should return false or throw an exception. If the current state (root
|
|
rlm@10
|
1811 value if var) is not acceptable to the new validator, an exception
|
|
rlm@10
|
1812 will be thrown and the validator will not be changed."
|
|
rlm@10
|
1813 {:added "1.0"}
|
|
rlm@10
|
1814 [^clojure.lang.IRef iref validator-fn] (. iref (setValidator validator-fn)))
|
|
rlm@10
|
1815
|
|
rlm@10
|
1816 (defn get-validator
|
|
rlm@10
|
1817 "Gets the validator-fn for a var/ref/agent/atom."
|
|
rlm@10
|
1818 {:added "1.0"}
|
|
rlm@10
|
1819 [^clojure.lang.IRef iref] (. iref (getValidator)))
|
|
rlm@10
|
1820
|
|
rlm@10
|
1821 (defn alter-meta!
|
|
rlm@10
|
1822 "Atomically sets the metadata for a namespace/var/ref/agent/atom to be:
|
|
rlm@10
|
1823
|
|
rlm@10
|
1824 (apply f its-current-meta args)
|
|
rlm@10
|
1825
|
|
rlm@10
|
1826 f must be free of side-effects"
|
|
rlm@10
|
1827 {:added "1.0"}
|
|
rlm@10
|
1828 [^clojure.lang.IReference iref f & args] (.alterMeta iref f args))
|
|
rlm@10
|
1829
|
|
rlm@10
|
1830 (defn reset-meta!
|
|
rlm@10
|
1831 "Atomically resets the metadata for a namespace/var/ref/agent/atom"
|
|
rlm@10
|
1832 {:added "1.0"}
|
|
rlm@10
|
1833 [^clojure.lang.IReference iref metadata-map] (.resetMeta iref metadata-map))
|
|
rlm@10
|
1834
|
|
rlm@10
|
1835 (defn commute
|
|
rlm@10
|
1836 "Must be called in a transaction. Sets the in-transaction-value of
|
|
rlm@10
|
1837 ref to:
|
|
rlm@10
|
1838
|
|
rlm@10
|
1839 (apply fun in-transaction-value-of-ref args)
|
|
rlm@10
|
1840
|
|
rlm@10
|
1841 and returns the in-transaction-value of ref.
|
|
rlm@10
|
1842
|
|
rlm@10
|
1843 At the commit point of the transaction, sets the value of ref to be:
|
|
rlm@10
|
1844
|
|
rlm@10
|
1845 (apply fun most-recently-committed-value-of-ref args)
|
|
rlm@10
|
1846
|
|
rlm@10
|
1847 Thus fun should be commutative, or, failing that, you must accept
|
|
rlm@10
|
1848 last-one-in-wins behavior. commute allows for more concurrency than
|
|
rlm@10
|
1849 ref-set."
|
|
rlm@10
|
1850 {:added "1.0"}
|
|
rlm@10
|
1851
|
|
rlm@10
|
1852 [^clojure.lang.Ref ref fun & args]
|
|
rlm@10
|
1853 (. ref (commute fun args)))
|
|
rlm@10
|
1854
|
|
rlm@10
|
1855 (defn alter
|
|
rlm@10
|
1856 "Must be called in a transaction. Sets the in-transaction-value of
|
|
rlm@10
|
1857 ref to:
|
|
rlm@10
|
1858
|
|
rlm@10
|
1859 (apply fun in-transaction-value-of-ref args)
|
|
rlm@10
|
1860
|
|
rlm@10
|
1861 and returns the in-transaction-value of ref."
|
|
rlm@10
|
1862 {:added "1.0"}
|
|
rlm@10
|
1863 [^clojure.lang.Ref ref fun & args]
|
|
rlm@10
|
1864 (. ref (alter fun args)))
|
|
rlm@10
|
1865
|
|
rlm@10
|
1866 (defn ref-set
|
|
rlm@10
|
1867 "Must be called in a transaction. Sets the value of ref.
|
|
rlm@10
|
1868 Returns val."
|
|
rlm@10
|
1869 {:added "1.0"}
|
|
rlm@10
|
1870 [^clojure.lang.Ref ref val]
|
|
rlm@10
|
1871 (. ref (set val)))
|
|
rlm@10
|
1872
|
|
rlm@10
|
1873 (defn ref-history-count
|
|
rlm@10
|
1874 "Returns the history count of a ref"
|
|
rlm@10
|
1875 {:added "1.1"}
|
|
rlm@10
|
1876 [^clojure.lang.Ref ref]
|
|
rlm@10
|
1877 (.getHistoryCount ref))
|
|
rlm@10
|
1878
|
|
rlm@10
|
1879 (defn ref-min-history
|
|
rlm@10
|
1880 "Gets the min-history of a ref, or sets it and returns the ref"
|
|
rlm@10
|
1881 {:added "1.1"}
|
|
rlm@10
|
1882 ([^clojure.lang.Ref ref]
|
|
rlm@10
|
1883 (.getMinHistory ref))
|
|
rlm@10
|
1884 ([^clojure.lang.Ref ref n]
|
|
rlm@10
|
1885 (.setMinHistory ref n)))
|
|
rlm@10
|
1886
|
|
rlm@10
|
1887 (defn ref-max-history
|
|
rlm@10
|
1888 "Gets the max-history of a ref, or sets it and returns the ref"
|
|
rlm@10
|
1889 {:added "1.1"}
|
|
rlm@10
|
1890 ([^clojure.lang.Ref ref]
|
|
rlm@10
|
1891 (.getMaxHistory ref))
|
|
rlm@10
|
1892 ([^clojure.lang.Ref ref n]
|
|
rlm@10
|
1893 (.setMaxHistory ref n)))
|
|
rlm@10
|
1894
|
|
rlm@10
|
1895 (defn ensure
|
|
rlm@10
|
1896 "Must be called in a transaction. Protects the ref from modification
|
|
rlm@10
|
1897 by other transactions. Returns the in-transaction-value of
|
|
rlm@10
|
1898 ref. Allows for more concurrency than (ref-set ref @ref)"
|
|
rlm@10
|
1899 {:added "1.0"}
|
|
rlm@10
|
1900 [^clojure.lang.Ref ref]
|
|
rlm@10
|
1901 (. ref (touch))
|
|
rlm@10
|
1902 (. ref (deref)))
|
|
rlm@10
|
1903
|
|
rlm@10
|
1904 (defmacro sync
|
|
rlm@10
|
1905 "transaction-flags => TBD, pass nil for now
|
|
rlm@10
|
1906
|
|
rlm@10
|
1907 Runs the exprs (in an implicit do) in a transaction that encompasses
|
|
rlm@10
|
1908 exprs and any nested calls. Starts a transaction if none is already
|
|
rlm@10
|
1909 running on this thread. Any uncaught exception will abort the
|
|
rlm@10
|
1910 transaction and flow out of sync. The exprs may be run more than
|
|
rlm@10
|
1911 once, but any effects on Refs will be atomic."
|
|
rlm@10
|
1912 {:added "1.0"}
|
|
rlm@10
|
1913 [flags-ignored-for-now & body]
|
|
rlm@10
|
1914 `(. clojure.lang.LockingTransaction
|
|
rlm@10
|
1915 (runInTransaction (fn [] ~@body))))
|
|
rlm@10
|
1916
|
|
rlm@10
|
1917
|
|
rlm@10
|
1918 (defmacro io!
|
|
rlm@10
|
1919 "If an io! block occurs in a transaction, throws an
|
|
rlm@10
|
1920 IllegalStateException, else runs body in an implicit do. If the
|
|
rlm@10
|
1921 first expression in body is a literal string, will use that as the
|
|
rlm@10
|
1922 exception message."
|
|
rlm@10
|
1923 {:added "1.0"}
|
|
rlm@10
|
1924 [& body]
|
|
rlm@10
|
1925 (let [message (when (string? (first body)) (first body))
|
|
rlm@10
|
1926 body (if message (next body) body)]
|
|
rlm@10
|
1927 `(if (clojure.lang.LockingTransaction/isRunning)
|
|
rlm@10
|
1928 (throw (new IllegalStateException ~(or message "I/O in transaction")))
|
|
rlm@10
|
1929 (do ~@body))))
|
|
rlm@10
|
1930
|
|
rlm@10
|
1931 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; fn stuff ;;;;;;;;;;;;;;;;
|
|
rlm@10
|
1932
|
|
rlm@10
|
1933
|
|
rlm@10
|
1934 (defn comp
|
|
rlm@10
|
1935 "Takes a set of functions and returns a fn that is the composition
|
|
rlm@10
|
1936 of those fns. The returned fn takes a variable number of args,
|
|
rlm@10
|
1937 applies the rightmost of fns to the args, the next
|
|
rlm@10
|
1938 fn (right-to-left) to the result, etc."
|
|
rlm@10
|
1939 {:added "1.0"}
|
|
rlm@10
|
1940 ([f] f)
|
|
rlm@10
|
1941 ([f g]
|
|
rlm@10
|
1942 (fn
|
|
rlm@10
|
1943 ([] (f (g)))
|
|
rlm@10
|
1944 ([x] (f (g x)))
|
|
rlm@10
|
1945 ([x y] (f (g x y)))
|
|
rlm@10
|
1946 ([x y z] (f (g x y z)))
|
|
rlm@10
|
1947 ([x y z & args] (f (apply g x y z args)))))
|
|
rlm@10
|
1948 ([f g h]
|
|
rlm@10
|
1949 (fn
|
|
rlm@10
|
1950 ([] (f (g (h))))
|
|
rlm@10
|
1951 ([x] (f (g (h x))))
|
|
rlm@10
|
1952 ([x y] (f (g (h x y))))
|
|
rlm@10
|
1953 ([x y z] (f (g (h x y z))))
|
|
rlm@10
|
1954 ([x y z & args] (f (g (apply h x y z args))))))
|
|
rlm@10
|
1955 ([f1 f2 f3 & fs]
|
|
rlm@10
|
1956 (let [fs (reverse (list* f1 f2 f3 fs))]
|
|
rlm@10
|
1957 (fn [& args]
|
|
rlm@10
|
1958 (loop [ret (apply (first fs) args) fs (next fs)]
|
|
rlm@10
|
1959 (if fs
|
|
rlm@10
|
1960 (recur ((first fs) ret) (next fs))
|
|
rlm@10
|
1961 ret))))))
|
|
rlm@10
|
1962
|
|
rlm@10
|
1963 (defn juxt
|
|
rlm@10
|
1964 "Alpha - name subject to change.
|
|
rlm@10
|
1965 Takes a set of functions and returns a fn that is the juxtaposition
|
|
rlm@10
|
1966 of those fns. The returned fn takes a variable number of args, and
|
|
rlm@10
|
1967 returns a vector containing the result of applying each fn to the
|
|
rlm@10
|
1968 args (left-to-right).
|
|
rlm@10
|
1969 ((juxt a b c) x) => [(a x) (b x) (c x)]"
|
|
rlm@10
|
1970 {:added "1.1"}
|
|
rlm@10
|
1971 ([f]
|
|
rlm@10
|
1972 (fn
|
|
rlm@10
|
1973 ([] [(f)])
|
|
rlm@10
|
1974 ([x] [(f x)])
|
|
rlm@10
|
1975 ([x y] [(f x y)])
|
|
rlm@10
|
1976 ([x y z] [(f x y z)])
|
|
rlm@10
|
1977 ([x y z & args] [(apply f x y z args)])))
|
|
rlm@10
|
1978 ([f g]
|
|
rlm@10
|
1979 (fn
|
|
rlm@10
|
1980 ([] [(f) (g)])
|
|
rlm@10
|
1981 ([x] [(f x) (g x)])
|
|
rlm@10
|
1982 ([x y] [(f x y) (g x y)])
|
|
rlm@10
|
1983 ([x y z] [(f x y z) (g x y z)])
|
|
rlm@10
|
1984 ([x y z & args] [(apply f x y z args) (apply g x y z args)])))
|
|
rlm@10
|
1985 ([f g h]
|
|
rlm@10
|
1986 (fn
|
|
rlm@10
|
1987 ([] [(f) (g) (h)])
|
|
rlm@10
|
1988 ([x] [(f x) (g x) (h x)])
|
|
rlm@10
|
1989 ([x y] [(f x y) (g x y) (h x y)])
|
|
rlm@10
|
1990 ([x y z] [(f x y z) (g x y z) (h x y z)])
|
|
rlm@10
|
1991 ([x y z & args] [(apply f x y z args) (apply g x y z args) (apply h x y z args)])))
|
|
rlm@10
|
1992 ([f g h & fs]
|
|
rlm@10
|
1993 (let [fs (list* f g h fs)]
|
|
rlm@10
|
1994 (fn
|
|
rlm@10
|
1995 ([] (reduce #(conj %1 (%2)) [] fs))
|
|
rlm@10
|
1996 ([x] (reduce #(conj %1 (%2 x)) [] fs))
|
|
rlm@10
|
1997 ([x y] (reduce #(conj %1 (%2 x y)) [] fs))
|
|
rlm@10
|
1998 ([x y z] (reduce #(conj %1 (%2 x y z)) [] fs))
|
|
rlm@10
|
1999 ([x y z & args] (reduce #(conj %1 (apply %2 x y z args)) [] fs))))))
|
|
rlm@10
|
2000
|
|
rlm@10
|
2001 (defn partial
|
|
rlm@10
|
2002 "Takes a function f and fewer than the normal arguments to f, and
|
|
rlm@10
|
2003 returns a fn that takes a variable number of additional args. When
|
|
rlm@10
|
2004 called, the returned function calls f with args + additional args."
|
|
rlm@10
|
2005 {:added "1.0"}
|
|
rlm@10
|
2006 ([f arg1]
|
|
rlm@10
|
2007 (fn [& args] (apply f arg1 args)))
|
|
rlm@10
|
2008 ([f arg1 arg2]
|
|
rlm@10
|
2009 (fn [& args] (apply f arg1 arg2 args)))
|
|
rlm@10
|
2010 ([f arg1 arg2 arg3]
|
|
rlm@10
|
2011 (fn [& args] (apply f arg1 arg2 arg3 args)))
|
|
rlm@10
|
2012 ([f arg1 arg2 arg3 & more]
|
|
rlm@10
|
2013 (fn [& args] (apply f arg1 arg2 arg3 (concat more args)))))
|
|
rlm@10
|
2014
|
|
rlm@10
|
2015 ;;;;;;;;;;;;;;;;;;; sequence fns ;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
2016 (defn sequence
|
|
rlm@10
|
2017 "Coerces coll to a (possibly empty) sequence, if it is not already
|
|
rlm@10
|
2018 one. Will not force a lazy seq. (sequence nil) yields ()"
|
|
rlm@10
|
2019 {:added "1.0"}
|
|
rlm@10
|
2020 [coll]
|
|
rlm@10
|
2021 (if (seq? coll) coll
|
|
rlm@10
|
2022 (or (seq coll) ())))
|
|
rlm@10
|
2023
|
|
rlm@10
|
2024 (defn every?
|
|
rlm@10
|
2025 "Returns true if (pred x) is logical true for every x in coll, else
|
|
rlm@10
|
2026 false."
|
|
rlm@10
|
2027 {:tag Boolean
|
|
rlm@10
|
2028 :added "1.0"}
|
|
rlm@10
|
2029 [pred coll]
|
|
rlm@10
|
2030 (cond
|
|
rlm@10
|
2031 (nil? (seq coll)) true
|
|
rlm@10
|
2032 (pred (first coll)) (recur pred (next coll))
|
|
rlm@10
|
2033 :else false))
|
|
rlm@10
|
2034
|
|
rlm@10
|
2035 (def
|
|
rlm@10
|
2036 ^{:tag Boolean
|
|
rlm@10
|
2037 :doc "Returns false if (pred x) is logical true for every x in
|
|
rlm@10
|
2038 coll, else true."
|
|
rlm@10
|
2039 :arglists '([pred coll])
|
|
rlm@10
|
2040 :added "1.0"}
|
|
rlm@10
|
2041 not-every? (comp not every?))
|
|
rlm@10
|
2042
|
|
rlm@10
|
2043 (defn some
|
|
rlm@10
|
2044 "Returns the first logical true value of (pred x) for any x in coll,
|
|
rlm@10
|
2045 else nil. One common idiom is to use a set as pred, for example
|
|
rlm@10
|
2046 this will return :fred if :fred is in the sequence, otherwise nil:
|
|
rlm@10
|
2047 (some #{:fred} coll)"
|
|
rlm@10
|
2048 {:added "1.0"}
|
|
rlm@10
|
2049 [pred coll]
|
|
rlm@10
|
2050 (when (seq coll)
|
|
rlm@10
|
2051 (or (pred (first coll)) (recur pred (next coll)))))
|
|
rlm@10
|
2052
|
|
rlm@10
|
2053 (def
|
|
rlm@10
|
2054 ^{:tag Boolean
|
|
rlm@10
|
2055 :doc "Returns false if (pred x) is logical true for any x in coll,
|
|
rlm@10
|
2056 else true."
|
|
rlm@10
|
2057 :arglists '([pred coll])
|
|
rlm@10
|
2058 :added "1.0"}
|
|
rlm@10
|
2059 not-any? (comp not some))
|
|
rlm@10
|
2060
|
|
rlm@10
|
2061 ;will be redefed later with arg checks
|
|
rlm@10
|
2062 (defmacro dotimes
|
|
rlm@10
|
2063 "bindings => name n
|
|
rlm@10
|
2064
|
|
rlm@10
|
2065 Repeatedly executes body (presumably for side-effects) with name
|
|
rlm@10
|
2066 bound to integers from 0 through n-1."
|
|
rlm@10
|
2067 {:added "1.0"}
|
|
rlm@10
|
2068 [bindings & body]
|
|
rlm@10
|
2069 (let [i (first bindings)
|
|
rlm@10
|
2070 n (second bindings)]
|
|
rlm@10
|
2071 `(let [n# (int ~n)]
|
|
rlm@10
|
2072 (loop [~i (int 0)]
|
|
rlm@10
|
2073 (when (< ~i n#)
|
|
rlm@10
|
2074 ~@body
|
|
rlm@10
|
2075 (recur (inc ~i)))))))
|
|
rlm@10
|
2076
|
|
rlm@10
|
2077 (defn map
|
|
rlm@10
|
2078 "Returns a lazy sequence consisting of the result of applying f to the
|
|
rlm@10
|
2079 set of first items of each coll, followed by applying f to the set
|
|
rlm@10
|
2080 of second items in each coll, until any one of the colls is
|
|
rlm@10
|
2081 exhausted. Any remaining items in other colls are ignored. Function
|
|
rlm@10
|
2082 f should accept number-of-colls arguments."
|
|
rlm@10
|
2083 {:added "1.0"}
|
|
rlm@10
|
2084 ([f coll]
|
|
rlm@10
|
2085 (lazy-seq
|
|
rlm@10
|
2086 (when-let [s (seq coll)]
|
|
rlm@10
|
2087 (if (chunked-seq? s)
|
|
rlm@10
|
2088 (let [c (chunk-first s)
|
|
rlm@10
|
2089 size (int (count c))
|
|
rlm@10
|
2090 b (chunk-buffer size)]
|
|
rlm@10
|
2091 (dotimes [i size]
|
|
rlm@10
|
2092 (chunk-append b (f (.nth c i))))
|
|
rlm@10
|
2093 (chunk-cons (chunk b) (map f (chunk-rest s))))
|
|
rlm@10
|
2094 (cons (f (first s)) (map f (rest s)))))))
|
|
rlm@10
|
2095 ([f c1 c2]
|
|
rlm@10
|
2096 (lazy-seq
|
|
rlm@10
|
2097 (let [s1 (seq c1) s2 (seq c2)]
|
|
rlm@10
|
2098 (when (and s1 s2)
|
|
rlm@10
|
2099 (cons (f (first s1) (first s2))
|
|
rlm@10
|
2100 (map f (rest s1) (rest s2)))))))
|
|
rlm@10
|
2101 ([f c1 c2 c3]
|
|
rlm@10
|
2102 (lazy-seq
|
|
rlm@10
|
2103 (let [s1 (seq c1) s2 (seq c2) s3 (seq c3)]
|
|
rlm@10
|
2104 (when (and s1 s2 s3)
|
|
rlm@10
|
2105 (cons (f (first s1) (first s2) (first s3))
|
|
rlm@10
|
2106 (map f (rest s1) (rest s2) (rest s3)))))))
|
|
rlm@10
|
2107 ([f c1 c2 c3 & colls]
|
|
rlm@10
|
2108 (let [step (fn step [cs]
|
|
rlm@10
|
2109 (lazy-seq
|
|
rlm@10
|
2110 (let [ss (map seq cs)]
|
|
rlm@10
|
2111 (when (every? identity ss)
|
|
rlm@10
|
2112 (cons (map first ss) (step (map rest ss)))))))]
|
|
rlm@10
|
2113 (map #(apply f %) (step (conj colls c3 c2 c1))))))
|
|
rlm@10
|
2114
|
|
rlm@10
|
2115 (defn mapcat
|
|
rlm@10
|
2116 "Returns the result of applying concat to the result of applying map
|
|
rlm@10
|
2117 to f and colls. Thus function f should return a collection."
|
|
rlm@10
|
2118 {:added "1.0"}
|
|
rlm@10
|
2119 [f & colls]
|
|
rlm@10
|
2120 (apply concat (apply map f colls)))
|
|
rlm@10
|
2121
|
|
rlm@10
|
2122 (defn filter
|
|
rlm@10
|
2123 "Returns a lazy sequence of the items in coll for which
|
|
rlm@10
|
2124 (pred item) returns true. pred must be free of side-effects."
|
|
rlm@10
|
2125 {:added "1.0"}
|
|
rlm@10
|
2126 ([pred coll]
|
|
rlm@10
|
2127 (lazy-seq
|
|
rlm@10
|
2128 (when-let [s (seq coll)]
|
|
rlm@10
|
2129 (if (chunked-seq? s)
|
|
rlm@10
|
2130 (let [c (chunk-first s)
|
|
rlm@10
|
2131 size (count c)
|
|
rlm@10
|
2132 b (chunk-buffer size)]
|
|
rlm@10
|
2133 (dotimes [i size]
|
|
rlm@10
|
2134 (when (pred (.nth c i))
|
|
rlm@10
|
2135 (chunk-append b (.nth c i))))
|
|
rlm@10
|
2136 (chunk-cons (chunk b) (filter pred (chunk-rest s))))
|
|
rlm@10
|
2137 (let [f (first s) r (rest s)]
|
|
rlm@10
|
2138 (if (pred f)
|
|
rlm@10
|
2139 (cons f (filter pred r))
|
|
rlm@10
|
2140 (filter pred r))))))))
|
|
rlm@10
|
2141
|
|
rlm@10
|
2142
|
|
rlm@10
|
2143 (defn remove
|
|
rlm@10
|
2144 "Returns a lazy sequence of the items in coll for which
|
|
rlm@10
|
2145 (pred item) returns false. pred must be free of side-effects."
|
|
rlm@10
|
2146 {:added "1.0"}
|
|
rlm@10
|
2147 [pred coll]
|
|
rlm@10
|
2148 (filter (complement pred) coll))
|
|
rlm@10
|
2149
|
|
rlm@10
|
2150 (defn take
|
|
rlm@10
|
2151 "Returns a lazy sequence of the first n items in coll, or all items if
|
|
rlm@10
|
2152 there are fewer than n."
|
|
rlm@10
|
2153 {:added "1.0"}
|
|
rlm@10
|
2154 [n coll]
|
|
rlm@10
|
2155 (lazy-seq
|
|
rlm@10
|
2156 (when (pos? n)
|
|
rlm@10
|
2157 (when-let [s (seq coll)]
|
|
rlm@10
|
2158 (cons (first s) (take (dec n) (rest s)))))))
|
|
rlm@10
|
2159
|
|
rlm@10
|
2160 (defn take-while
|
|
rlm@10
|
2161 "Returns a lazy sequence of successive items from coll while
|
|
rlm@10
|
2162 (pred item) returns true. pred must be free of side-effects."
|
|
rlm@10
|
2163 {:added "1.0"}
|
|
rlm@10
|
2164 [pred coll]
|
|
rlm@10
|
2165 (lazy-seq
|
|
rlm@10
|
2166 (when-let [s (seq coll)]
|
|
rlm@10
|
2167 (when (pred (first s))
|
|
rlm@10
|
2168 (cons (first s) (take-while pred (rest s)))))))
|
|
rlm@10
|
2169
|
|
rlm@10
|
2170 (defn drop
|
|
rlm@10
|
2171 "Returns a lazy sequence of all but the first n items in coll."
|
|
rlm@10
|
2172 {:added "1.0"}
|
|
rlm@10
|
2173 [n coll]
|
|
rlm@10
|
2174 (let [step (fn [n coll]
|
|
rlm@10
|
2175 (let [s (seq coll)]
|
|
rlm@10
|
2176 (if (and (pos? n) s)
|
|
rlm@10
|
2177 (recur (dec n) (rest s))
|
|
rlm@10
|
2178 s)))]
|
|
rlm@10
|
2179 (lazy-seq (step n coll))))
|
|
rlm@10
|
2180
|
|
rlm@10
|
2181 (defn drop-last
|
|
rlm@10
|
2182 "Return a lazy sequence of all but the last n (default 1) items in coll"
|
|
rlm@10
|
2183 {:added "1.0"}
|
|
rlm@10
|
2184 ([s] (drop-last 1 s))
|
|
rlm@10
|
2185 ([n s] (map (fn [x _] x) s (drop n s))))
|
|
rlm@10
|
2186
|
|
rlm@10
|
2187 (defn take-last
|
|
rlm@10
|
2188 "Returns a seq of the last n items in coll. Depending on the type
|
|
rlm@10
|
2189 of coll may be no better than linear time. For vectors, see also subvec."
|
|
rlm@10
|
2190 {:added "1.1"}
|
|
rlm@10
|
2191 [n coll]
|
|
rlm@10
|
2192 (loop [s (seq coll), lead (seq (drop n coll))]
|
|
rlm@10
|
2193 (if lead
|
|
rlm@10
|
2194 (recur (next s) (next lead))
|
|
rlm@10
|
2195 s)))
|
|
rlm@10
|
2196
|
|
rlm@10
|
2197 (defn drop-while
|
|
rlm@10
|
2198 "Returns a lazy sequence of the items in coll starting from the first
|
|
rlm@10
|
2199 item for which (pred item) returns nil."
|
|
rlm@10
|
2200 {:added "1.0"}
|
|
rlm@10
|
2201 [pred coll]
|
|
rlm@10
|
2202 (let [step (fn [pred coll]
|
|
rlm@10
|
2203 (let [s (seq coll)]
|
|
rlm@10
|
2204 (if (and s (pred (first s)))
|
|
rlm@10
|
2205 (recur pred (rest s))
|
|
rlm@10
|
2206 s)))]
|
|
rlm@10
|
2207 (lazy-seq (step pred coll))))
|
|
rlm@10
|
2208
|
|
rlm@10
|
2209 (defn cycle
|
|
rlm@10
|
2210 "Returns a lazy (infinite!) sequence of repetitions of the items in coll."
|
|
rlm@10
|
2211 {:added "1.0"}
|
|
rlm@10
|
2212 [coll] (lazy-seq
|
|
rlm@10
|
2213 (when-let [s (seq coll)]
|
|
rlm@10
|
2214 (concat s (cycle s)))))
|
|
rlm@10
|
2215
|
|
rlm@10
|
2216 (defn split-at
|
|
rlm@10
|
2217 "Returns a vector of [(take n coll) (drop n coll)]"
|
|
rlm@10
|
2218 {:added "1.0"}
|
|
rlm@10
|
2219 [n coll]
|
|
rlm@10
|
2220 [(take n coll) (drop n coll)])
|
|
rlm@10
|
2221
|
|
rlm@10
|
2222 (defn split-with
|
|
rlm@10
|
2223 "Returns a vector of [(take-while pred coll) (drop-while pred coll)]"
|
|
rlm@10
|
2224 {:added "1.0"}
|
|
rlm@10
|
2225 [pred coll]
|
|
rlm@10
|
2226 [(take-while pred coll) (drop-while pred coll)])
|
|
rlm@10
|
2227
|
|
rlm@10
|
2228 (defn repeat
|
|
rlm@10
|
2229 "Returns a lazy (infinite!, or length n if supplied) sequence of xs."
|
|
rlm@10
|
2230 {:added "1.0"}
|
|
rlm@10
|
2231 ([x] (lazy-seq (cons x (repeat x))))
|
|
rlm@10
|
2232 ([n x] (take n (repeat x))))
|
|
rlm@10
|
2233
|
|
rlm@10
|
2234 (defn replicate
|
|
rlm@10
|
2235 "Returns a lazy seq of n xs."
|
|
rlm@10
|
2236 {:added "1.0"}
|
|
rlm@10
|
2237 [n x] (take n (repeat x)))
|
|
rlm@10
|
2238
|
|
rlm@10
|
2239 (defn iterate
|
|
rlm@10
|
2240 "Returns a lazy sequence of x, (f x), (f (f x)) etc. f must be free of side-effects"
|
|
rlm@10
|
2241 {:added "1.0"}
|
|
rlm@10
|
2242 [f x] (cons x (lazy-seq (iterate f (f x)))))
|
|
rlm@10
|
2243
|
|
rlm@10
|
2244 (defn range
|
|
rlm@10
|
2245 "Returns a lazy seq of nums from start (inclusive) to end
|
|
rlm@10
|
2246 (exclusive), by step, where start defaults to 0, step to 1, and end
|
|
rlm@10
|
2247 to infinity."
|
|
rlm@10
|
2248 {:added "1.0"}
|
|
rlm@10
|
2249 ([] (range 0 Double/POSITIVE_INFINITY 1))
|
|
rlm@10
|
2250 ([end] (range 0 end 1))
|
|
rlm@10
|
2251 ([start end] (range start end 1))
|
|
rlm@10
|
2252 ([start end step]
|
|
rlm@10
|
2253 (lazy-seq
|
|
rlm@10
|
2254 (let [b (chunk-buffer 32)
|
|
rlm@10
|
2255 comp (if (pos? step) < >)]
|
|
rlm@10
|
2256 (loop [i start]
|
|
rlm@10
|
2257 (if (and (< (count b) 32)
|
|
rlm@10
|
2258 (comp i end))
|
|
rlm@10
|
2259 (do
|
|
rlm@10
|
2260 (chunk-append b i)
|
|
rlm@10
|
2261 (recur (+ i step)))
|
|
rlm@10
|
2262 (chunk-cons (chunk b)
|
|
rlm@10
|
2263 (when (comp i end)
|
|
rlm@10
|
2264 (range i end step)))))))))
|
|
rlm@10
|
2265
|
|
rlm@10
|
2266 (defn merge
|
|
rlm@10
|
2267 "Returns a map that consists of the rest of the maps conj-ed onto
|
|
rlm@10
|
2268 the first. If a key occurs in more than one map, the mapping from
|
|
rlm@10
|
2269 the latter (left-to-right) will be the mapping in the result."
|
|
rlm@10
|
2270 {:added "1.0"}
|
|
rlm@10
|
2271 [& maps]
|
|
rlm@10
|
2272 (when (some identity maps)
|
|
rlm@10
|
2273 (reduce #(conj (or %1 {}) %2) maps)))
|
|
rlm@10
|
2274
|
|
rlm@10
|
2275 (defn merge-with
|
|
rlm@10
|
2276 "Returns a map that consists of the rest of the maps conj-ed onto
|
|
rlm@10
|
2277 the first. If a key occurs in more than one map, the mapping(s)
|
|
rlm@10
|
2278 from the latter (left-to-right) will be combined with the mapping in
|
|
rlm@10
|
2279 the result by calling (f val-in-result val-in-latter)."
|
|
rlm@10
|
2280 {:added "1.0"}
|
|
rlm@10
|
2281 [f & maps]
|
|
rlm@10
|
2282 (when (some identity maps)
|
|
rlm@10
|
2283 (let [merge-entry (fn [m e]
|
|
rlm@10
|
2284 (let [k (key e) v (val e)]
|
|
rlm@10
|
2285 (if (contains? m k)
|
|
rlm@10
|
2286 (assoc m k (f (get m k) v))
|
|
rlm@10
|
2287 (assoc m k v))))
|
|
rlm@10
|
2288 merge2 (fn [m1 m2]
|
|
rlm@10
|
2289 (reduce merge-entry (or m1 {}) (seq m2)))]
|
|
rlm@10
|
2290 (reduce merge2 maps))))
|
|
rlm@10
|
2291
|
|
rlm@10
|
2292
|
|
rlm@10
|
2293
|
|
rlm@10
|
2294 (defn zipmap
|
|
rlm@10
|
2295 "Returns a map with the keys mapped to the corresponding vals."
|
|
rlm@10
|
2296 {:added "1.0"}
|
|
rlm@10
|
2297 [keys vals]
|
|
rlm@10
|
2298 (loop [map {}
|
|
rlm@10
|
2299 ks (seq keys)
|
|
rlm@10
|
2300 vs (seq vals)]
|
|
rlm@10
|
2301 (if (and ks vs)
|
|
rlm@10
|
2302 (recur (assoc map (first ks) (first vs))
|
|
rlm@10
|
2303 (next ks)
|
|
rlm@10
|
2304 (next vs))
|
|
rlm@10
|
2305 map)))
|
|
rlm@10
|
2306
|
|
rlm@10
|
2307 (defmacro declare
|
|
rlm@10
|
2308 "defs the supplied var names with no bindings, useful for making forward declarations."
|
|
rlm@10
|
2309 {:added "1.0"}
|
|
rlm@10
|
2310 [& names] `(do ~@(map #(list 'def (vary-meta % assoc :declared true)) names)))
|
|
rlm@10
|
2311
|
|
rlm@10
|
2312 (defn line-seq
|
|
rlm@10
|
2313 "Returns the lines of text from rdr as a lazy sequence of strings.
|
|
rlm@10
|
2314 rdr must implement java.io.BufferedReader."
|
|
rlm@10
|
2315 {:added "1.0"}
|
|
rlm@10
|
2316 [^java.io.BufferedReader rdr]
|
|
rlm@10
|
2317 (when-let [line (.readLine rdr)]
|
|
rlm@10
|
2318 (cons line (lazy-seq (line-seq rdr)))))
|
|
rlm@10
|
2319
|
|
rlm@10
|
2320 (defn comparator
|
|
rlm@10
|
2321 "Returns an implementation of java.util.Comparator based upon pred."
|
|
rlm@10
|
2322 {:added "1.0"}
|
|
rlm@10
|
2323 [pred]
|
|
rlm@10
|
2324 (fn [x y]
|
|
rlm@10
|
2325 (cond (pred x y) -1 (pred y x) 1 :else 0)))
|
|
rlm@10
|
2326
|
|
rlm@10
|
2327 (defn sort
|
|
rlm@10
|
2328 "Returns a sorted sequence of the items in coll. If no comparator is
|
|
rlm@10
|
2329 supplied, uses compare. comparator must
|
|
rlm@10
|
2330 implement java.util.Comparator."
|
|
rlm@10
|
2331 {:added "1.0"}
|
|
rlm@10
|
2332 ([coll]
|
|
rlm@10
|
2333 (sort compare coll))
|
|
rlm@10
|
2334 ([^java.util.Comparator comp coll]
|
|
rlm@10
|
2335 (if (seq coll)
|
|
rlm@10
|
2336 (let [a (to-array coll)]
|
|
rlm@10
|
2337 (. java.util.Arrays (sort a comp))
|
|
rlm@10
|
2338 (seq a))
|
|
rlm@10
|
2339 ())))
|
|
rlm@10
|
2340
|
|
rlm@10
|
2341 (defn sort-by
|
|
rlm@10
|
2342 "Returns a sorted sequence of the items in coll, where the sort
|
|
rlm@10
|
2343 order is determined by comparing (keyfn item). If no comparator is
|
|
rlm@10
|
2344 supplied, uses compare. comparator must
|
|
rlm@10
|
2345 implement java.util.Comparator."
|
|
rlm@10
|
2346 {:added "1.0"}
|
|
rlm@10
|
2347 ([keyfn coll]
|
|
rlm@10
|
2348 (sort-by keyfn compare coll))
|
|
rlm@10
|
2349 ([keyfn ^java.util.Comparator comp coll]
|
|
rlm@10
|
2350 (sort (fn [x y] (. comp (compare (keyfn x) (keyfn y)))) coll)))
|
|
rlm@10
|
2351
|
|
rlm@10
|
2352 (defn partition
|
|
rlm@10
|
2353 "Returns a lazy sequence of lists of n items each, at offsets step
|
|
rlm@10
|
2354 apart. If step is not supplied, defaults to n, i.e. the partitions
|
|
rlm@10
|
2355 do not overlap. If a pad collection is supplied, use its elements as
|
|
rlm@10
|
2356 necessary to complete last partition upto n items. In case there are
|
|
rlm@10
|
2357 not enough padding elements, return a partition with less than n items."
|
|
rlm@10
|
2358 {:added "1.0"}
|
|
rlm@10
|
2359 ([n coll]
|
|
rlm@10
|
2360 (partition n n coll))
|
|
rlm@10
|
2361 ([n step coll]
|
|
rlm@10
|
2362 (lazy-seq
|
|
rlm@10
|
2363 (when-let [s (seq coll)]
|
|
rlm@10
|
2364 (let [p (take n s)]
|
|
rlm@10
|
2365 (when (= n (count p))
|
|
rlm@10
|
2366 (cons p (partition n step (drop step s))))))))
|
|
rlm@10
|
2367 ([n step pad coll]
|
|
rlm@10
|
2368 (lazy-seq
|
|
rlm@10
|
2369 (when-let [s (seq coll)]
|
|
rlm@10
|
2370 (let [p (take n s)]
|
|
rlm@10
|
2371 (if (= n (count p))
|
|
rlm@10
|
2372 (cons p (partition n step pad (drop step s)))
|
|
rlm@10
|
2373 (list (take n (concat p pad)))))))))
|
|
rlm@10
|
2374
|
|
rlm@10
|
2375 ;; evaluation
|
|
rlm@10
|
2376
|
|
rlm@10
|
2377 (defn eval
|
|
rlm@10
|
2378 "Evaluates the form data structure (not text!) and returns the result."
|
|
rlm@10
|
2379 {:added "1.0"}
|
|
rlm@10
|
2380 [form] (. clojure.lang.Compiler (eval form)))
|
|
rlm@10
|
2381
|
|
rlm@10
|
2382 (defmacro doseq
|
|
rlm@10
|
2383 "Repeatedly executes body (presumably for side-effects) with
|
|
rlm@10
|
2384 bindings and filtering as provided by \"for\". Does not retain
|
|
rlm@10
|
2385 the head of the sequence. Returns nil."
|
|
rlm@10
|
2386 {:added "1.0"}
|
|
rlm@10
|
2387 [seq-exprs & body]
|
|
rlm@10
|
2388 (assert-args doseq
|
|
rlm@10
|
2389 (vector? seq-exprs) "a vector for its binding"
|
|
rlm@10
|
2390 (even? (count seq-exprs)) "an even number of forms in binding vector")
|
|
rlm@10
|
2391 (let [step (fn step [recform exprs]
|
|
rlm@10
|
2392 (if-not exprs
|
|
rlm@10
|
2393 [true `(do ~@body)]
|
|
rlm@10
|
2394 (let [k (first exprs)
|
|
rlm@10
|
2395 v (second exprs)]
|
|
rlm@10
|
2396 (if (keyword? k)
|
|
rlm@10
|
2397 (let [steppair (step recform (nnext exprs))
|
|
rlm@10
|
2398 needrec (steppair 0)
|
|
rlm@10
|
2399 subform (steppair 1)]
|
|
rlm@10
|
2400 (cond
|
|
rlm@10
|
2401 (= k :let) [needrec `(let ~v ~subform)]
|
|
rlm@10
|
2402 (= k :while) [false `(when ~v
|
|
rlm@10
|
2403 ~subform
|
|
rlm@10
|
2404 ~@(when needrec [recform]))]
|
|
rlm@10
|
2405 (= k :when) [false `(if ~v
|
|
rlm@10
|
2406 (do
|
|
rlm@10
|
2407 ~subform
|
|
rlm@10
|
2408 ~@(when needrec [recform]))
|
|
rlm@10
|
2409 ~recform)]))
|
|
rlm@10
|
2410 (let [seq- (gensym "seq_")
|
|
rlm@10
|
2411 chunk- (with-meta (gensym "chunk_")
|
|
rlm@10
|
2412 {:tag 'clojure.lang.IChunk})
|
|
rlm@10
|
2413 count- (gensym "count_")
|
|
rlm@10
|
2414 i- (gensym "i_")
|
|
rlm@10
|
2415 recform `(recur (next ~seq-) nil (int 0) (int 0))
|
|
rlm@10
|
2416 steppair (step recform (nnext exprs))
|
|
rlm@10
|
2417 needrec (steppair 0)
|
|
rlm@10
|
2418 subform (steppair 1)
|
|
rlm@10
|
2419 recform-chunk
|
|
rlm@10
|
2420 `(recur ~seq- ~chunk- ~count- (unchecked-inc ~i-))
|
|
rlm@10
|
2421 steppair-chunk (step recform-chunk (nnext exprs))
|
|
rlm@10
|
2422 subform-chunk (steppair-chunk 1)]
|
|
rlm@10
|
2423 [true
|
|
rlm@10
|
2424 `(loop [~seq- (seq ~v), ~chunk- nil,
|
|
rlm@10
|
2425 ~count- (int 0), ~i- (int 0)]
|
|
rlm@10
|
2426 (if (< ~i- ~count-)
|
|
rlm@10
|
2427 (let [~k (.nth ~chunk- ~i-)]
|
|
rlm@10
|
2428 ~subform-chunk
|
|
rlm@10
|
2429 ~@(when needrec [recform-chunk]))
|
|
rlm@10
|
2430 (when-let [~seq- (seq ~seq-)]
|
|
rlm@10
|
2431 (if (chunked-seq? ~seq-)
|
|
rlm@10
|
2432 (let [c# (chunk-first ~seq-)]
|
|
rlm@10
|
2433 (recur (chunk-rest ~seq-) c#
|
|
rlm@10
|
2434 (int (count c#)) (int 0)))
|
|
rlm@10
|
2435 (let [~k (first ~seq-)]
|
|
rlm@10
|
2436 ~subform
|
|
rlm@10
|
2437 ~@(when needrec [recform]))))))])))))]
|
|
rlm@10
|
2438 (nth (step nil (seq seq-exprs)) 1)))
|
|
rlm@10
|
2439
|
|
rlm@10
|
2440 (defn dorun
|
|
rlm@10
|
2441 "When lazy sequences are produced via functions that have side
|
|
rlm@10
|
2442 effects, any effects other than those needed to produce the first
|
|
rlm@10
|
2443 element in the seq do not occur until the seq is consumed. dorun can
|
|
rlm@10
|
2444 be used to force any effects. Walks through the successive nexts of
|
|
rlm@10
|
2445 the seq, does not retain the head and returns nil."
|
|
rlm@10
|
2446 {:added "1.0"}
|
|
rlm@10
|
2447 ([coll]
|
|
rlm@10
|
2448 (when (seq coll)
|
|
rlm@10
|
2449 (recur (next coll))))
|
|
rlm@10
|
2450 ([n coll]
|
|
rlm@10
|
2451 (when (and (seq coll) (pos? n))
|
|
rlm@10
|
2452 (recur (dec n) (next coll)))))
|
|
rlm@10
|
2453
|
|
rlm@10
|
2454 (defn doall
|
|
rlm@10
|
2455 "When lazy sequences are produced via functions that have side
|
|
rlm@10
|
2456 effects, any effects other than those needed to produce the first
|
|
rlm@10
|
2457 element in the seq do not occur until the seq is consumed. doall can
|
|
rlm@10
|
2458 be used to force any effects. Walks through the successive nexts of
|
|
rlm@10
|
2459 the seq, retains the head and returns it, thus causing the entire
|
|
rlm@10
|
2460 seq to reside in memory at one time."
|
|
rlm@10
|
2461 {:added "1.0"}
|
|
rlm@10
|
2462 ([coll]
|
|
rlm@10
|
2463 (dorun coll)
|
|
rlm@10
|
2464 coll)
|
|
rlm@10
|
2465 ([n coll]
|
|
rlm@10
|
2466 (dorun n coll)
|
|
rlm@10
|
2467 coll))
|
|
rlm@10
|
2468
|
|
rlm@10
|
2469 (defn await
|
|
rlm@10
|
2470 "Blocks the current thread (indefinitely!) until all actions
|
|
rlm@10
|
2471 dispatched thus far, from this thread or agent, to the agent(s) have
|
|
rlm@10
|
2472 occurred. Will block on failed agents. Will never return if
|
|
rlm@10
|
2473 a failed agent is restarted with :clear-actions true."
|
|
rlm@10
|
2474 {:added "1.0"}
|
|
rlm@10
|
2475 [& agents]
|
|
rlm@10
|
2476 (io! "await in transaction"
|
|
rlm@10
|
2477 (when *agent*
|
|
rlm@10
|
2478 (throw (new Exception "Can't await in agent action")))
|
|
rlm@10
|
2479 (let [latch (new java.util.concurrent.CountDownLatch (count agents))
|
|
rlm@10
|
2480 count-down (fn [agent] (. latch (countDown)) agent)]
|
|
rlm@10
|
2481 (doseq [agent agents]
|
|
rlm@10
|
2482 (send agent count-down))
|
|
rlm@10
|
2483 (. latch (await)))))
|
|
rlm@10
|
2484
|
|
rlm@10
|
2485 (defn await1 [^clojure.lang.Agent a]
|
|
rlm@10
|
2486 (when (pos? (.getQueueCount a))
|
|
rlm@10
|
2487 (await a))
|
|
rlm@10
|
2488 a)
|
|
rlm@10
|
2489
|
|
rlm@10
|
2490 (defn await-for
|
|
rlm@10
|
2491 "Blocks the current thread until all actions dispatched thus
|
|
rlm@10
|
2492 far (from this thread or agent) to the agents have occurred, or the
|
|
rlm@10
|
2493 timeout (in milliseconds) has elapsed. Returns nil if returning due
|
|
rlm@10
|
2494 to timeout, non-nil otherwise."
|
|
rlm@10
|
2495 {:added "1.0"}
|
|
rlm@10
|
2496 [timeout-ms & agents]
|
|
rlm@10
|
2497 (io! "await-for in transaction"
|
|
rlm@10
|
2498 (when *agent*
|
|
rlm@10
|
2499 (throw (new Exception "Can't await in agent action")))
|
|
rlm@10
|
2500 (let [latch (new java.util.concurrent.CountDownLatch (count agents))
|
|
rlm@10
|
2501 count-down (fn [agent] (. latch (countDown)) agent)]
|
|
rlm@10
|
2502 (doseq [agent agents]
|
|
rlm@10
|
2503 (send agent count-down))
|
|
rlm@10
|
2504 (. latch (await timeout-ms (. java.util.concurrent.TimeUnit MILLISECONDS))))))
|
|
rlm@10
|
2505
|
|
rlm@10
|
2506 (defmacro dotimes
|
|
rlm@10
|
2507 "bindings => name n
|
|
rlm@10
|
2508
|
|
rlm@10
|
2509 Repeatedly executes body (presumably for side-effects) with name
|
|
rlm@10
|
2510 bound to integers from 0 through n-1."
|
|
rlm@10
|
2511 {:added "1.0"}
|
|
rlm@10
|
2512 [bindings & body]
|
|
rlm@10
|
2513 (assert-args dotimes
|
|
rlm@10
|
2514 (vector? bindings) "a vector for its binding"
|
|
rlm@10
|
2515 (= 2 (count bindings)) "exactly 2 forms in binding vector")
|
|
rlm@10
|
2516 (let [i (first bindings)
|
|
rlm@10
|
2517 n (second bindings)]
|
|
rlm@10
|
2518 `(let [n# (int ~n)]
|
|
rlm@10
|
2519 (loop [~i (int 0)]
|
|
rlm@10
|
2520 (when (< ~i n#)
|
|
rlm@10
|
2521 ~@body
|
|
rlm@10
|
2522 (recur (unchecked-inc ~i)))))))
|
|
rlm@10
|
2523
|
|
rlm@10
|
2524 #_(defn into
|
|
rlm@10
|
2525 "Returns a new coll consisting of to-coll with all of the items of
|
|
rlm@10
|
2526 from-coll conjoined."
|
|
rlm@10
|
2527 {:added "1.0"}
|
|
rlm@10
|
2528 [to from]
|
|
rlm@10
|
2529 (let [ret to items (seq from)]
|
|
rlm@10
|
2530 (if items
|
|
rlm@10
|
2531 (recur (conj ret (first items)) (next items))
|
|
rlm@10
|
2532 ret)))
|
|
rlm@10
|
2533
|
|
rlm@10
|
2534 ;;;;;;;;;;;;;;;;;;;;; editable collections ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
2535 (defn transient
|
|
rlm@10
|
2536 "Alpha - subject to change.
|
|
rlm@10
|
2537 Returns a new, transient version of the collection, in constant time."
|
|
rlm@10
|
2538 {:added "1.1"}
|
|
rlm@10
|
2539 [^clojure.lang.IEditableCollection coll]
|
|
rlm@10
|
2540 (.asTransient coll))
|
|
rlm@10
|
2541
|
|
rlm@10
|
2542 (defn persistent!
|
|
rlm@10
|
2543 "Alpha - subject to change.
|
|
rlm@10
|
2544 Returns a new, persistent version of the transient collection, in
|
|
rlm@10
|
2545 constant time. The transient collection cannot be used after this
|
|
rlm@10
|
2546 call, any such use will throw an exception."
|
|
rlm@10
|
2547 {:added "1.1"}
|
|
rlm@10
|
2548 [^clojure.lang.ITransientCollection coll]
|
|
rlm@10
|
2549 (.persistent coll))
|
|
rlm@10
|
2550
|
|
rlm@10
|
2551 (defn conj!
|
|
rlm@10
|
2552 "Alpha - subject to change.
|
|
rlm@10
|
2553 Adds x to the transient collection, and return coll. The 'addition'
|
|
rlm@10
|
2554 may happen at different 'places' depending on the concrete type."
|
|
rlm@10
|
2555 {:added "1.1"}
|
|
rlm@10
|
2556 [^clojure.lang.ITransientCollection coll x]
|
|
rlm@10
|
2557 (.conj coll x))
|
|
rlm@10
|
2558
|
|
rlm@10
|
2559 (defn assoc!
|
|
rlm@10
|
2560 "Alpha - subject to change.
|
|
rlm@10
|
2561 When applied to a transient map, adds mapping of key(s) to
|
|
rlm@10
|
2562 val(s). When applied to a transient vector, sets the val at index.
|
|
rlm@10
|
2563 Note - index must be <= (count vector). Returns coll."
|
|
rlm@10
|
2564 {:added "1.1"}
|
|
rlm@10
|
2565 ([^clojure.lang.ITransientAssociative coll key val] (.assoc coll key val))
|
|
rlm@10
|
2566 ([^clojure.lang.ITransientAssociative coll key val & kvs]
|
|
rlm@10
|
2567 (let [ret (.assoc coll key val)]
|
|
rlm@10
|
2568 (if kvs
|
|
rlm@10
|
2569 (recur ret (first kvs) (second kvs) (nnext kvs))
|
|
rlm@10
|
2570 ret))))
|
|
rlm@10
|
2571
|
|
rlm@10
|
2572 (defn dissoc!
|
|
rlm@10
|
2573 "Alpha - subject to change.
|
|
rlm@10
|
2574 Returns a transient map that doesn't contain a mapping for key(s)."
|
|
rlm@10
|
2575 {:added "1.1"}
|
|
rlm@10
|
2576 ([^clojure.lang.ITransientMap map key] (.without map key))
|
|
rlm@10
|
2577 ([^clojure.lang.ITransientMap map key & ks]
|
|
rlm@10
|
2578 (let [ret (.without map key)]
|
|
rlm@10
|
2579 (if ks
|
|
rlm@10
|
2580 (recur ret (first ks) (next ks))
|
|
rlm@10
|
2581 ret))))
|
|
rlm@10
|
2582
|
|
rlm@10
|
2583 (defn pop!
|
|
rlm@10
|
2584 "Alpha - subject to change.
|
|
rlm@10
|
2585 Removes the last item from a transient vector. If
|
|
rlm@10
|
2586 the collection is empty, throws an exception. Returns coll"
|
|
rlm@10
|
2587 {:added "1.1"}
|
|
rlm@10
|
2588 [^clojure.lang.ITransientVector coll]
|
|
rlm@10
|
2589 (.pop coll))
|
|
rlm@10
|
2590
|
|
rlm@10
|
2591 (defn disj!
|
|
rlm@10
|
2592 "Alpha - subject to change.
|
|
rlm@10
|
2593 disj[oin]. Returns a transient set of the same (hashed/sorted) type, that
|
|
rlm@10
|
2594 does not contain key(s)."
|
|
rlm@10
|
2595 {:added "1.1"}
|
|
rlm@10
|
2596 ([set] set)
|
|
rlm@10
|
2597 ([^clojure.lang.ITransientSet set key]
|
|
rlm@10
|
2598 (. set (disjoin key)))
|
|
rlm@10
|
2599 ([set key & ks]
|
|
rlm@10
|
2600 (let [ret (disj set key)]
|
|
rlm@10
|
2601 (if ks
|
|
rlm@10
|
2602 (recur ret (first ks) (next ks))
|
|
rlm@10
|
2603 ret))))
|
|
rlm@10
|
2604
|
|
rlm@10
|
2605 ;redef into with batch support
|
|
rlm@10
|
2606 (defn into
|
|
rlm@10
|
2607 "Returns a new coll consisting of to-coll with all of the items of
|
|
rlm@10
|
2608 from-coll conjoined."
|
|
rlm@10
|
2609 {:added "1.0"}
|
|
rlm@10
|
2610 [to from]
|
|
rlm@10
|
2611 (if (instance? clojure.lang.IEditableCollection to)
|
|
rlm@10
|
2612 (persistent! (reduce conj! (transient to) from))
|
|
rlm@10
|
2613 (reduce conj to from)))
|
|
rlm@10
|
2614
|
|
rlm@10
|
2615 (defmacro import
|
|
rlm@10
|
2616 "import-list => (package-symbol class-name-symbols*)
|
|
rlm@10
|
2617
|
|
rlm@10
|
2618 For each name in class-name-symbols, adds a mapping from name to the
|
|
rlm@10
|
2619 class named by package.name to the current namespace. Use :import in the ns
|
|
rlm@10
|
2620 macro in preference to calling this directly."
|
|
rlm@10
|
2621 {:added "1.0"}
|
|
rlm@10
|
2622 [& import-symbols-or-lists]
|
|
rlm@10
|
2623 (let [specs (map #(if (and (seq? %) (= 'quote (first %))) (second %) %)
|
|
rlm@10
|
2624 import-symbols-or-lists)]
|
|
rlm@10
|
2625 `(do ~@(map #(list 'clojure.core/import* %)
|
|
rlm@10
|
2626 (reduce (fn [v spec]
|
|
rlm@10
|
2627 (if (symbol? spec)
|
|
rlm@10
|
2628 (conj v (name spec))
|
|
rlm@10
|
2629 (let [p (first spec) cs (rest spec)]
|
|
rlm@10
|
2630 (into v (map #(str p "." %) cs)))))
|
|
rlm@10
|
2631 [] specs)))))
|
|
rlm@10
|
2632
|
|
rlm@10
|
2633 (defn into-array
|
|
rlm@10
|
2634 "Returns an array with components set to the values in aseq. The array's
|
|
rlm@10
|
2635 component type is type if provided, or the type of the first value in
|
|
rlm@10
|
2636 aseq if present, or Object. All values in aseq must be compatible with
|
|
rlm@10
|
2637 the component type. Class objects for the primitive types can be obtained
|
|
rlm@10
|
2638 using, e.g., Integer/TYPE."
|
|
rlm@10
|
2639 {:added "1.0"}
|
|
rlm@10
|
2640 ([aseq]
|
|
rlm@10
|
2641 (clojure.lang.RT/seqToTypedArray (seq aseq)))
|
|
rlm@10
|
2642 ([type aseq]
|
|
rlm@10
|
2643 (clojure.lang.RT/seqToTypedArray type (seq aseq))))
|
|
rlm@10
|
2644
|
|
rlm@10
|
2645 (defn ^{:private true}
|
|
rlm@10
|
2646 array [& items]
|
|
rlm@10
|
2647 (into-array items))
|
|
rlm@10
|
2648
|
|
rlm@10
|
2649 (defn ^Class class
|
|
rlm@10
|
2650 "Returns the Class of x"
|
|
rlm@10
|
2651 {:added "1.0"}
|
|
rlm@10
|
2652 [^Object x] (if (nil? x) x (. x (getClass))))
|
|
rlm@10
|
2653
|
|
rlm@10
|
2654 (defn type
|
|
rlm@10
|
2655 "Returns the :type metadata of x, or its Class if none"
|
|
rlm@10
|
2656 {:added "1.0"}
|
|
rlm@10
|
2657 [x]
|
|
rlm@10
|
2658 (or (:type (meta x)) (class x)))
|
|
rlm@10
|
2659
|
|
rlm@10
|
2660 (defn num
|
|
rlm@10
|
2661 "Coerce to Number"
|
|
rlm@10
|
2662 {:tag Number
|
|
rlm@10
|
2663 :inline (fn [x] `(. clojure.lang.Numbers (num ~x)))
|
|
rlm@10
|
2664 :added "1.0"}
|
|
rlm@10
|
2665 [x] (. clojure.lang.Numbers (num x)))
|
|
rlm@10
|
2666
|
|
rlm@10
|
2667 (defn long
|
|
rlm@10
|
2668 "Coerce to long"
|
|
rlm@10
|
2669 {:tag Long
|
|
rlm@10
|
2670 :inline (fn [x] `(. clojure.lang.RT (longCast ~x)))
|
|
rlm@10
|
2671 :added "1.0"}
|
|
rlm@10
|
2672 [^Number x] (clojure.lang.RT/longCast x))
|
|
rlm@10
|
2673
|
|
rlm@10
|
2674 (defn float
|
|
rlm@10
|
2675 "Coerce to float"
|
|
rlm@10
|
2676 {:tag Float
|
|
rlm@10
|
2677 :inline (fn [x] `(. clojure.lang.RT (floatCast ~x)))
|
|
rlm@10
|
2678 :added "1.0"}
|
|
rlm@10
|
2679 [^Number x] (clojure.lang.RT/floatCast x))
|
|
rlm@10
|
2680
|
|
rlm@10
|
2681 (defn double
|
|
rlm@10
|
2682 "Coerce to double"
|
|
rlm@10
|
2683 {:tag Double
|
|
rlm@10
|
2684 :inline (fn [x] `(. clojure.lang.RT (doubleCast ~x)))
|
|
rlm@10
|
2685 :added "1.0"}
|
|
rlm@10
|
2686 [^Number x] (clojure.lang.RT/doubleCast x))
|
|
rlm@10
|
2687
|
|
rlm@10
|
2688 (defn short
|
|
rlm@10
|
2689 "Coerce to short"
|
|
rlm@10
|
2690 {:tag Short
|
|
rlm@10
|
2691 :inline (fn [x] `(. clojure.lang.RT (shortCast ~x)))
|
|
rlm@10
|
2692 :added "1.0"}
|
|
rlm@10
|
2693 [^Number x] (clojure.lang.RT/shortCast x))
|
|
rlm@10
|
2694
|
|
rlm@10
|
2695 (defn byte
|
|
rlm@10
|
2696 "Coerce to byte"
|
|
rlm@10
|
2697 {:tag Byte
|
|
rlm@10
|
2698 :inline (fn [x] `(. clojure.lang.RT (byteCast ~x)))
|
|
rlm@10
|
2699 :added "1.0"}
|
|
rlm@10
|
2700 [^Number x] (clojure.lang.RT/byteCast x))
|
|
rlm@10
|
2701
|
|
rlm@10
|
2702 (defn char
|
|
rlm@10
|
2703 "Coerce to char"
|
|
rlm@10
|
2704 {:tag Character
|
|
rlm@10
|
2705 :inline (fn [x] `(. clojure.lang.RT (charCast ~x)))
|
|
rlm@10
|
2706 :added "1.1"}
|
|
rlm@10
|
2707 [x] (. clojure.lang.RT (charCast x)))
|
|
rlm@10
|
2708
|
|
rlm@10
|
2709 (defn boolean
|
|
rlm@10
|
2710 "Coerce to boolean"
|
|
rlm@10
|
2711 {
|
|
rlm@10
|
2712 :inline (fn [x] `(. clojure.lang.RT (booleanCast ~x)))
|
|
rlm@10
|
2713 :added "1.0"}
|
|
rlm@10
|
2714 [x] (clojure.lang.RT/booleanCast x))
|
|
rlm@10
|
2715
|
|
rlm@10
|
2716 (defn number?
|
|
rlm@10
|
2717 "Returns true if x is a Number"
|
|
rlm@10
|
2718 {:added "1.0"}
|
|
rlm@10
|
2719 [x]
|
|
rlm@10
|
2720 (instance? Number x))
|
|
rlm@10
|
2721
|
|
rlm@10
|
2722 (defn integer?
|
|
rlm@10
|
2723 "Returns true if n is an integer"
|
|
rlm@10
|
2724 {:added "1.0"}
|
|
rlm@10
|
2725 [n]
|
|
rlm@10
|
2726 (or (instance? Integer n)
|
|
rlm@10
|
2727 (instance? Long n)
|
|
rlm@10
|
2728 (instance? BigInteger n)
|
|
rlm@10
|
2729 (instance? Short n)
|
|
rlm@10
|
2730 (instance? Byte n)))
|
|
rlm@10
|
2731
|
|
rlm@10
|
2732 (defn mod
|
|
rlm@10
|
2733 "Modulus of num and div. Truncates toward negative infinity."
|
|
rlm@10
|
2734 {:added "1.0"}
|
|
rlm@10
|
2735 [num div]
|
|
rlm@10
|
2736 (let [m (rem num div)]
|
|
rlm@10
|
2737 (if (or (zero? m) (pos? (* num div)))
|
|
rlm@10
|
2738 m
|
|
rlm@10
|
2739 (+ m div))))
|
|
rlm@10
|
2740
|
|
rlm@10
|
2741 (defn ratio?
|
|
rlm@10
|
2742 "Returns true if n is a Ratio"
|
|
rlm@10
|
2743 {:added "1.0"}
|
|
rlm@10
|
2744 [n] (instance? clojure.lang.Ratio n))
|
|
rlm@10
|
2745
|
|
rlm@10
|
2746 (defn numerator
|
|
rlm@10
|
2747 "Returns the numerator part of a Ratio."
|
|
rlm@10
|
2748 {:tag BigInteger
|
|
rlm@10
|
2749 :added "1.2"}
|
|
rlm@10
|
2750 [r]
|
|
rlm@10
|
2751 (.numerator ^clojure.lang.Ratio r))
|
|
rlm@10
|
2752
|
|
rlm@10
|
2753 (defn denominator
|
|
rlm@10
|
2754 "Returns the denominator part of a Ratio."
|
|
rlm@10
|
2755 {:tag BigInteger
|
|
rlm@10
|
2756 :added "1.2"}
|
|
rlm@10
|
2757 [r]
|
|
rlm@10
|
2758 (.denominator ^clojure.lang.Ratio r))
|
|
rlm@10
|
2759
|
|
rlm@10
|
2760 (defn decimal?
|
|
rlm@10
|
2761 "Returns true if n is a BigDecimal"
|
|
rlm@10
|
2762 {:added "1.0"}
|
|
rlm@10
|
2763 [n] (instance? BigDecimal n))
|
|
rlm@10
|
2764
|
|
rlm@10
|
2765 (defn float?
|
|
rlm@10
|
2766 "Returns true if n is a floating point number"
|
|
rlm@10
|
2767 {:added "1.0"}
|
|
rlm@10
|
2768 [n]
|
|
rlm@10
|
2769 (or (instance? Double n)
|
|
rlm@10
|
2770 (instance? Float n)))
|
|
rlm@10
|
2771
|
|
rlm@10
|
2772 (defn rational? [n]
|
|
rlm@10
|
2773 "Returns true if n is a rational number"
|
|
rlm@10
|
2774 {:added "1.0"}
|
|
rlm@10
|
2775 (or (integer? n) (ratio? n) (decimal? n)))
|
|
rlm@10
|
2776
|
|
rlm@10
|
2777 (defn bigint
|
|
rlm@10
|
2778 "Coerce to BigInteger"
|
|
rlm@10
|
2779 {:tag BigInteger
|
|
rlm@10
|
2780 :added "1.0"}
|
|
rlm@10
|
2781 [x] (cond
|
|
rlm@10
|
2782 (instance? BigInteger x) x
|
|
rlm@10
|
2783 (decimal? x) (.toBigInteger ^BigDecimal x)
|
|
rlm@10
|
2784 (ratio? x) (.bigIntegerValue ^clojure.lang.Ratio x)
|
|
rlm@10
|
2785 (number? x) (BigInteger/valueOf (long x))
|
|
rlm@10
|
2786 :else (BigInteger. x)))
|
|
rlm@10
|
2787
|
|
rlm@10
|
2788 (defn bigdec
|
|
rlm@10
|
2789 "Coerce to BigDecimal"
|
|
rlm@10
|
2790 {:tag BigDecimal
|
|
rlm@10
|
2791 :added "1.0"}
|
|
rlm@10
|
2792 [x] (cond
|
|
rlm@10
|
2793 (decimal? x) x
|
|
rlm@10
|
2794 (float? x) (. BigDecimal valueOf (double x))
|
|
rlm@10
|
2795 (ratio? x) (/ (BigDecimal. (.numerator x)) (.denominator x))
|
|
rlm@10
|
2796 (instance? BigInteger x) (BigDecimal. ^BigInteger x)
|
|
rlm@10
|
2797 (number? x) (BigDecimal/valueOf (long x))
|
|
rlm@10
|
2798 :else (BigDecimal. x)))
|
|
rlm@10
|
2799
|
|
rlm@10
|
2800 (def ^{:private true} print-initialized false)
|
|
rlm@10
|
2801
|
|
rlm@10
|
2802 (defmulti print-method (fn [x writer] (type x)))
|
|
rlm@10
|
2803 (defmulti print-dup (fn [x writer] (class x)))
|
|
rlm@10
|
2804
|
|
rlm@10
|
2805 (defn pr-on
|
|
rlm@10
|
2806 {:private true}
|
|
rlm@10
|
2807 [x w]
|
|
rlm@10
|
2808 (if *print-dup*
|
|
rlm@10
|
2809 (print-dup x w)
|
|
rlm@10
|
2810 (print-method x w))
|
|
rlm@10
|
2811 nil)
|
|
rlm@10
|
2812
|
|
rlm@10
|
2813 (defn pr
|
|
rlm@10
|
2814 "Prints the object(s) to the output stream that is the current value
|
|
rlm@10
|
2815 of *out*. Prints the object(s), separated by spaces if there is
|
|
rlm@10
|
2816 more than one. By default, pr and prn print in a way that objects
|
|
rlm@10
|
2817 can be read by the reader"
|
|
rlm@10
|
2818 {:dynamic true
|
|
rlm@10
|
2819 :added "1.0"}
|
|
rlm@10
|
2820 ([] nil)
|
|
rlm@10
|
2821 ([x]
|
|
rlm@10
|
2822 (pr-on x *out*))
|
|
rlm@10
|
2823 ([x & more]
|
|
rlm@10
|
2824 (pr x)
|
|
rlm@10
|
2825 (. *out* (append \space))
|
|
rlm@10
|
2826 (if-let [nmore (next more)]
|
|
rlm@10
|
2827 (recur (first more) nmore)
|
|
rlm@10
|
2828 (apply pr more))))
|
|
rlm@10
|
2829
|
|
rlm@10
|
2830 (defn newline
|
|
rlm@10
|
2831 "Writes a newline to the output stream that is the current value of
|
|
rlm@10
|
2832 *out*"
|
|
rlm@10
|
2833 {:added "1.0"}
|
|
rlm@10
|
2834 []
|
|
rlm@10
|
2835 (. *out* (append \newline))
|
|
rlm@10
|
2836 nil)
|
|
rlm@10
|
2837
|
|
rlm@10
|
2838 (defn flush
|
|
rlm@10
|
2839 "Flushes the output stream that is the current value of
|
|
rlm@10
|
2840 *out*"
|
|
rlm@10
|
2841 {:added "1.0"}
|
|
rlm@10
|
2842 []
|
|
rlm@10
|
2843 (. *out* (flush))
|
|
rlm@10
|
2844 nil)
|
|
rlm@10
|
2845
|
|
rlm@10
|
2846 (defn prn
|
|
rlm@10
|
2847 "Same as pr followed by (newline). Observes *flush-on-newline*"
|
|
rlm@10
|
2848 {:added "1.0"}
|
|
rlm@10
|
2849 [& more]
|
|
rlm@10
|
2850 (apply pr more)
|
|
rlm@10
|
2851 (newline)
|
|
rlm@10
|
2852 (when *flush-on-newline*
|
|
rlm@10
|
2853 (flush)))
|
|
rlm@10
|
2854
|
|
rlm@10
|
2855 (defn print
|
|
rlm@10
|
2856 "Prints the object(s) to the output stream that is the current value
|
|
rlm@10
|
2857 of *out*. print and println produce output for human consumption."
|
|
rlm@10
|
2858 {:added "1.0"}
|
|
rlm@10
|
2859 [& more]
|
|
rlm@10
|
2860 (binding [*print-readably* nil]
|
|
rlm@10
|
2861 (apply pr more)))
|
|
rlm@10
|
2862
|
|
rlm@10
|
2863 (defn println
|
|
rlm@10
|
2864 "Same as print followed by (newline)"
|
|
rlm@10
|
2865 {:added "1.0"}
|
|
rlm@10
|
2866 [& more]
|
|
rlm@10
|
2867 (binding [*print-readably* nil]
|
|
rlm@10
|
2868 (apply prn more)))
|
|
rlm@10
|
2869
|
|
rlm@10
|
2870 (defn read
|
|
rlm@10
|
2871 "Reads the next object from stream, which must be an instance of
|
|
rlm@10
|
2872 java.io.PushbackReader or some derivee. stream defaults to the
|
|
rlm@10
|
2873 current value of *in* ."
|
|
rlm@10
|
2874 {:added "1.0"}
|
|
rlm@10
|
2875 ([]
|
|
rlm@10
|
2876 (read *in*))
|
|
rlm@10
|
2877 ([stream]
|
|
rlm@10
|
2878 (read stream true nil))
|
|
rlm@10
|
2879 ([stream eof-error? eof-value]
|
|
rlm@10
|
2880 (read stream eof-error? eof-value false))
|
|
rlm@10
|
2881 ([stream eof-error? eof-value recursive?]
|
|
rlm@10
|
2882 (. clojure.lang.LispReader (read stream (boolean eof-error?) eof-value recursive?))))
|
|
rlm@10
|
2883
|
|
rlm@10
|
2884 (defn read-line
|
|
rlm@10
|
2885 "Reads the next line from stream that is the current value of *in* ."
|
|
rlm@10
|
2886 {:added "1.0"}
|
|
rlm@10
|
2887 []
|
|
rlm@10
|
2888 (if (instance? clojure.lang.LineNumberingPushbackReader *in*)
|
|
rlm@10
|
2889 (.readLine ^clojure.lang.LineNumberingPushbackReader *in*)
|
|
rlm@10
|
2890 (.readLine ^java.io.BufferedReader *in*)))
|
|
rlm@10
|
2891
|
|
rlm@10
|
2892 (defn read-string
|
|
rlm@10
|
2893 "Reads one object from the string s"
|
|
rlm@10
|
2894 {:added "1.0"}
|
|
rlm@10
|
2895 [s] (clojure.lang.RT/readString s))
|
|
rlm@10
|
2896
|
|
rlm@10
|
2897 (defn subvec
|
|
rlm@10
|
2898 "Returns a persistent vector of the items in vector from
|
|
rlm@10
|
2899 start (inclusive) to end (exclusive). If end is not supplied,
|
|
rlm@10
|
2900 defaults to (count vector). This operation is O(1) and very fast, as
|
|
rlm@10
|
2901 the resulting vector shares structure with the original and no
|
|
rlm@10
|
2902 trimming is done."
|
|
rlm@10
|
2903 {:added "1.0"}
|
|
rlm@10
|
2904 ([v start]
|
|
rlm@10
|
2905 (subvec v start (count v)))
|
|
rlm@10
|
2906 ([v start end]
|
|
rlm@10
|
2907 (. clojure.lang.RT (subvec v start end))))
|
|
rlm@10
|
2908
|
|
rlm@10
|
2909 (defmacro with-open
|
|
rlm@10
|
2910 "bindings => [name init ...]
|
|
rlm@10
|
2911
|
|
rlm@10
|
2912 Evaluates body in a try expression with names bound to the values
|
|
rlm@10
|
2913 of the inits, and a finally clause that calls (.close name) on each
|
|
rlm@10
|
2914 name in reverse order."
|
|
rlm@10
|
2915 {:added "1.0"}
|
|
rlm@10
|
2916 [bindings & body]
|
|
rlm@10
|
2917 (assert-args with-open
|
|
rlm@10
|
2918 (vector? bindings) "a vector for its binding"
|
|
rlm@10
|
2919 (even? (count bindings)) "an even number of forms in binding vector")
|
|
rlm@10
|
2920 (cond
|
|
rlm@10
|
2921 (= (count bindings) 0) `(do ~@body)
|
|
rlm@10
|
2922 (symbol? (bindings 0)) `(let ~(subvec bindings 0 2)
|
|
rlm@10
|
2923 (try
|
|
rlm@10
|
2924 (with-open ~(subvec bindings 2) ~@body)
|
|
rlm@10
|
2925 (finally
|
|
rlm@10
|
2926 (. ~(bindings 0) close))))
|
|
rlm@10
|
2927 :else (throw (IllegalArgumentException.
|
|
rlm@10
|
2928 "with-open only allows Symbols in bindings"))))
|
|
rlm@10
|
2929
|
|
rlm@10
|
2930 (defmacro doto
|
|
rlm@10
|
2931 "Evaluates x then calls all of the methods and functions with the
|
|
rlm@10
|
2932 value of x supplied at the front of the given arguments. The forms
|
|
rlm@10
|
2933 are evaluated in order. Returns x.
|
|
rlm@10
|
2934
|
|
rlm@10
|
2935 (doto (new java.util.HashMap) (.put \"a\" 1) (.put \"b\" 2))"
|
|
rlm@10
|
2936 {:added "1.0"}
|
|
rlm@10
|
2937 [x & forms]
|
|
rlm@10
|
2938 (let [gx (gensym)]
|
|
rlm@10
|
2939 `(let [~gx ~x]
|
|
rlm@10
|
2940 ~@(map (fn [f]
|
|
rlm@10
|
2941 (if (seq? f)
|
|
rlm@10
|
2942 `(~(first f) ~gx ~@(next f))
|
|
rlm@10
|
2943 `(~f ~gx)))
|
|
rlm@10
|
2944 forms)
|
|
rlm@10
|
2945 ~gx)))
|
|
rlm@10
|
2946
|
|
rlm@10
|
2947 (defmacro memfn
|
|
rlm@10
|
2948 "Expands into code that creates a fn that expects to be passed an
|
|
rlm@10
|
2949 object and any args and calls the named instance method on the
|
|
rlm@10
|
2950 object passing the args. Use when you want to treat a Java method as
|
|
rlm@10
|
2951 a first-class fn."
|
|
rlm@10
|
2952 {:added "1.0"}
|
|
rlm@10
|
2953 [name & args]
|
|
rlm@10
|
2954 `(fn [target# ~@args]
|
|
rlm@10
|
2955 (. target# (~name ~@args))))
|
|
rlm@10
|
2956
|
|
rlm@10
|
2957 (defmacro time
|
|
rlm@10
|
2958 "Evaluates expr and prints the time it took. Returns the value of
|
|
rlm@10
|
2959 expr."
|
|
rlm@10
|
2960 {:added "1.0"}
|
|
rlm@10
|
2961 [expr]
|
|
rlm@10
|
2962 `(let [start# (. System (nanoTime))
|
|
rlm@10
|
2963 ret# ~expr]
|
|
rlm@10
|
2964 (prn (str "Elapsed time: " (/ (double (- (. System (nanoTime)) start#)) 1000000.0) " msecs"))
|
|
rlm@10
|
2965 ret#))
|
|
rlm@10
|
2966
|
|
rlm@10
|
2967
|
|
rlm@10
|
2968
|
|
rlm@10
|
2969 (import '(java.lang.reflect Array))
|
|
rlm@10
|
2970
|
|
rlm@10
|
2971 (defn alength
|
|
rlm@10
|
2972 "Returns the length of the Java array. Works on arrays of all
|
|
rlm@10
|
2973 types."
|
|
rlm@10
|
2974 {:inline (fn [a] `(. clojure.lang.RT (alength ~a)))
|
|
rlm@10
|
2975 :added "1.0"}
|
|
rlm@10
|
2976 [array] (. clojure.lang.RT (alength array)))
|
|
rlm@10
|
2977
|
|
rlm@10
|
2978 (defn aclone
|
|
rlm@10
|
2979 "Returns a clone of the Java array. Works on arrays of known
|
|
rlm@10
|
2980 types."
|
|
rlm@10
|
2981 {:inline (fn [a] `(. clojure.lang.RT (aclone ~a)))
|
|
rlm@10
|
2982 :added "1.0"}
|
|
rlm@10
|
2983 [array] (. clojure.lang.RT (aclone array)))
|
|
rlm@10
|
2984
|
|
rlm@10
|
2985 (defn aget
|
|
rlm@10
|
2986 "Returns the value at the index/indices. Works on Java arrays of all
|
|
rlm@10
|
2987 types."
|
|
rlm@10
|
2988 {:inline (fn [a i] `(. clojure.lang.RT (aget ~a (int ~i))))
|
|
rlm@10
|
2989 :inline-arities #{2}
|
|
rlm@10
|
2990 :added "1.0"}
|
|
rlm@10
|
2991 ([array idx]
|
|
rlm@10
|
2992 (clojure.lang.Reflector/prepRet (. Array (get array idx))))
|
|
rlm@10
|
2993 ([array idx & idxs]
|
|
rlm@10
|
2994 (apply aget (aget array idx) idxs)))
|
|
rlm@10
|
2995
|
|
rlm@10
|
2996 (defn aset
|
|
rlm@10
|
2997 "Sets the value at the index/indices. Works on Java arrays of
|
|
rlm@10
|
2998 reference types. Returns val."
|
|
rlm@10
|
2999 {:inline (fn [a i v] `(. clojure.lang.RT (aset ~a (int ~i) ~v)))
|
|
rlm@10
|
3000 :inline-arities #{3}
|
|
rlm@10
|
3001 :added "1.0"}
|
|
rlm@10
|
3002 ([array idx val]
|
|
rlm@10
|
3003 (. Array (set array idx val))
|
|
rlm@10
|
3004 val)
|
|
rlm@10
|
3005 ([array idx idx2 & idxv]
|
|
rlm@10
|
3006 (apply aset (aget array idx) idx2 idxv)))
|
|
rlm@10
|
3007
|
|
rlm@10
|
3008 (defmacro
|
|
rlm@10
|
3009 ^{:private true}
|
|
rlm@10
|
3010 def-aset [name method coerce]
|
|
rlm@10
|
3011 `(defn ~name
|
|
rlm@10
|
3012 {:arglists '([~'array ~'idx ~'val] [~'array ~'idx ~'idx2 & ~'idxv])}
|
|
rlm@10
|
3013 ([array# idx# val#]
|
|
rlm@10
|
3014 (. Array (~method array# idx# (~coerce val#)))
|
|
rlm@10
|
3015 val#)
|
|
rlm@10
|
3016 ([array# idx# idx2# & idxv#]
|
|
rlm@10
|
3017 (apply ~name (aget array# idx#) idx2# idxv#))))
|
|
rlm@10
|
3018
|
|
rlm@10
|
3019 (def-aset
|
|
rlm@10
|
3020 ^{:doc "Sets the value at the index/indices. Works on arrays of int. Returns val."
|
|
rlm@10
|
3021 :added "1.0"}
|
|
rlm@10
|
3022 aset-int setInt int)
|
|
rlm@10
|
3023
|
|
rlm@10
|
3024 (def-aset
|
|
rlm@10
|
3025 ^{:doc "Sets the value at the index/indices. Works on arrays of long. Returns val."
|
|
rlm@10
|
3026 :added "1.0"}
|
|
rlm@10
|
3027 aset-long setLong long)
|
|
rlm@10
|
3028
|
|
rlm@10
|
3029 (def-aset
|
|
rlm@10
|
3030 ^{:doc "Sets the value at the index/indices. Works on arrays of boolean. Returns val."
|
|
rlm@10
|
3031 :added "1.0"}
|
|
rlm@10
|
3032 aset-boolean setBoolean boolean)
|
|
rlm@10
|
3033
|
|
rlm@10
|
3034 (def-aset
|
|
rlm@10
|
3035 ^{:doc "Sets the value at the index/indices. Works on arrays of float. Returns val."
|
|
rlm@10
|
3036 :added "1.0"}
|
|
rlm@10
|
3037 aset-float setFloat float)
|
|
rlm@10
|
3038
|
|
rlm@10
|
3039 (def-aset
|
|
rlm@10
|
3040 ^{:doc "Sets the value at the index/indices. Works on arrays of double. Returns val."
|
|
rlm@10
|
3041 :added "1.0"}
|
|
rlm@10
|
3042 aset-double setDouble double)
|
|
rlm@10
|
3043
|
|
rlm@10
|
3044 (def-aset
|
|
rlm@10
|
3045 ^{:doc "Sets the value at the index/indices. Works on arrays of short. Returns val."
|
|
rlm@10
|
3046 :added "1.0"}
|
|
rlm@10
|
3047 aset-short setShort short)
|
|
rlm@10
|
3048
|
|
rlm@10
|
3049 (def-aset
|
|
rlm@10
|
3050 ^{:doc "Sets the value at the index/indices. Works on arrays of byte. Returns val."
|
|
rlm@10
|
3051 :added "1.0"}
|
|
rlm@10
|
3052 aset-byte setByte byte)
|
|
rlm@10
|
3053
|
|
rlm@10
|
3054 (def-aset
|
|
rlm@10
|
3055 ^{:doc "Sets the value at the index/indices. Works on arrays of char. Returns val."
|
|
rlm@10
|
3056 :added "1.0"}
|
|
rlm@10
|
3057 aset-char setChar char)
|
|
rlm@10
|
3058
|
|
rlm@10
|
3059 (defn make-array
|
|
rlm@10
|
3060 "Creates and returns an array of instances of the specified class of
|
|
rlm@10
|
3061 the specified dimension(s). Note that a class object is required.
|
|
rlm@10
|
3062 Class objects can be obtained by using their imported or
|
|
rlm@10
|
3063 fully-qualified name. Class objects for the primitive types can be
|
|
rlm@10
|
3064 obtained using, e.g., Integer/TYPE."
|
|
rlm@10
|
3065 {:added "1.0"}
|
|
rlm@10
|
3066 ([^Class type len]
|
|
rlm@10
|
3067 (. Array (newInstance type (int len))))
|
|
rlm@10
|
3068 ([^Class type dim & more-dims]
|
|
rlm@10
|
3069 (let [dims (cons dim more-dims)
|
|
rlm@10
|
3070 ^"[I" dimarray (make-array (. Integer TYPE) (count dims))]
|
|
rlm@10
|
3071 (dotimes [i (alength dimarray)]
|
|
rlm@10
|
3072 (aset-int dimarray i (nth dims i)))
|
|
rlm@10
|
3073 (. Array (newInstance type dimarray)))))
|
|
rlm@10
|
3074
|
|
rlm@10
|
3075 (defn to-array-2d
|
|
rlm@10
|
3076 "Returns a (potentially-ragged) 2-dimensional array of Objects
|
|
rlm@10
|
3077 containing the contents of coll, which can be any Collection of any
|
|
rlm@10
|
3078 Collection."
|
|
rlm@10
|
3079 {:tag "[[Ljava.lang.Object;"
|
|
rlm@10
|
3080 :added "1.0"}
|
|
rlm@10
|
3081 [^java.util.Collection coll]
|
|
rlm@10
|
3082 (let [ret (make-array (. Class (forName "[Ljava.lang.Object;")) (. coll (size)))]
|
|
rlm@10
|
3083 (loop [i 0 xs (seq coll)]
|
|
rlm@10
|
3084 (when xs
|
|
rlm@10
|
3085 (aset ret i (to-array (first xs)))
|
|
rlm@10
|
3086 (recur (inc i) (next xs))))
|
|
rlm@10
|
3087 ret))
|
|
rlm@10
|
3088
|
|
rlm@10
|
3089 (defn macroexpand-1
|
|
rlm@10
|
3090 "If form represents a macro form, returns its expansion,
|
|
rlm@10
|
3091 else returns form."
|
|
rlm@10
|
3092 {:added "1.0"}
|
|
rlm@10
|
3093 [form]
|
|
rlm@10
|
3094 (. clojure.lang.Compiler (macroexpand1 form)))
|
|
rlm@10
|
3095
|
|
rlm@10
|
3096 (defn macroexpand
|
|
rlm@10
|
3097 "Repeatedly calls macroexpand-1 on form until it no longer
|
|
rlm@10
|
3098 represents a macro form, then returns it. Note neither
|
|
rlm@10
|
3099 macroexpand-1 nor macroexpand expand macros in subforms."
|
|
rlm@10
|
3100 {:added "1.0"}
|
|
rlm@10
|
3101 [form]
|
|
rlm@10
|
3102 (let [ex (macroexpand-1 form)]
|
|
rlm@10
|
3103 (if (identical? ex form)
|
|
rlm@10
|
3104 form
|
|
rlm@10
|
3105 (macroexpand ex))))
|
|
rlm@10
|
3106
|
|
rlm@10
|
3107 (defn create-struct
|
|
rlm@10
|
3108 "Returns a structure basis object."
|
|
rlm@10
|
3109 {:added "1.0"}
|
|
rlm@10
|
3110 [& keys]
|
|
rlm@10
|
3111 (. clojure.lang.PersistentStructMap (createSlotMap keys)))
|
|
rlm@10
|
3112
|
|
rlm@10
|
3113 (defmacro defstruct
|
|
rlm@10
|
3114 "Same as (def name (create-struct keys...))"
|
|
rlm@10
|
3115 {:added "1.0"}
|
|
rlm@10
|
3116 [name & keys]
|
|
rlm@10
|
3117 `(def ~name (create-struct ~@keys)))
|
|
rlm@10
|
3118
|
|
rlm@10
|
3119 (defn struct-map
|
|
rlm@10
|
3120 "Returns a new structmap instance with the keys of the
|
|
rlm@10
|
3121 structure-basis. keyvals may contain all, some or none of the basis
|
|
rlm@10
|
3122 keys - where values are not supplied they will default to nil.
|
|
rlm@10
|
3123 keyvals can also contain keys not in the basis."
|
|
rlm@10
|
3124 {:added "1.0"}
|
|
rlm@10
|
3125 [s & inits]
|
|
rlm@10
|
3126 (. clojure.lang.PersistentStructMap (create s inits)))
|
|
rlm@10
|
3127
|
|
rlm@10
|
3128 (defn struct
|
|
rlm@10
|
3129 "Returns a new structmap instance with the keys of the
|
|
rlm@10
|
3130 structure-basis. vals must be supplied for basis keys in order -
|
|
rlm@10
|
3131 where values are not supplied they will default to nil."
|
|
rlm@10
|
3132 {:added "1.0"}
|
|
rlm@10
|
3133 [s & vals]
|
|
rlm@10
|
3134 (. clojure.lang.PersistentStructMap (construct s vals)))
|
|
rlm@10
|
3135
|
|
rlm@10
|
3136 (defn accessor
|
|
rlm@10
|
3137 "Returns a fn that, given an instance of a structmap with the basis,
|
|
rlm@10
|
3138 returns the value at the key. The key must be in the basis. The
|
|
rlm@10
|
3139 returned function should be (slightly) more efficient than using
|
|
rlm@10
|
3140 get, but such use of accessors should be limited to known
|
|
rlm@10
|
3141 performance-critical areas."
|
|
rlm@10
|
3142 {:added "1.0"}
|
|
rlm@10
|
3143 [s key]
|
|
rlm@10
|
3144 (. clojure.lang.PersistentStructMap (getAccessor s key)))
|
|
rlm@10
|
3145
|
|
rlm@10
|
3146 (defn load-reader
|
|
rlm@10
|
3147 "Sequentially read and evaluate the set of forms contained in the
|
|
rlm@10
|
3148 stream/file"
|
|
rlm@10
|
3149 {:added "1.0"}
|
|
rlm@10
|
3150 [rdr] (. clojure.lang.Compiler (load rdr)))
|
|
rlm@10
|
3151
|
|
rlm@10
|
3152 (defn load-string
|
|
rlm@10
|
3153 "Sequentially read and evaluate the set of forms contained in the
|
|
rlm@10
|
3154 string"
|
|
rlm@10
|
3155 {:added "1.0"}
|
|
rlm@10
|
3156 [s]
|
|
rlm@10
|
3157 (let [rdr (-> (java.io.StringReader. s)
|
|
rlm@10
|
3158 (clojure.lang.LineNumberingPushbackReader.))]
|
|
rlm@10
|
3159 (load-reader rdr)))
|
|
rlm@10
|
3160
|
|
rlm@10
|
3161 (defn set
|
|
rlm@10
|
3162 "Returns a set of the distinct elements of coll."
|
|
rlm@10
|
3163 {:added "1.0"}
|
|
rlm@10
|
3164 [coll] (clojure.lang.PersistentHashSet/create ^clojure.lang.ISeq (seq coll)))
|
|
rlm@10
|
3165
|
|
rlm@10
|
3166 (defn ^{:private true}
|
|
rlm@10
|
3167 filter-key [keyfn pred amap]
|
|
rlm@10
|
3168 (loop [ret {} es (seq amap)]
|
|
rlm@10
|
3169 (if es
|
|
rlm@10
|
3170 (if (pred (keyfn (first es)))
|
|
rlm@10
|
3171 (recur (assoc ret (key (first es)) (val (first es))) (next es))
|
|
rlm@10
|
3172 (recur ret (next es)))
|
|
rlm@10
|
3173 ret)))
|
|
rlm@10
|
3174
|
|
rlm@10
|
3175 (defn find-ns
|
|
rlm@10
|
3176 "Returns the namespace named by the symbol or nil if it doesn't exist."
|
|
rlm@10
|
3177 {:added "1.0"}
|
|
rlm@10
|
3178 [sym] (clojure.lang.Namespace/find sym))
|
|
rlm@10
|
3179
|
|
rlm@10
|
3180 (defn create-ns
|
|
rlm@10
|
3181 "Create a new namespace named by the symbol if one doesn't already
|
|
rlm@10
|
3182 exist, returns it or the already-existing namespace of the same
|
|
rlm@10
|
3183 name."
|
|
rlm@10
|
3184 {:added "1.0"}
|
|
rlm@10
|
3185 [sym] (clojure.lang.Namespace/findOrCreate sym))
|
|
rlm@10
|
3186
|
|
rlm@10
|
3187 (defn remove-ns
|
|
rlm@10
|
3188 "Removes the namespace named by the symbol. Use with caution.
|
|
rlm@10
|
3189 Cannot be used to remove the clojure namespace."
|
|
rlm@10
|
3190 {:added "1.0"}
|
|
rlm@10
|
3191 [sym] (clojure.lang.Namespace/remove sym))
|
|
rlm@10
|
3192
|
|
rlm@10
|
3193 (defn all-ns
|
|
rlm@10
|
3194 "Returns a sequence of all namespaces."
|
|
rlm@10
|
3195 {:added "1.0"}
|
|
rlm@10
|
3196 [] (clojure.lang.Namespace/all))
|
|
rlm@10
|
3197
|
|
rlm@10
|
3198 (defn ^clojure.lang.Namespace the-ns
|
|
rlm@10
|
3199 "If passed a namespace, returns it. Else, when passed a symbol,
|
|
rlm@10
|
3200 returns the namespace named by it, throwing an exception if not
|
|
rlm@10
|
3201 found."
|
|
rlm@10
|
3202 {:added "1.0"}
|
|
rlm@10
|
3203 [x]
|
|
rlm@10
|
3204 (if (instance? clojure.lang.Namespace x)
|
|
rlm@10
|
3205 x
|
|
rlm@10
|
3206 (or (find-ns x) (throw (Exception. (str "No namespace: " x " found"))))))
|
|
rlm@10
|
3207
|
|
rlm@10
|
3208 (defn ns-name
|
|
rlm@10
|
3209 "Returns the name of the namespace, a symbol."
|
|
rlm@10
|
3210 {:added "1.0"}
|
|
rlm@10
|
3211 [ns]
|
|
rlm@10
|
3212 (.getName (the-ns ns)))
|
|
rlm@10
|
3213
|
|
rlm@10
|
3214 (defn ns-map
|
|
rlm@10
|
3215 "Returns a map of all the mappings for the namespace."
|
|
rlm@10
|
3216 {:added "1.0"}
|
|
rlm@10
|
3217 [ns]
|
|
rlm@10
|
3218 (.getMappings (the-ns ns)))
|
|
rlm@10
|
3219
|
|
rlm@10
|
3220 (defn ns-unmap
|
|
rlm@10
|
3221 "Removes the mappings for the symbol from the namespace."
|
|
rlm@10
|
3222 {:added "1.0"}
|
|
rlm@10
|
3223 [ns sym]
|
|
rlm@10
|
3224 (.unmap (the-ns ns) sym))
|
|
rlm@10
|
3225
|
|
rlm@10
|
3226 ;(defn export [syms]
|
|
rlm@10
|
3227 ; (doseq [sym syms]
|
|
rlm@10
|
3228 ; (.. *ns* (intern sym) (setExported true))))
|
|
rlm@10
|
3229
|
|
rlm@10
|
3230 (defn ns-publics
|
|
rlm@10
|
3231 "Returns a map of the public intern mappings for the namespace."
|
|
rlm@10
|
3232 {:added "1.0"}
|
|
rlm@10
|
3233 [ns]
|
|
rlm@10
|
3234 (let [ns (the-ns ns)]
|
|
rlm@10
|
3235 (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v)
|
|
rlm@10
|
3236 (= ns (.ns v))
|
|
rlm@10
|
3237 (.isPublic v)))
|
|
rlm@10
|
3238 (ns-map ns))))
|
|
rlm@10
|
3239
|
|
rlm@10
|
3240 (defn ns-imports
|
|
rlm@10
|
3241 "Returns a map of the import mappings for the namespace."
|
|
rlm@10
|
3242 {:added "1.0"}
|
|
rlm@10
|
3243 [ns]
|
|
rlm@10
|
3244 (filter-key val (partial instance? Class) (ns-map ns)))
|
|
rlm@10
|
3245
|
|
rlm@10
|
3246 (defn ns-interns
|
|
rlm@10
|
3247 "Returns a map of the intern mappings for the namespace."
|
|
rlm@10
|
3248 {:added "1.0"}
|
|
rlm@10
|
3249 [ns]
|
|
rlm@10
|
3250 (let [ns (the-ns ns)]
|
|
rlm@10
|
3251 (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v)
|
|
rlm@10
|
3252 (= ns (.ns v))))
|
|
rlm@10
|
3253 (ns-map ns))))
|
|
rlm@10
|
3254
|
|
rlm@10
|
3255 (defn refer
|
|
rlm@10
|
3256 "refers to all public vars of ns, subject to filters.
|
|
rlm@10
|
3257 filters can include at most one each of:
|
|
rlm@10
|
3258
|
|
rlm@10
|
3259 :exclude list-of-symbols
|
|
rlm@10
|
3260 :only list-of-symbols
|
|
rlm@10
|
3261 :rename map-of-fromsymbol-tosymbol
|
|
rlm@10
|
3262
|
|
rlm@10
|
3263 For each public interned var in the namespace named by the symbol,
|
|
rlm@10
|
3264 adds a mapping from the name of the var to the var to the current
|
|
rlm@10
|
3265 namespace. Throws an exception if name is already mapped to
|
|
rlm@10
|
3266 something else in the current namespace. Filters can be used to
|
|
rlm@10
|
3267 select a subset, via inclusion or exclusion, or to provide a mapping
|
|
rlm@10
|
3268 to a symbol different from the var's name, in order to prevent
|
|
rlm@10
|
3269 clashes. Use :use in the ns macro in preference to calling this directly."
|
|
rlm@10
|
3270 {:added "1.0"}
|
|
rlm@10
|
3271 [ns-sym & filters]
|
|
rlm@10
|
3272 (let [ns (or (find-ns ns-sym) (throw (new Exception (str "No namespace: " ns-sym))))
|
|
rlm@10
|
3273 fs (apply hash-map filters)
|
|
rlm@10
|
3274 nspublics (ns-publics ns)
|
|
rlm@10
|
3275 rename (or (:rename fs) {})
|
|
rlm@10
|
3276 exclude (set (:exclude fs))
|
|
rlm@10
|
3277 to-do (or (:only fs) (keys nspublics))]
|
|
rlm@10
|
3278 (doseq [sym to-do]
|
|
rlm@10
|
3279 (when-not (exclude sym)
|
|
rlm@10
|
3280 (let [v (nspublics sym)]
|
|
rlm@10
|
3281 (when-not v
|
|
rlm@10
|
3282 (throw (new java.lang.IllegalAccessError
|
|
rlm@10
|
3283 (if (get (ns-interns ns) sym)
|
|
rlm@10
|
3284 (str sym " is not public")
|
|
rlm@10
|
3285 (str sym " does not exist")))))
|
|
rlm@10
|
3286 (. *ns* (refer (or (rename sym) sym) v)))))))
|
|
rlm@10
|
3287
|
|
rlm@10
|
3288 (defn ns-refers
|
|
rlm@10
|
3289 "Returns a map of the refer mappings for the namespace."
|
|
rlm@10
|
3290 {:added "1.0"}
|
|
rlm@10
|
3291 [ns]
|
|
rlm@10
|
3292 (let [ns (the-ns ns)]
|
|
rlm@10
|
3293 (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v)
|
|
rlm@10
|
3294 (not= ns (.ns v))))
|
|
rlm@10
|
3295 (ns-map ns))))
|
|
rlm@10
|
3296
|
|
rlm@10
|
3297 (defn alias
|
|
rlm@10
|
3298 "Add an alias in the current namespace to another
|
|
rlm@10
|
3299 namespace. Arguments are two symbols: the alias to be used, and
|
|
rlm@10
|
3300 the symbolic name of the target namespace. Use :as in the ns macro in preference
|
|
rlm@10
|
3301 to calling this directly."
|
|
rlm@10
|
3302 {:added "1.0"}
|
|
rlm@10
|
3303 [alias namespace-sym]
|
|
rlm@10
|
3304 (.addAlias *ns* alias (find-ns namespace-sym)))
|
|
rlm@10
|
3305
|
|
rlm@10
|
3306 (defn ns-aliases
|
|
rlm@10
|
3307 "Returns a map of the aliases for the namespace."
|
|
rlm@10
|
3308 {:added "1.0"}
|
|
rlm@10
|
3309 [ns]
|
|
rlm@10
|
3310 (.getAliases (the-ns ns)))
|
|
rlm@10
|
3311
|
|
rlm@10
|
3312 (defn ns-unalias
|
|
rlm@10
|
3313 "Removes the alias for the symbol from the namespace."
|
|
rlm@10
|
3314 {:added "1.0"}
|
|
rlm@10
|
3315 [ns sym]
|
|
rlm@10
|
3316 (.removeAlias (the-ns ns) sym))
|
|
rlm@10
|
3317
|
|
rlm@10
|
3318 (defn take-nth
|
|
rlm@10
|
3319 "Returns a lazy seq of every nth item in coll."
|
|
rlm@10
|
3320 {:added "1.0"}
|
|
rlm@10
|
3321 [n coll]
|
|
rlm@10
|
3322 (lazy-seq
|
|
rlm@10
|
3323 (when-let [s (seq coll)]
|
|
rlm@10
|
3324 (cons (first s) (take-nth n (drop n s))))))
|
|
rlm@10
|
3325
|
|
rlm@10
|
3326 (defn interleave
|
|
rlm@10
|
3327 "Returns a lazy seq of the first item in each coll, then the second etc."
|
|
rlm@10
|
3328 {:added "1.0"}
|
|
rlm@10
|
3329 ([c1 c2]
|
|
rlm@10
|
3330 (lazy-seq
|
|
rlm@10
|
3331 (let [s1 (seq c1) s2 (seq c2)]
|
|
rlm@10
|
3332 (when (and s1 s2)
|
|
rlm@10
|
3333 (cons (first s1) (cons (first s2)
|
|
rlm@10
|
3334 (interleave (rest s1) (rest s2))))))))
|
|
rlm@10
|
3335 ([c1 c2 & colls]
|
|
rlm@10
|
3336 (lazy-seq
|
|
rlm@10
|
3337 (let [ss (map seq (conj colls c2 c1))]
|
|
rlm@10
|
3338 (when (every? identity ss)
|
|
rlm@10
|
3339 (concat (map first ss) (apply interleave (map rest ss))))))))
|
|
rlm@10
|
3340
|
|
rlm@10
|
3341 (defn var-get
|
|
rlm@10
|
3342 "Gets the value in the var object"
|
|
rlm@10
|
3343 {:added "1.0"}
|
|
rlm@10
|
3344 [^clojure.lang.Var x] (. x (get)))
|
|
rlm@10
|
3345
|
|
rlm@10
|
3346 (defn var-set
|
|
rlm@10
|
3347 "Sets the value in the var object to val. The var must be
|
|
rlm@10
|
3348 thread-locally bound."
|
|
rlm@10
|
3349 {:added "1.0"}
|
|
rlm@10
|
3350 [^clojure.lang.Var x val] (. x (set val)))
|
|
rlm@10
|
3351
|
|
rlm@10
|
3352 (defmacro with-local-vars
|
|
rlm@10
|
3353 "varbinding=> symbol init-expr
|
|
rlm@10
|
3354
|
|
rlm@10
|
3355 Executes the exprs in a context in which the symbols are bound to
|
|
rlm@10
|
3356 vars with per-thread bindings to the init-exprs. The symbols refer
|
|
rlm@10
|
3357 to the var objects themselves, and must be accessed with var-get and
|
|
rlm@10
|
3358 var-set"
|
|
rlm@10
|
3359 {:added "1.0"}
|
|
rlm@10
|
3360 [name-vals-vec & body]
|
|
rlm@10
|
3361 (assert-args with-local-vars
|
|
rlm@10
|
3362 (vector? name-vals-vec) "a vector for its binding"
|
|
rlm@10
|
3363 (even? (count name-vals-vec)) "an even number of forms in binding vector")
|
|
rlm@10
|
3364 `(let [~@(interleave (take-nth 2 name-vals-vec)
|
|
rlm@10
|
3365 (repeat '(. clojure.lang.Var (create))))]
|
|
rlm@10
|
3366 (. clojure.lang.Var (pushThreadBindings (hash-map ~@name-vals-vec)))
|
|
rlm@10
|
3367 (try
|
|
rlm@10
|
3368 ~@body
|
|
rlm@10
|
3369 (finally (. clojure.lang.Var (popThreadBindings))))))
|
|
rlm@10
|
3370
|
|
rlm@10
|
3371 (defn ns-resolve
|
|
rlm@10
|
3372 "Returns the var or Class to which a symbol will be resolved in the
|
|
rlm@10
|
3373 namespace, else nil. Note that if the symbol is fully qualified,
|
|
rlm@10
|
3374 the var/Class to which it resolves need not be present in the
|
|
rlm@10
|
3375 namespace."
|
|
rlm@10
|
3376 {:added "1.0"}
|
|
rlm@10
|
3377 [ns sym]
|
|
rlm@10
|
3378 (clojure.lang.Compiler/maybeResolveIn (the-ns ns) sym))
|
|
rlm@10
|
3379
|
|
rlm@10
|
3380 (defn resolve
|
|
rlm@10
|
3381 "same as (ns-resolve *ns* symbol)"
|
|
rlm@10
|
3382 {:added "1.0"}
|
|
rlm@10
|
3383 [sym] (ns-resolve *ns* sym))
|
|
rlm@10
|
3384
|
|
rlm@10
|
3385 (defn array-map
|
|
rlm@10
|
3386 "Constructs an array-map."
|
|
rlm@10
|
3387 {:added "1.0"}
|
|
rlm@10
|
3388 ([] (. clojure.lang.PersistentArrayMap EMPTY))
|
|
rlm@10
|
3389 ([& keyvals] (clojure.lang.PersistentArrayMap/createWithCheck (to-array keyvals))))
|
|
rlm@10
|
3390
|
|
rlm@10
|
3391 (defn nthnext
|
|
rlm@10
|
3392 "Returns the nth next of coll, (seq coll) when n is 0."
|
|
rlm@10
|
3393 {:added "1.0"}
|
|
rlm@10
|
3394 [coll n]
|
|
rlm@10
|
3395 (loop [n n xs (seq coll)]
|
|
rlm@10
|
3396 (if (and xs (pos? n))
|
|
rlm@10
|
3397 (recur (dec n) (next xs))
|
|
rlm@10
|
3398 xs)))
|
|
rlm@10
|
3399
|
|
rlm@10
|
3400
|
|
rlm@10
|
3401 ;redefine let and loop with destructuring
|
|
rlm@10
|
3402 (defn destructure [bindings]
|
|
rlm@10
|
3403 (let [bents (partition 2 bindings)
|
|
rlm@10
|
3404 pb (fn pb [bvec b v]
|
|
rlm@10
|
3405 (let [pvec
|
|
rlm@10
|
3406 (fn [bvec b val]
|
|
rlm@10
|
3407 (let [gvec (gensym "vec__")]
|
|
rlm@10
|
3408 (loop [ret (-> bvec (conj gvec) (conj val))
|
|
rlm@10
|
3409 n 0
|
|
rlm@10
|
3410 bs b
|
|
rlm@10
|
3411 seen-rest? false]
|
|
rlm@10
|
3412 (if (seq bs)
|
|
rlm@10
|
3413 (let [firstb (first bs)]
|
|
rlm@10
|
3414 (cond
|
|
rlm@10
|
3415 (= firstb '&) (recur (pb ret (second bs) (list `nthnext gvec n))
|
|
rlm@10
|
3416 n
|
|
rlm@10
|
3417 (nnext bs)
|
|
rlm@10
|
3418 true)
|
|
rlm@10
|
3419 (= firstb :as) (pb ret (second bs) gvec)
|
|
rlm@10
|
3420 :else (if seen-rest?
|
|
rlm@10
|
3421 (throw (new Exception "Unsupported binding form, only :as can follow & parameter"))
|
|
rlm@10
|
3422 (recur (pb ret firstb (list `nth gvec n nil))
|
|
rlm@10
|
3423 (inc n)
|
|
rlm@10
|
3424 (next bs)
|
|
rlm@10
|
3425 seen-rest?))))
|
|
rlm@10
|
3426 ret))))
|
|
rlm@10
|
3427 pmap
|
|
rlm@10
|
3428 (fn [bvec b v]
|
|
rlm@10
|
3429 (let [gmap (or (:as b) (gensym "map__"))
|
|
rlm@10
|
3430 defaults (:or b)]
|
|
rlm@10
|
3431 (loop [ret (-> bvec (conj gmap) (conj v)
|
|
rlm@10
|
3432 (conj gmap) (conj `(if (seq? ~gmap) (apply hash-map ~gmap) ~gmap)))
|
|
rlm@10
|
3433 bes (reduce
|
|
rlm@10
|
3434 (fn [bes entry]
|
|
rlm@10
|
3435 (reduce #(assoc %1 %2 ((val entry) %2))
|
|
rlm@10
|
3436 (dissoc bes (key entry))
|
|
rlm@10
|
3437 ((key entry) bes)))
|
|
rlm@10
|
3438 (dissoc b :as :or)
|
|
rlm@10
|
3439 {:keys #(keyword (str %)), :strs str, :syms #(list `quote %)})]
|
|
rlm@10
|
3440 (if (seq bes)
|
|
rlm@10
|
3441 (let [bb (key (first bes))
|
|
rlm@10
|
3442 bk (val (first bes))
|
|
rlm@10
|
3443 has-default (contains? defaults bb)]
|
|
rlm@10
|
3444 (recur (pb ret bb (if has-default
|
|
rlm@10
|
3445 (list `get gmap bk (defaults bb))
|
|
rlm@10
|
3446 (list `get gmap bk)))
|
|
rlm@10
|
3447 (next bes)))
|
|
rlm@10
|
3448 ret))))]
|
|
rlm@10
|
3449 (cond
|
|
rlm@10
|
3450 (symbol? b) (-> bvec (conj b) (conj v))
|
|
rlm@10
|
3451 (vector? b) (pvec bvec b v)
|
|
rlm@10
|
3452 (map? b) (pmap bvec b v)
|
|
rlm@10
|
3453 :else (throw (new Exception (str "Unsupported binding form: " b))))))
|
|
rlm@10
|
3454 process-entry (fn [bvec b] (pb bvec (first b) (second b)))]
|
|
rlm@10
|
3455 (if (every? symbol? (map first bents))
|
|
rlm@10
|
3456 bindings
|
|
rlm@10
|
3457 (reduce process-entry [] bents))))
|
|
rlm@10
|
3458
|
|
rlm@10
|
3459 (defmacro let
|
|
rlm@10
|
3460 "Evaluates the exprs in a lexical context in which the symbols in
|
|
rlm@10
|
3461 the binding-forms are bound to their respective init-exprs or parts
|
|
rlm@10
|
3462 therein."
|
|
rlm@10
|
3463 {:added "1.0"}
|
|
rlm@10
|
3464 [bindings & body]
|
|
rlm@10
|
3465 (assert-args let
|
|
rlm@10
|
3466 (vector? bindings) "a vector for its binding"
|
|
rlm@10
|
3467 (even? (count bindings)) "an even number of forms in binding vector")
|
|
rlm@10
|
3468 `(let* ~(destructure bindings) ~@body))
|
|
rlm@10
|
3469
|
|
rlm@10
|
3470 (defn ^{:private true}
|
|
rlm@10
|
3471 maybe-destructured
|
|
rlm@10
|
3472 [params body]
|
|
rlm@10
|
3473 (if (every? symbol? params)
|
|
rlm@10
|
3474 (cons params body)
|
|
rlm@10
|
3475 (loop [params params
|
|
rlm@10
|
3476 new-params []
|
|
rlm@10
|
3477 lets []]
|
|
rlm@10
|
3478 (if params
|
|
rlm@10
|
3479 (if (symbol? (first params))
|
|
rlm@10
|
3480 (recur (next params) (conj new-params (first params)) lets)
|
|
rlm@10
|
3481 (let [gparam (gensym "p__")]
|
|
rlm@10
|
3482 (recur (next params) (conj new-params gparam)
|
|
rlm@10
|
3483 (-> lets (conj (first params)) (conj gparam)))))
|
|
rlm@10
|
3484 `(~new-params
|
|
rlm@10
|
3485 (let ~lets
|
|
rlm@10
|
3486 ~@body))))))
|
|
rlm@10
|
3487
|
|
rlm@10
|
3488 ;redefine fn with destructuring and pre/post conditions
|
|
rlm@10
|
3489 (defmacro fn
|
|
rlm@10
|
3490 "(fn name? [params* ] exprs*)
|
|
rlm@10
|
3491 (fn name? ([params* ] exprs*)+)
|
|
rlm@10
|
3492
|
|
rlm@10
|
3493 params => positional-params* , or positional-params* & next-param
|
|
rlm@10
|
3494 positional-param => binding-form
|
|
rlm@10
|
3495 next-param => binding-form
|
|
rlm@10
|
3496 name => symbol
|
|
rlm@10
|
3497
|
|
rlm@10
|
3498 Defines a function"
|
|
rlm@10
|
3499 {:added "1.0"}
|
|
rlm@10
|
3500 [& sigs]
|
|
rlm@10
|
3501 (let [name (if (symbol? (first sigs)) (first sigs) nil)
|
|
rlm@10
|
3502 sigs (if name (next sigs) sigs)
|
|
rlm@10
|
3503 sigs (if (vector? (first sigs)) (list sigs) sigs)
|
|
rlm@10
|
3504 psig (fn* [sig]
|
|
rlm@10
|
3505 (let [[params & body] sig
|
|
rlm@10
|
3506 conds (when (and (next body) (map? (first body)))
|
|
rlm@10
|
3507 (first body))
|
|
rlm@10
|
3508 body (if conds (next body) body)
|
|
rlm@10
|
3509 conds (or conds (meta params))
|
|
rlm@10
|
3510 pre (:pre conds)
|
|
rlm@10
|
3511 post (:post conds)
|
|
rlm@10
|
3512 body (if post
|
|
rlm@10
|
3513 `((let [~'% ~(if (< 1 (count body))
|
|
rlm@10
|
3514 `(do ~@body)
|
|
rlm@10
|
3515 (first body))]
|
|
rlm@10
|
3516 ~@(map (fn* [c] `(assert ~c)) post)
|
|
rlm@10
|
3517 ~'%))
|
|
rlm@10
|
3518 body)
|
|
rlm@10
|
3519 body (if pre
|
|
rlm@10
|
3520 (concat (map (fn* [c] `(assert ~c)) pre)
|
|
rlm@10
|
3521 body)
|
|
rlm@10
|
3522 body)]
|
|
rlm@10
|
3523 (maybe-destructured params body)))
|
|
rlm@10
|
3524 new-sigs (map psig sigs)]
|
|
rlm@10
|
3525 (with-meta
|
|
rlm@10
|
3526 (if name
|
|
rlm@10
|
3527 (list* 'fn* name new-sigs)
|
|
rlm@10
|
3528 (cons 'fn* new-sigs))
|
|
rlm@10
|
3529 (meta &form))))
|
|
rlm@10
|
3530
|
|
rlm@10
|
3531 (defmacro loop
|
|
rlm@10
|
3532 "Evaluates the exprs in a lexical context in which the symbols in
|
|
rlm@10
|
3533 the binding-forms are bound to their respective init-exprs or parts
|
|
rlm@10
|
3534 therein. Acts as a recur target."
|
|
rlm@10
|
3535 {:added "1.0"}
|
|
rlm@10
|
3536 [bindings & body]
|
|
rlm@10
|
3537 (assert-args loop
|
|
rlm@10
|
3538 (vector? bindings) "a vector for its binding"
|
|
rlm@10
|
3539 (even? (count bindings)) "an even number of forms in binding vector")
|
|
rlm@10
|
3540 (let [db (destructure bindings)]
|
|
rlm@10
|
3541 (if (= db bindings)
|
|
rlm@10
|
3542 `(loop* ~bindings ~@body)
|
|
rlm@10
|
3543 (let [vs (take-nth 2 (drop 1 bindings))
|
|
rlm@10
|
3544 bs (take-nth 2 bindings)
|
|
rlm@10
|
3545 gs (map (fn [b] (if (symbol? b) b (gensym))) bs)
|
|
rlm@10
|
3546 bfs (reduce (fn [ret [b v g]]
|
|
rlm@10
|
3547 (if (symbol? b)
|
|
rlm@10
|
3548 (conj ret g v)
|
|
rlm@10
|
3549 (conj ret g v b g)))
|
|
rlm@10
|
3550 [] (map vector bs vs gs))]
|
|
rlm@10
|
3551 `(let ~bfs
|
|
rlm@10
|
3552 (loop* ~(vec (interleave gs gs))
|
|
rlm@10
|
3553 (let ~(vec (interleave bs gs))
|
|
rlm@10
|
3554 ~@body)))))))
|
|
rlm@10
|
3555
|
|
rlm@10
|
3556 (defmacro when-first
|
|
rlm@10
|
3557 "bindings => x xs
|
|
rlm@10
|
3558
|
|
rlm@10
|
3559 Same as (when (seq xs) (let [x (first xs)] body))"
|
|
rlm@10
|
3560 {:added "1.0"}
|
|
rlm@10
|
3561 [bindings & body]
|
|
rlm@10
|
3562 (assert-args when-first
|
|
rlm@10
|
3563 (vector? bindings) "a vector for its binding"
|
|
rlm@10
|
3564 (= 2 (count bindings)) "exactly 2 forms in binding vector")
|
|
rlm@10
|
3565 (let [[x xs] bindings]
|
|
rlm@10
|
3566 `(when (seq ~xs)
|
|
rlm@10
|
3567 (let [~x (first ~xs)]
|
|
rlm@10
|
3568 ~@body))))
|
|
rlm@10
|
3569
|
|
rlm@10
|
3570 (defmacro lazy-cat
|
|
rlm@10
|
3571 "Expands to code which yields a lazy sequence of the concatenation
|
|
rlm@10
|
3572 of the supplied colls. Each coll expr is not evaluated until it is
|
|
rlm@10
|
3573 needed.
|
|
rlm@10
|
3574
|
|
rlm@10
|
3575 (lazy-cat xs ys zs) === (concat (lazy-seq xs) (lazy-seq ys) (lazy-seq zs))"
|
|
rlm@10
|
3576 {:added "1.0"}
|
|
rlm@10
|
3577 [& colls]
|
|
rlm@10
|
3578 `(concat ~@(map #(list `lazy-seq %) colls)))
|
|
rlm@10
|
3579
|
|
rlm@10
|
3580 (defmacro for
|
|
rlm@10
|
3581 "List comprehension. Takes a vector of one or more
|
|
rlm@10
|
3582 binding-form/collection-expr pairs, each followed by zero or more
|
|
rlm@10
|
3583 modifiers, and yields a lazy sequence of evaluations of expr.
|
|
rlm@10
|
3584 Collections are iterated in a nested fashion, rightmost fastest,
|
|
rlm@10
|
3585 and nested coll-exprs can refer to bindings created in prior
|
|
rlm@10
|
3586 binding-forms. Supported modifiers are: :let [binding-form expr ...],
|
|
rlm@10
|
3587 :while test, :when test.
|
|
rlm@10
|
3588
|
|
rlm@10
|
3589 (take 100 (for [x (range 100000000) y (range 1000000) :while (< y x)] [x y]))"
|
|
rlm@10
|
3590 {:added "1.0"}
|
|
rlm@10
|
3591 [seq-exprs body-expr]
|
|
rlm@10
|
3592 (assert-args for
|
|
rlm@10
|
3593 (vector? seq-exprs) "a vector for its binding"
|
|
rlm@10
|
3594 (even? (count seq-exprs)) "an even number of forms in binding vector")
|
|
rlm@10
|
3595 (let [to-groups (fn [seq-exprs]
|
|
rlm@10
|
3596 (reduce (fn [groups [k v]]
|
|
rlm@10
|
3597 (if (keyword? k)
|
|
rlm@10
|
3598 (conj (pop groups) (conj (peek groups) [k v]))
|
|
rlm@10
|
3599 (conj groups [k v])))
|
|
rlm@10
|
3600 [] (partition 2 seq-exprs)))
|
|
rlm@10
|
3601 err (fn [& msg] (throw (IllegalArgumentException. ^String (apply str msg))))
|
|
rlm@10
|
3602 emit-bind (fn emit-bind [[[bind expr & mod-pairs]
|
|
rlm@10
|
3603 & [[_ next-expr] :as next-groups]]]
|
|
rlm@10
|
3604 (let [giter (gensym "iter__")
|
|
rlm@10
|
3605 gxs (gensym "s__")
|
|
rlm@10
|
3606 do-mod (fn do-mod [[[k v :as pair] & etc]]
|
|
rlm@10
|
3607 (cond
|
|
rlm@10
|
3608 (= k :let) `(let ~v ~(do-mod etc))
|
|
rlm@10
|
3609 (= k :while) `(when ~v ~(do-mod etc))
|
|
rlm@10
|
3610 (= k :when) `(if ~v
|
|
rlm@10
|
3611 ~(do-mod etc)
|
|
rlm@10
|
3612 (recur (rest ~gxs)))
|
|
rlm@10
|
3613 (keyword? k) (err "Invalid 'for' keyword " k)
|
|
rlm@10
|
3614 next-groups
|
|
rlm@10
|
3615 `(let [iterys# ~(emit-bind next-groups)
|
|
rlm@10
|
3616 fs# (seq (iterys# ~next-expr))]
|
|
rlm@10
|
3617 (if fs#
|
|
rlm@10
|
3618 (concat fs# (~giter (rest ~gxs)))
|
|
rlm@10
|
3619 (recur (rest ~gxs))))
|
|
rlm@10
|
3620 :else `(cons ~body-expr
|
|
rlm@10
|
3621 (~giter (rest ~gxs)))))]
|
|
rlm@10
|
3622 (if next-groups
|
|
rlm@10
|
3623 #_"not the inner-most loop"
|
|
rlm@10
|
3624 `(fn ~giter [~gxs]
|
|
rlm@10
|
3625 (lazy-seq
|
|
rlm@10
|
3626 (loop [~gxs ~gxs]
|
|
rlm@10
|
3627 (when-first [~bind ~gxs]
|
|
rlm@10
|
3628 ~(do-mod mod-pairs)))))
|
|
rlm@10
|
3629 #_"inner-most loop"
|
|
rlm@10
|
3630 (let [gi (gensym "i__")
|
|
rlm@10
|
3631 gb (gensym "b__")
|
|
rlm@10
|
3632 do-cmod (fn do-cmod [[[k v :as pair] & etc]]
|
|
rlm@10
|
3633 (cond
|
|
rlm@10
|
3634 (= k :let) `(let ~v ~(do-cmod etc))
|
|
rlm@10
|
3635 (= k :while) `(when ~v ~(do-cmod etc))
|
|
rlm@10
|
3636 (= k :when) `(if ~v
|
|
rlm@10
|
3637 ~(do-cmod etc)
|
|
rlm@10
|
3638 (recur
|
|
rlm@10
|
3639 (unchecked-inc ~gi)))
|
|
rlm@10
|
3640 (keyword? k)
|
|
rlm@10
|
3641 (err "Invalid 'for' keyword " k)
|
|
rlm@10
|
3642 :else
|
|
rlm@10
|
3643 `(do (chunk-append ~gb ~body-expr)
|
|
rlm@10
|
3644 (recur (unchecked-inc ~gi)))))]
|
|
rlm@10
|
3645 `(fn ~giter [~gxs]
|
|
rlm@10
|
3646 (lazy-seq
|
|
rlm@10
|
3647 (loop [~gxs ~gxs]
|
|
rlm@10
|
3648 (when-let [~gxs (seq ~gxs)]
|
|
rlm@10
|
3649 (if (chunked-seq? ~gxs)
|
|
rlm@10
|
3650 (let [c# (chunk-first ~gxs)
|
|
rlm@10
|
3651 size# (int (count c#))
|
|
rlm@10
|
3652 ~gb (chunk-buffer size#)]
|
|
rlm@10
|
3653 (if (loop [~gi (int 0)]
|
|
rlm@10
|
3654 (if (< ~gi size#)
|
|
rlm@10
|
3655 (let [~bind (.nth c# ~gi)]
|
|
rlm@10
|
3656 ~(do-cmod mod-pairs))
|
|
rlm@10
|
3657 true))
|
|
rlm@10
|
3658 (chunk-cons
|
|
rlm@10
|
3659 (chunk ~gb)
|
|
rlm@10
|
3660 (~giter (chunk-rest ~gxs)))
|
|
rlm@10
|
3661 (chunk-cons (chunk ~gb) nil)))
|
|
rlm@10
|
3662 (let [~bind (first ~gxs)]
|
|
rlm@10
|
3663 ~(do-mod mod-pairs)))))))))))]
|
|
rlm@10
|
3664 `(let [iter# ~(emit-bind (to-groups seq-exprs))]
|
|
rlm@10
|
3665 (iter# ~(second seq-exprs)))))
|
|
rlm@10
|
3666
|
|
rlm@10
|
3667 (defmacro comment
|
|
rlm@10
|
3668 "Ignores body, yields nil"
|
|
rlm@10
|
3669 {:added "1.0"}
|
|
rlm@10
|
3670 [& body])
|
|
rlm@10
|
3671
|
|
rlm@10
|
3672 (defmacro with-out-str
|
|
rlm@10
|
3673 "Evaluates exprs in a context in which *out* is bound to a fresh
|
|
rlm@10
|
3674 StringWriter. Returns the string created by any nested printing
|
|
rlm@10
|
3675 calls."
|
|
rlm@10
|
3676 {:added "1.0"}
|
|
rlm@10
|
3677 [& body]
|
|
rlm@10
|
3678 `(let [s# (new java.io.StringWriter)]
|
|
rlm@10
|
3679 (binding [*out* s#]
|
|
rlm@10
|
3680 ~@body
|
|
rlm@10
|
3681 (str s#))))
|
|
rlm@10
|
3682
|
|
rlm@10
|
3683 (defmacro with-in-str
|
|
rlm@10
|
3684 "Evaluates body in a context in which *in* is bound to a fresh
|
|
rlm@10
|
3685 StringReader initialized with the string s."
|
|
rlm@10
|
3686 {:added "1.0"}
|
|
rlm@10
|
3687 [s & body]
|
|
rlm@10
|
3688 `(with-open [s# (-> (java.io.StringReader. ~s) clojure.lang.LineNumberingPushbackReader.)]
|
|
rlm@10
|
3689 (binding [*in* s#]
|
|
rlm@10
|
3690 ~@body)))
|
|
rlm@10
|
3691
|
|
rlm@10
|
3692 (defn pr-str
|
|
rlm@10
|
3693 "pr to a string, returning it"
|
|
rlm@10
|
3694 {:tag String
|
|
rlm@10
|
3695 :added "1.0"}
|
|
rlm@10
|
3696 [& xs]
|
|
rlm@10
|
3697 (with-out-str
|
|
rlm@10
|
3698 (apply pr xs)))
|
|
rlm@10
|
3699
|
|
rlm@10
|
3700 (defn prn-str
|
|
rlm@10
|
3701 "prn to a string, returning it"
|
|
rlm@10
|
3702 {:tag String
|
|
rlm@10
|
3703 :added "1.0"}
|
|
rlm@10
|
3704 [& xs]
|
|
rlm@10
|
3705 (with-out-str
|
|
rlm@10
|
3706 (apply prn xs)))
|
|
rlm@10
|
3707
|
|
rlm@10
|
3708 (defn print-str
|
|
rlm@10
|
3709 "print to a string, returning it"
|
|
rlm@10
|
3710 {:tag String
|
|
rlm@10
|
3711 :added "1.0"}
|
|
rlm@10
|
3712 [& xs]
|
|
rlm@10
|
3713 (with-out-str
|
|
rlm@10
|
3714 (apply print xs)))
|
|
rlm@10
|
3715
|
|
rlm@10
|
3716 (defn println-str
|
|
rlm@10
|
3717 "println to a string, returning it"
|
|
rlm@10
|
3718 {:tag String
|
|
rlm@10
|
3719 :added "1.0"}
|
|
rlm@10
|
3720 [& xs]
|
|
rlm@10
|
3721 (with-out-str
|
|
rlm@10
|
3722 (apply println xs)))
|
|
rlm@10
|
3723
|
|
rlm@10
|
3724 (defmacro assert
|
|
rlm@10
|
3725 "Evaluates expr and throws an exception if it does not evaluate to
|
|
rlm@10
|
3726 logical true."
|
|
rlm@10
|
3727 {:added "1.0"}
|
|
rlm@10
|
3728 [x]
|
|
rlm@10
|
3729 (when *assert*
|
|
rlm@10
|
3730 `(when-not ~x
|
|
rlm@10
|
3731 (throw (new AssertionError (str "Assert failed: " (pr-str '~x)))))))
|
|
rlm@10
|
3732
|
|
rlm@10
|
3733 (defn test
|
|
rlm@10
|
3734 "test [v] finds fn at key :test in var metadata and calls it,
|
|
rlm@10
|
3735 presuming failure will throw exception"
|
|
rlm@10
|
3736 {:added "1.0"}
|
|
rlm@10
|
3737 [v]
|
|
rlm@10
|
3738 (let [f (:test (meta v))]
|
|
rlm@10
|
3739 (if f
|
|
rlm@10
|
3740 (do (f) :ok)
|
|
rlm@10
|
3741 :no-test)))
|
|
rlm@10
|
3742
|
|
rlm@10
|
3743 (defn re-pattern
|
|
rlm@10
|
3744 "Returns an instance of java.util.regex.Pattern, for use, e.g. in
|
|
rlm@10
|
3745 re-matcher."
|
|
rlm@10
|
3746 {:tag java.util.regex.Pattern
|
|
rlm@10
|
3747 :added "1.0"}
|
|
rlm@10
|
3748 [s] (if (instance? java.util.regex.Pattern s)
|
|
rlm@10
|
3749 s
|
|
rlm@10
|
3750 (. java.util.regex.Pattern (compile s))))
|
|
rlm@10
|
3751
|
|
rlm@10
|
3752 (defn re-matcher
|
|
rlm@10
|
3753 "Returns an instance of java.util.regex.Matcher, for use, e.g. in
|
|
rlm@10
|
3754 re-find."
|
|
rlm@10
|
3755 {:tag java.util.regex.Matcher
|
|
rlm@10
|
3756 :added "1.0"}
|
|
rlm@10
|
3757 [^java.util.regex.Pattern re s]
|
|
rlm@10
|
3758 (. re (matcher s)))
|
|
rlm@10
|
3759
|
|
rlm@10
|
3760 (defn re-groups
|
|
rlm@10
|
3761 "Returns the groups from the most recent match/find. If there are no
|
|
rlm@10
|
3762 nested groups, returns a string of the entire match. If there are
|
|
rlm@10
|
3763 nested groups, returns a vector of the groups, the first element
|
|
rlm@10
|
3764 being the entire match."
|
|
rlm@10
|
3765 {:added "1.0"}
|
|
rlm@10
|
3766 [^java.util.regex.Matcher m]
|
|
rlm@10
|
3767 (let [gc (. m (groupCount))]
|
|
rlm@10
|
3768 (if (zero? gc)
|
|
rlm@10
|
3769 (. m (group))
|
|
rlm@10
|
3770 (loop [ret [] c 0]
|
|
rlm@10
|
3771 (if (<= c gc)
|
|
rlm@10
|
3772 (recur (conj ret (. m (group c))) (inc c))
|
|
rlm@10
|
3773 ret)))))
|
|
rlm@10
|
3774
|
|
rlm@10
|
3775 (defn re-seq
|
|
rlm@10
|
3776 "Returns a lazy sequence of successive matches of pattern in string,
|
|
rlm@10
|
3777 using java.util.regex.Matcher.find(), each such match processed with
|
|
rlm@10
|
3778 re-groups."
|
|
rlm@10
|
3779 {:added "1.0"}
|
|
rlm@10
|
3780 [^java.util.regex.Pattern re s]
|
|
rlm@10
|
3781 (let [m (re-matcher re s)]
|
|
rlm@10
|
3782 ((fn step []
|
|
rlm@10
|
3783 (when (. m (find))
|
|
rlm@10
|
3784 (cons (re-groups m) (lazy-seq (step))))))))
|
|
rlm@10
|
3785
|
|
rlm@10
|
3786 (defn re-matches
|
|
rlm@10
|
3787 "Returns the match, if any, of string to pattern, using
|
|
rlm@10
|
3788 java.util.regex.Matcher.matches(). Uses re-groups to return the
|
|
rlm@10
|
3789 groups."
|
|
rlm@10
|
3790 {:added "1.0"}
|
|
rlm@10
|
3791 [^java.util.regex.Pattern re s]
|
|
rlm@10
|
3792 (let [m (re-matcher re s)]
|
|
rlm@10
|
3793 (when (. m (matches))
|
|
rlm@10
|
3794 (re-groups m))))
|
|
rlm@10
|
3795
|
|
rlm@10
|
3796
|
|
rlm@10
|
3797 (defn re-find
|
|
rlm@10
|
3798 "Returns the next regex match, if any, of string to pattern, using
|
|
rlm@10
|
3799 java.util.regex.Matcher.find(). Uses re-groups to return the
|
|
rlm@10
|
3800 groups."
|
|
rlm@10
|
3801 {:added "1.0"}
|
|
rlm@10
|
3802 ([^java.util.regex.Matcher m]
|
|
rlm@10
|
3803 (when (. m (find))
|
|
rlm@10
|
3804 (re-groups m)))
|
|
rlm@10
|
3805 ([^java.util.regex.Pattern re s]
|
|
rlm@10
|
3806 (let [m (re-matcher re s)]
|
|
rlm@10
|
3807 (re-find m))))
|
|
rlm@10
|
3808
|
|
rlm@10
|
3809 (defn rand
|
|
rlm@10
|
3810 "Returns a random floating point number between 0 (inclusive) and
|
|
rlm@10
|
3811 n (default 1) (exclusive)."
|
|
rlm@10
|
3812 {:added "1.0"}
|
|
rlm@10
|
3813 ([] (. Math (random)))
|
|
rlm@10
|
3814 ([n] (* n (rand))))
|
|
rlm@10
|
3815
|
|
rlm@10
|
3816 (defn rand-int
|
|
rlm@10
|
3817 "Returns a random integer between 0 (inclusive) and n (exclusive)."
|
|
rlm@10
|
3818 {:added "1.0"}
|
|
rlm@10
|
3819 [n] (int (rand n)))
|
|
rlm@10
|
3820
|
|
rlm@10
|
3821 (defmacro defn-
|
|
rlm@10
|
3822 "same as defn, yielding non-public def"
|
|
rlm@10
|
3823 {:added "1.0"}
|
|
rlm@10
|
3824 [name & decls]
|
|
rlm@10
|
3825 (list* `defn (with-meta name (assoc (meta name) :private true)) decls))
|
|
rlm@10
|
3826
|
|
rlm@10
|
3827 (defn print-doc [v]
|
|
rlm@10
|
3828 (println "-------------------------")
|
|
rlm@10
|
3829 (println (str (ns-name (:ns (meta v))) "/" (:name (meta v))))
|
|
rlm@10
|
3830 (prn (:arglists (meta v)))
|
|
rlm@10
|
3831 (when (:macro (meta v))
|
|
rlm@10
|
3832 (println "Macro"))
|
|
rlm@10
|
3833 (println " " (:doc (meta v))))
|
|
rlm@10
|
3834
|
|
rlm@10
|
3835 (defn find-doc
|
|
rlm@10
|
3836 "Prints documentation for any var whose documentation or name
|
|
rlm@10
|
3837 contains a match for re-string-or-pattern"
|
|
rlm@10
|
3838 {:added "1.0"}
|
|
rlm@10
|
3839 [re-string-or-pattern]
|
|
rlm@10
|
3840 (let [re (re-pattern re-string-or-pattern)]
|
|
rlm@10
|
3841 (doseq [ns (all-ns)
|
|
rlm@10
|
3842 v (sort-by (comp :name meta) (vals (ns-interns ns)))
|
|
rlm@10
|
3843 :when (and (:doc (meta v))
|
|
rlm@10
|
3844 (or (re-find (re-matcher re (:doc (meta v))))
|
|
rlm@10
|
3845 (re-find (re-matcher re (str (:name (meta v)))))))]
|
|
rlm@10
|
3846 (print-doc v))))
|
|
rlm@10
|
3847
|
|
rlm@10
|
3848 (defn special-form-anchor
|
|
rlm@10
|
3849 "Returns the anchor tag on http://clojure.org/special_forms for the
|
|
rlm@10
|
3850 special form x, or nil"
|
|
rlm@10
|
3851 {:added "1.0"}
|
|
rlm@10
|
3852 [x]
|
|
rlm@10
|
3853 (#{'. 'def 'do 'fn 'if 'let 'loop 'monitor-enter 'monitor-exit 'new
|
|
rlm@10
|
3854 'quote 'recur 'set! 'throw 'try 'var} x))
|
|
rlm@10
|
3855
|
|
rlm@10
|
3856 (defn syntax-symbol-anchor
|
|
rlm@10
|
3857 "Returns the anchor tag on http://clojure.org/special_forms for the
|
|
rlm@10
|
3858 special form that uses syntax symbol x, or nil"
|
|
rlm@10
|
3859 {:added "1.0"}
|
|
rlm@10
|
3860 [x]
|
|
rlm@10
|
3861 ({'& 'fn 'catch 'try 'finally 'try} x))
|
|
rlm@10
|
3862
|
|
rlm@10
|
3863 (defn print-special-doc
|
|
rlm@10
|
3864 [name type anchor]
|
|
rlm@10
|
3865 (println "-------------------------")
|
|
rlm@10
|
3866 (println name)
|
|
rlm@10
|
3867 (println type)
|
|
rlm@10
|
3868 (println (str " Please see http://clojure.org/special_forms#" anchor)))
|
|
rlm@10
|
3869
|
|
rlm@10
|
3870 (defn print-namespace-doc
|
|
rlm@10
|
3871 "Print the documentation string of a Namespace."
|
|
rlm@10
|
3872 {:added "1.0"}
|
|
rlm@10
|
3873 [nspace]
|
|
rlm@10
|
3874 (println "-------------------------")
|
|
rlm@10
|
3875 (println (str (ns-name nspace)))
|
|
rlm@10
|
3876 (println " " (:doc (meta nspace))))
|
|
rlm@10
|
3877
|
|
rlm@10
|
3878 (defmacro doc
|
|
rlm@10
|
3879 "Prints documentation for a var or special form given its name"
|
|
rlm@10
|
3880 {:added "1.0"}
|
|
rlm@10
|
3881 [name]
|
|
rlm@10
|
3882 (cond
|
|
rlm@10
|
3883 (special-form-anchor `~name)
|
|
rlm@10
|
3884 `(print-special-doc '~name "Special Form" (special-form-anchor '~name))
|
|
rlm@10
|
3885 (syntax-symbol-anchor `~name)
|
|
rlm@10
|
3886 `(print-special-doc '~name "Syntax Symbol" (syntax-symbol-anchor '~name))
|
|
rlm@10
|
3887 :else
|
|
rlm@10
|
3888 (let [nspace (find-ns name)]
|
|
rlm@10
|
3889 (if nspace
|
|
rlm@10
|
3890 `(print-namespace-doc ~nspace)
|
|
rlm@10
|
3891 `(print-doc (var ~name))))))
|
|
rlm@10
|
3892
|
|
rlm@10
|
3893 (defn tree-seq
|
|
rlm@10
|
3894 "Returns a lazy sequence of the nodes in a tree, via a depth-first walk.
|
|
rlm@10
|
3895 branch? must be a fn of one arg that returns true if passed a node
|
|
rlm@10
|
3896 that can have children (but may not). children must be a fn of one
|
|
rlm@10
|
3897 arg that returns a sequence of the children. Will only be called on
|
|
rlm@10
|
3898 nodes for which branch? returns true. Root is the root node of the
|
|
rlm@10
|
3899 tree."
|
|
rlm@10
|
3900 {:added "1.0"}
|
|
rlm@10
|
3901 [branch? children root]
|
|
rlm@10
|
3902 (let [walk (fn walk [node]
|
|
rlm@10
|
3903 (lazy-seq
|
|
rlm@10
|
3904 (cons node
|
|
rlm@10
|
3905 (when (branch? node)
|
|
rlm@10
|
3906 (mapcat walk (children node))))))]
|
|
rlm@10
|
3907 (walk root)))
|
|
rlm@10
|
3908
|
|
rlm@10
|
3909 (defn file-seq
|
|
rlm@10
|
3910 "A tree seq on java.io.Files"
|
|
rlm@10
|
3911 {:added "1.0"}
|
|
rlm@10
|
3912 [dir]
|
|
rlm@10
|
3913 (tree-seq
|
|
rlm@10
|
3914 (fn [^java.io.File f] (. f (isDirectory)))
|
|
rlm@10
|
3915 (fn [^java.io.File d] (seq (. d (listFiles))))
|
|
rlm@10
|
3916 dir))
|
|
rlm@10
|
3917
|
|
rlm@10
|
3918 (defn xml-seq
|
|
rlm@10
|
3919 "A tree seq on the xml elements as per xml/parse"
|
|
rlm@10
|
3920 {:added "1.0"}
|
|
rlm@10
|
3921 [root]
|
|
rlm@10
|
3922 (tree-seq
|
|
rlm@10
|
3923 (complement string?)
|
|
rlm@10
|
3924 (comp seq :content)
|
|
rlm@10
|
3925 root))
|
|
rlm@10
|
3926
|
|
rlm@10
|
3927 (defn special-symbol?
|
|
rlm@10
|
3928 "Returns true if s names a special form"
|
|
rlm@10
|
3929 {:added "1.0"}
|
|
rlm@10
|
3930 [s]
|
|
rlm@10
|
3931 (contains? (. clojure.lang.Compiler specials) s))
|
|
rlm@10
|
3932
|
|
rlm@10
|
3933 (defn var?
|
|
rlm@10
|
3934 "Returns true if v is of type clojure.lang.Var"
|
|
rlm@10
|
3935 {:added "1.0"}
|
|
rlm@10
|
3936 [v] (instance? clojure.lang.Var v))
|
|
rlm@10
|
3937
|
|
rlm@10
|
3938 (defn ^String subs
|
|
rlm@10
|
3939 "Returns the substring of s beginning at start inclusive, and ending
|
|
rlm@10
|
3940 at end (defaults to length of string), exclusive."
|
|
rlm@10
|
3941 {:added "1.0"}
|
|
rlm@10
|
3942 ([^String s start] (. s (substring start)))
|
|
rlm@10
|
3943 ([^String s start end] (. s (substring start end))))
|
|
rlm@10
|
3944
|
|
rlm@10
|
3945 (defn max-key
|
|
rlm@10
|
3946 "Returns the x for which (k x), a number, is greatest."
|
|
rlm@10
|
3947 {:added "1.0"}
|
|
rlm@10
|
3948 ([k x] x)
|
|
rlm@10
|
3949 ([k x y] (if (> (k x) (k y)) x y))
|
|
rlm@10
|
3950 ([k x y & more]
|
|
rlm@10
|
3951 (reduce #(max-key k %1 %2) (max-key k x y) more)))
|
|
rlm@10
|
3952
|
|
rlm@10
|
3953 (defn min-key
|
|
rlm@10
|
3954 "Returns the x for which (k x), a number, is least."
|
|
rlm@10
|
3955 {:added "1.0"}
|
|
rlm@10
|
3956 ([k x] x)
|
|
rlm@10
|
3957 ([k x y] (if (< (k x) (k y)) x y))
|
|
rlm@10
|
3958 ([k x y & more]
|
|
rlm@10
|
3959 (reduce #(min-key k %1 %2) (min-key k x y) more)))
|
|
rlm@10
|
3960
|
|
rlm@10
|
3961 (defn distinct
|
|
rlm@10
|
3962 "Returns a lazy sequence of the elements of coll with duplicates removed"
|
|
rlm@10
|
3963 {:added "1.0"}
|
|
rlm@10
|
3964 [coll]
|
|
rlm@10
|
3965 (let [step (fn step [xs seen]
|
|
rlm@10
|
3966 (lazy-seq
|
|
rlm@10
|
3967 ((fn [[f :as xs] seen]
|
|
rlm@10
|
3968 (when-let [s (seq xs)]
|
|
rlm@10
|
3969 (if (contains? seen f)
|
|
rlm@10
|
3970 (recur (rest s) seen)
|
|
rlm@10
|
3971 (cons f (step (rest s) (conj seen f))))))
|
|
rlm@10
|
3972 xs seen)))]
|
|
rlm@10
|
3973 (step coll #{})))
|
|
rlm@10
|
3974
|
|
rlm@10
|
3975
|
|
rlm@10
|
3976
|
|
rlm@10
|
3977 (defn replace
|
|
rlm@10
|
3978 "Given a map of replacement pairs and a vector/collection, returns a
|
|
rlm@10
|
3979 vector/seq with any elements = a key in smap replaced with the
|
|
rlm@10
|
3980 corresponding val in smap"
|
|
rlm@10
|
3981 {:added "1.0"}
|
|
rlm@10
|
3982 [smap coll]
|
|
rlm@10
|
3983 (if (vector? coll)
|
|
rlm@10
|
3984 (reduce (fn [v i]
|
|
rlm@10
|
3985 (if-let [e (find smap (nth v i))]
|
|
rlm@10
|
3986 (assoc v i (val e))
|
|
rlm@10
|
3987 v))
|
|
rlm@10
|
3988 coll (range (count coll)))
|
|
rlm@10
|
3989 (map #(if-let [e (find smap %)] (val e) %) coll)))
|
|
rlm@10
|
3990
|
|
rlm@10
|
3991 (defmacro dosync
|
|
rlm@10
|
3992 "Runs the exprs (in an implicit do) in a transaction that encompasses
|
|
rlm@10
|
3993 exprs and any nested calls. Starts a transaction if none is already
|
|
rlm@10
|
3994 running on this thread. Any uncaught exception will abort the
|
|
rlm@10
|
3995 transaction and flow out of dosync. The exprs may be run more than
|
|
rlm@10
|
3996 once, but any effects on Refs will be atomic."
|
|
rlm@10
|
3997 {:added "1.0"}
|
|
rlm@10
|
3998 [& exprs]
|
|
rlm@10
|
3999 `(sync nil ~@exprs))
|
|
rlm@10
|
4000
|
|
rlm@10
|
4001 (defmacro with-precision
|
|
rlm@10
|
4002 "Sets the precision and rounding mode to be used for BigDecimal operations.
|
|
rlm@10
|
4003
|
|
rlm@10
|
4004 Usage: (with-precision 10 (/ 1M 3))
|
|
rlm@10
|
4005 or: (with-precision 10 :rounding HALF_DOWN (/ 1M 3))
|
|
rlm@10
|
4006
|
|
rlm@10
|
4007 The rounding mode is one of CEILING, FLOOR, HALF_UP, HALF_DOWN,
|
|
rlm@10
|
4008 HALF_EVEN, UP, DOWN and UNNECESSARY; it defaults to HALF_UP."
|
|
rlm@10
|
4009 {:added "1.0"}
|
|
rlm@10
|
4010 [precision & exprs]
|
|
rlm@10
|
4011 (let [[body rm] (if (= (first exprs) :rounding)
|
|
rlm@10
|
4012 [(next (next exprs))
|
|
rlm@10
|
4013 `((. java.math.RoundingMode ~(second exprs)))]
|
|
rlm@10
|
4014 [exprs nil])]
|
|
rlm@10
|
4015 `(binding [*math-context* (java.math.MathContext. ~precision ~@rm)]
|
|
rlm@10
|
4016 ~@body)))
|
|
rlm@10
|
4017
|
|
rlm@10
|
4018 (defn mk-bound-fn
|
|
rlm@10
|
4019 {:private true}
|
|
rlm@10
|
4020 [^clojure.lang.Sorted sc test key]
|
|
rlm@10
|
4021 (fn [e]
|
|
rlm@10
|
4022 (test (.. sc comparator (compare (. sc entryKey e) key)) 0)))
|
|
rlm@10
|
4023
|
|
rlm@10
|
4024 (defn subseq
|
|
rlm@10
|
4025 "sc must be a sorted collection, test(s) one of <, <=, > or
|
|
rlm@10
|
4026 >=. Returns a seq of those entries with keys ek for
|
|
rlm@10
|
4027 which (test (.. sc comparator (compare ek key)) 0) is true"
|
|
rlm@10
|
4028 {:added "1.0"}
|
|
rlm@10
|
4029 ([^clojure.lang.Sorted sc test key]
|
|
rlm@10
|
4030 (let [include (mk-bound-fn sc test key)]
|
|
rlm@10
|
4031 (if (#{> >=} test)
|
|
rlm@10
|
4032 (when-let [[e :as s] (. sc seqFrom key true)]
|
|
rlm@10
|
4033 (if (include e) s (next s)))
|
|
rlm@10
|
4034 (take-while include (. sc seq true)))))
|
|
rlm@10
|
4035 ([^clojure.lang.Sorted sc start-test start-key end-test end-key]
|
|
rlm@10
|
4036 (when-let [[e :as s] (. sc seqFrom start-key true)]
|
|
rlm@10
|
4037 (take-while (mk-bound-fn sc end-test end-key)
|
|
rlm@10
|
4038 (if ((mk-bound-fn sc start-test start-key) e) s (next s))))))
|
|
rlm@10
|
4039
|
|
rlm@10
|
4040 (defn rsubseq
|
|
rlm@10
|
4041 "sc must be a sorted collection, test(s) one of <, <=, > or
|
|
rlm@10
|
4042 >=. Returns a reverse seq of those entries with keys ek for
|
|
rlm@10
|
4043 which (test (.. sc comparator (compare ek key)) 0) is true"
|
|
rlm@10
|
4044 {:added "1.0"}
|
|
rlm@10
|
4045 ([^clojure.lang.Sorted sc test key]
|
|
rlm@10
|
4046 (let [include (mk-bound-fn sc test key)]
|
|
rlm@10
|
4047 (if (#{< <=} test)
|
|
rlm@10
|
4048 (when-let [[e :as s] (. sc seqFrom key false)]
|
|
rlm@10
|
4049 (if (include e) s (next s)))
|
|
rlm@10
|
4050 (take-while include (. sc seq false)))))
|
|
rlm@10
|
4051 ([^clojure.lang.Sorted sc start-test start-key end-test end-key]
|
|
rlm@10
|
4052 (when-let [[e :as s] (. sc seqFrom end-key false)]
|
|
rlm@10
|
4053 (take-while (mk-bound-fn sc start-test start-key)
|
|
rlm@10
|
4054 (if ((mk-bound-fn sc end-test end-key) e) s (next s))))))
|
|
rlm@10
|
4055
|
|
rlm@10
|
4056 (defn repeatedly
|
|
rlm@10
|
4057 "Takes a function of no args, presumably with side effects, and
|
|
rlm@10
|
4058 returns an infinite (or length n if supplied) lazy sequence of calls
|
|
rlm@10
|
4059 to it"
|
|
rlm@10
|
4060 {:added "1.0"}
|
|
rlm@10
|
4061 ([f] (lazy-seq (cons (f) (repeatedly f))))
|
|
rlm@10
|
4062 ([n f] (take n (repeatedly f))))
|
|
rlm@10
|
4063
|
|
rlm@10
|
4064 (defn add-classpath
|
|
rlm@10
|
4065 "DEPRECATED
|
|
rlm@10
|
4066
|
|
rlm@10
|
4067 Adds the url (String or URL object) to the classpath per
|
|
rlm@10
|
4068 URLClassLoader.addURL"
|
|
rlm@10
|
4069 {:added "1.0"
|
|
rlm@10
|
4070 :deprecated "1.1"}
|
|
rlm@10
|
4071 [url]
|
|
rlm@10
|
4072 (println "WARNING: add-classpath is deprecated")
|
|
rlm@10
|
4073 (clojure.lang.RT/addURL url))
|
|
rlm@10
|
4074
|
|
rlm@10
|
4075
|
|
rlm@10
|
4076
|
|
rlm@10
|
4077 (defn hash
|
|
rlm@10
|
4078 "Returns the hash code of its argument"
|
|
rlm@10
|
4079 {:added "1.0"}
|
|
rlm@10
|
4080 [x] (. clojure.lang.Util (hash x)))
|
|
rlm@10
|
4081
|
|
rlm@10
|
4082 (defn interpose
|
|
rlm@10
|
4083 "Returns a lazy seq of the elements of coll separated by sep"
|
|
rlm@10
|
4084 {:added "1.0"}
|
|
rlm@10
|
4085 [sep coll] (drop 1 (interleave (repeat sep) coll)))
|
|
rlm@10
|
4086
|
|
rlm@10
|
4087 (defmacro definline
|
|
rlm@10
|
4088 "Experimental - like defmacro, except defines a named function whose
|
|
rlm@10
|
4089 body is the expansion, calls to which may be expanded inline as if
|
|
rlm@10
|
4090 it were a macro. Cannot be used with variadic (&) args."
|
|
rlm@10
|
4091 {:added "1.0"}
|
|
rlm@10
|
4092 [name & decl]
|
|
rlm@10
|
4093 (let [[pre-args [args expr]] (split-with (comp not vector?) decl)]
|
|
rlm@10
|
4094 `(do
|
|
rlm@10
|
4095 (defn ~name ~@pre-args ~args ~(apply (eval (list `fn args expr)) args))
|
|
rlm@10
|
4096 (alter-meta! (var ~name) assoc :inline (fn ~name ~args ~expr))
|
|
rlm@10
|
4097 (var ~name))))
|
|
rlm@10
|
4098
|
|
rlm@10
|
4099 (defn empty
|
|
rlm@10
|
4100 "Returns an empty collection of the same category as coll, or nil"
|
|
rlm@10
|
4101 {:added "1.0"}
|
|
rlm@10
|
4102 [coll]
|
|
rlm@10
|
4103 (when (instance? clojure.lang.IPersistentCollection coll)
|
|
rlm@10
|
4104 (.empty ^clojure.lang.IPersistentCollection coll)))
|
|
rlm@10
|
4105
|
|
rlm@10
|
4106 (defmacro amap
|
|
rlm@10
|
4107 "Maps an expression across an array a, using an index named idx, and
|
|
rlm@10
|
4108 return value named ret, initialized to a clone of a, then setting
|
|
rlm@10
|
4109 each element of ret to the evaluation of expr, returning the new
|
|
rlm@10
|
4110 array ret."
|
|
rlm@10
|
4111 {:added "1.0"}
|
|
rlm@10
|
4112 [a idx ret expr]
|
|
rlm@10
|
4113 `(let [a# ~a
|
|
rlm@10
|
4114 ~ret (aclone a#)]
|
|
rlm@10
|
4115 (loop [~idx (int 0)]
|
|
rlm@10
|
4116 (if (< ~idx (alength a#))
|
|
rlm@10
|
4117 (do
|
|
rlm@10
|
4118 (aset ~ret ~idx ~expr)
|
|
rlm@10
|
4119 (recur (unchecked-inc ~idx)))
|
|
rlm@10
|
4120 ~ret))))
|
|
rlm@10
|
4121
|
|
rlm@10
|
4122 (defmacro areduce
|
|
rlm@10
|
4123 "Reduces an expression across an array a, using an index named idx,
|
|
rlm@10
|
4124 and return value named ret, initialized to init, setting ret to the
|
|
rlm@10
|
4125 evaluation of expr at each step, returning ret."
|
|
rlm@10
|
4126 {:added "1.0"}
|
|
rlm@10
|
4127 [a idx ret init expr]
|
|
rlm@10
|
4128 `(let [a# ~a]
|
|
rlm@10
|
4129 (loop [~idx (int 0) ~ret ~init]
|
|
rlm@10
|
4130 (if (< ~idx (alength a#))
|
|
rlm@10
|
4131 (recur (unchecked-inc ~idx) ~expr)
|
|
rlm@10
|
4132 ~ret))))
|
|
rlm@10
|
4133
|
|
rlm@10
|
4134 (defn float-array
|
|
rlm@10
|
4135 "Creates an array of floats"
|
|
rlm@10
|
4136 {:inline (fn [& args] `(. clojure.lang.Numbers float_array ~@args))
|
|
rlm@10
|
4137 :inline-arities #{1 2}
|
|
rlm@10
|
4138 :added "1.0"}
|
|
rlm@10
|
4139 ([size-or-seq] (. clojure.lang.Numbers float_array size-or-seq))
|
|
rlm@10
|
4140 ([size init-val-or-seq] (. clojure.lang.Numbers float_array size init-val-or-seq)))
|
|
rlm@10
|
4141
|
|
rlm@10
|
4142 (defn boolean-array
|
|
rlm@10
|
4143 "Creates an array of booleans"
|
|
rlm@10
|
4144 {:inline (fn [& args] `(. clojure.lang.Numbers boolean_array ~@args))
|
|
rlm@10
|
4145 :inline-arities #{1 2}
|
|
rlm@10
|
4146 :added "1.1"}
|
|
rlm@10
|
4147 ([size-or-seq] (. clojure.lang.Numbers boolean_array size-or-seq))
|
|
rlm@10
|
4148 ([size init-val-or-seq] (. clojure.lang.Numbers boolean_array size init-val-or-seq)))
|
|
rlm@10
|
4149
|
|
rlm@10
|
4150 (defn byte-array
|
|
rlm@10
|
4151 "Creates an array of bytes"
|
|
rlm@10
|
4152 {:inline (fn [& args] `(. clojure.lang.Numbers byte_array ~@args))
|
|
rlm@10
|
4153 :inline-arities #{1 2}
|
|
rlm@10
|
4154 :added "1.1"}
|
|
rlm@10
|
4155 ([size-or-seq] (. clojure.lang.Numbers byte_array size-or-seq))
|
|
rlm@10
|
4156 ([size init-val-or-seq] (. clojure.lang.Numbers byte_array size init-val-or-seq)))
|
|
rlm@10
|
4157
|
|
rlm@10
|
4158 (defn char-array
|
|
rlm@10
|
4159 "Creates an array of chars"
|
|
rlm@10
|
4160 {:inline (fn [& args] `(. clojure.lang.Numbers char_array ~@args))
|
|
rlm@10
|
4161 :inline-arities #{1 2}
|
|
rlm@10
|
4162 :added "1.1"}
|
|
rlm@10
|
4163 ([size-or-seq] (. clojure.lang.Numbers char_array size-or-seq))
|
|
rlm@10
|
4164 ([size init-val-or-seq] (. clojure.lang.Numbers char_array size init-val-or-seq)))
|
|
rlm@10
|
4165
|
|
rlm@10
|
4166 (defn short-array
|
|
rlm@10
|
4167 "Creates an array of shorts"
|
|
rlm@10
|
4168 {:inline (fn [& args] `(. clojure.lang.Numbers short_array ~@args))
|
|
rlm@10
|
4169 :inline-arities #{1 2}
|
|
rlm@10
|
4170 :added "1.1"}
|
|
rlm@10
|
4171 ([size-or-seq] (. clojure.lang.Numbers short_array size-or-seq))
|
|
rlm@10
|
4172 ([size init-val-or-seq] (. clojure.lang.Numbers short_array size init-val-or-seq)))
|
|
rlm@10
|
4173
|
|
rlm@10
|
4174 (defn double-array
|
|
rlm@10
|
4175 "Creates an array of doubles"
|
|
rlm@10
|
4176 {:inline (fn [& args] `(. clojure.lang.Numbers double_array ~@args))
|
|
rlm@10
|
4177 :inline-arities #{1 2}
|
|
rlm@10
|
4178 :added "1.0"}
|
|
rlm@10
|
4179 ([size-or-seq] (. clojure.lang.Numbers double_array size-or-seq))
|
|
rlm@10
|
4180 ([size init-val-or-seq] (. clojure.lang.Numbers double_array size init-val-or-seq)))
|
|
rlm@10
|
4181
|
|
rlm@10
|
4182 (defn object-array
|
|
rlm@10
|
4183 "Creates an array of objects"
|
|
rlm@10
|
4184 {:inline (fn [arg] `(. clojure.lang.RT object_array ~arg))
|
|
rlm@10
|
4185 :inline-arities #{1}
|
|
rlm@10
|
4186 :added "1.2"}
|
|
rlm@10
|
4187 ([size-or-seq] (. clojure.lang.RT object_array size-or-seq)))
|
|
rlm@10
|
4188
|
|
rlm@10
|
4189 (defn int-array
|
|
rlm@10
|
4190 "Creates an array of ints"
|
|
rlm@10
|
4191 {:inline (fn [& args] `(. clojure.lang.Numbers int_array ~@args))
|
|
rlm@10
|
4192 :inline-arities #{1 2}
|
|
rlm@10
|
4193 :added "1.0"}
|
|
rlm@10
|
4194 ([size-or-seq] (. clojure.lang.Numbers int_array size-or-seq))
|
|
rlm@10
|
4195 ([size init-val-or-seq] (. clojure.lang.Numbers int_array size init-val-or-seq)))
|
|
rlm@10
|
4196
|
|
rlm@10
|
4197 (defn long-array
|
|
rlm@10
|
4198 "Creates an array of longs"
|
|
rlm@10
|
4199 {:inline (fn [& args] `(. clojure.lang.Numbers long_array ~@args))
|
|
rlm@10
|
4200 :inline-arities #{1 2}
|
|
rlm@10
|
4201 :added "1.0"}
|
|
rlm@10
|
4202 ([size-or-seq] (. clojure.lang.Numbers long_array size-or-seq))
|
|
rlm@10
|
4203 ([size init-val-or-seq] (. clojure.lang.Numbers long_array size init-val-or-seq)))
|
|
rlm@10
|
4204
|
|
rlm@10
|
4205 (definline booleans
|
|
rlm@10
|
4206 "Casts to boolean[]"
|
|
rlm@10
|
4207 {:added "1.1"}
|
|
rlm@10
|
4208 [xs] `(. clojure.lang.Numbers booleans ~xs))
|
|
rlm@10
|
4209
|
|
rlm@10
|
4210 (definline bytes
|
|
rlm@10
|
4211 "Casts to bytes[]"
|
|
rlm@10
|
4212 {:added "1.1"}
|
|
rlm@10
|
4213 [xs] `(. clojure.lang.Numbers bytes ~xs))
|
|
rlm@10
|
4214
|
|
rlm@10
|
4215 (definline chars
|
|
rlm@10
|
4216 "Casts to chars[]"
|
|
rlm@10
|
4217 {:added "1.1"}
|
|
rlm@10
|
4218 [xs] `(. clojure.lang.Numbers chars ~xs))
|
|
rlm@10
|
4219
|
|
rlm@10
|
4220 (definline shorts
|
|
rlm@10
|
4221 "Casts to shorts[]"
|
|
rlm@10
|
4222 {:added "1.1"}
|
|
rlm@10
|
4223 [xs] `(. clojure.lang.Numbers shorts ~xs))
|
|
rlm@10
|
4224
|
|
rlm@10
|
4225 (definline floats
|
|
rlm@10
|
4226 "Casts to float[]"
|
|
rlm@10
|
4227 {:added "1.0"}
|
|
rlm@10
|
4228 [xs] `(. clojure.lang.Numbers floats ~xs))
|
|
rlm@10
|
4229
|
|
rlm@10
|
4230 (definline ints
|
|
rlm@10
|
4231 "Casts to int[]"
|
|
rlm@10
|
4232 {:added "1.0"}
|
|
rlm@10
|
4233 [xs] `(. clojure.lang.Numbers ints ~xs))
|
|
rlm@10
|
4234
|
|
rlm@10
|
4235 (definline doubles
|
|
rlm@10
|
4236 "Casts to double[]"
|
|
rlm@10
|
4237 {:added "1.0"}
|
|
rlm@10
|
4238 [xs] `(. clojure.lang.Numbers doubles ~xs))
|
|
rlm@10
|
4239
|
|
rlm@10
|
4240 (definline longs
|
|
rlm@10
|
4241 "Casts to long[]"
|
|
rlm@10
|
4242 {:added "1.0"}
|
|
rlm@10
|
4243 [xs] `(. clojure.lang.Numbers longs ~xs))
|
|
rlm@10
|
4244
|
|
rlm@10
|
4245 (import '(java.util.concurrent BlockingQueue LinkedBlockingQueue))
|
|
rlm@10
|
4246
|
|
rlm@10
|
4247 (defn seque
|
|
rlm@10
|
4248 "Creates a queued seq on another (presumably lazy) seq s. The queued
|
|
rlm@10
|
4249 seq will produce a concrete seq in the background, and can get up to
|
|
rlm@10
|
4250 n items ahead of the consumer. n-or-q can be an integer n buffer
|
|
rlm@10
|
4251 size, or an instance of java.util.concurrent BlockingQueue. Note
|
|
rlm@10
|
4252 that reading from a seque can block if the reader gets ahead of the
|
|
rlm@10
|
4253 producer."
|
|
rlm@10
|
4254 {:added "1.0"}
|
|
rlm@10
|
4255 ([s] (seque 100 s))
|
|
rlm@10
|
4256 ([n-or-q s]
|
|
rlm@10
|
4257 (let [^BlockingQueue q (if (instance? BlockingQueue n-or-q)
|
|
rlm@10
|
4258 n-or-q
|
|
rlm@10
|
4259 (LinkedBlockingQueue. (int n-or-q)))
|
|
rlm@10
|
4260 NIL (Object.) ;nil sentinel since LBQ doesn't support nils
|
|
rlm@10
|
4261 agt (agent (seq s))
|
|
rlm@10
|
4262 fill (fn [s]
|
|
rlm@10
|
4263 (try
|
|
rlm@10
|
4264 (loop [[x & xs :as s] s]
|
|
rlm@10
|
4265 (if s
|
|
rlm@10
|
4266 (if (.offer q (if (nil? x) NIL x))
|
|
rlm@10
|
4267 (recur xs)
|
|
rlm@10
|
4268 s)
|
|
rlm@10
|
4269 (.put q q))) ; q itself is eos sentinel
|
|
rlm@10
|
4270 (catch Exception e
|
|
rlm@10
|
4271 (.put q q)
|
|
rlm@10
|
4272 (throw e))))
|
|
rlm@10
|
4273 drain (fn drain []
|
|
rlm@10
|
4274 (lazy-seq
|
|
rlm@10
|
4275 (let [x (.take q)]
|
|
rlm@10
|
4276 (if (identical? x q) ;q itself is eos sentinel
|
|
rlm@10
|
4277 (do @agt nil) ;touch agent just to propagate errors
|
|
rlm@10
|
4278 (do
|
|
rlm@10
|
4279 (send-off agt fill)
|
|
rlm@10
|
4280 (cons (if (identical? x NIL) nil x) (drain)))))))]
|
|
rlm@10
|
4281 (send-off agt fill)
|
|
rlm@10
|
4282 (drain))))
|
|
rlm@10
|
4283
|
|
rlm@10
|
4284 (defn class?
|
|
rlm@10
|
4285 "Returns true if x is an instance of Class"
|
|
rlm@10
|
4286 {:added "1.0"}
|
|
rlm@10
|
4287 [x] (instance? Class x))
|
|
rlm@10
|
4288
|
|
rlm@10
|
4289 (defn- is-annotation? [c]
|
|
rlm@10
|
4290 (and (class? c)
|
|
rlm@10
|
4291 (.isAssignableFrom java.lang.annotation.Annotation c)))
|
|
rlm@10
|
4292
|
|
rlm@10
|
4293 (defn- is-runtime-annotation? [^Class c]
|
|
rlm@10
|
4294 (boolean
|
|
rlm@10
|
4295 (and (is-annotation? c)
|
|
rlm@10
|
4296 (when-let [^java.lang.annotation.Retention r
|
|
rlm@10
|
4297 (.getAnnotation c java.lang.annotation.Retention)]
|
|
rlm@10
|
4298 (= (.value r) java.lang.annotation.RetentionPolicy/RUNTIME)))))
|
|
rlm@10
|
4299
|
|
rlm@10
|
4300 (defn- descriptor [^Class c] (clojure.asm.Type/getDescriptor c))
|
|
rlm@10
|
4301
|
|
rlm@10
|
4302 (declare process-annotation)
|
|
rlm@10
|
4303 (defn- add-annotation [^clojure.asm.AnnotationVisitor av name v]
|
|
rlm@10
|
4304 (cond
|
|
rlm@10
|
4305 (vector? v) (let [avec (.visitArray av name)]
|
|
rlm@10
|
4306 (doseq [vval v]
|
|
rlm@10
|
4307 (add-annotation avec "value" vval))
|
|
rlm@10
|
4308 (.visitEnd avec))
|
|
rlm@10
|
4309 (symbol? v) (let [ev (eval v)]
|
|
rlm@10
|
4310 (cond
|
|
rlm@10
|
4311 (instance? java.lang.Enum ev)
|
|
rlm@10
|
4312 (.visitEnum av name (descriptor (class ev)) (str ev))
|
|
rlm@10
|
4313 (class? ev) (.visit av name (clojure.asm.Type/getType ev))
|
|
rlm@10
|
4314 :else (throw (IllegalArgumentException.
|
|
rlm@10
|
4315 (str "Unsupported annotation value: " v " of class " (class ev))))))
|
|
rlm@10
|
4316 (seq? v) (let [[nested nv] v
|
|
rlm@10
|
4317 c (resolve nested)
|
|
rlm@10
|
4318 nav (.visitAnnotation av name (descriptor c))]
|
|
rlm@10
|
4319 (process-annotation nav nv)
|
|
rlm@10
|
4320 (.visitEnd nav))
|
|
rlm@10
|
4321 :else (.visit av name v)))
|
|
rlm@10
|
4322
|
|
rlm@10
|
4323 (defn- process-annotation [av v]
|
|
rlm@10
|
4324 (if (map? v)
|
|
rlm@10
|
4325 (doseq [[k v] v]
|
|
rlm@10
|
4326 (add-annotation av (name k) v))
|
|
rlm@10
|
4327 (add-annotation av "value" v)))
|
|
rlm@10
|
4328
|
|
rlm@10
|
4329 (defn- add-annotations
|
|
rlm@10
|
4330 ([visitor m] (add-annotations visitor m nil))
|
|
rlm@10
|
4331 ([visitor m i]
|
|
rlm@10
|
4332 (doseq [[k v] m]
|
|
rlm@10
|
4333 (when (symbol? k)
|
|
rlm@10
|
4334 (when-let [c (resolve k)]
|
|
rlm@10
|
4335 (when (is-annotation? c)
|
|
rlm@10
|
4336 ;this is known duck/reflective as no common base of ASM Visitors
|
|
rlm@10
|
4337 (let [av (if i
|
|
rlm@10
|
4338 (.visitParameterAnnotation visitor i (descriptor c)
|
|
rlm@10
|
4339 (is-runtime-annotation? c))
|
|
rlm@10
|
4340 (.visitAnnotation visitor (descriptor c)
|
|
rlm@10
|
4341 (is-runtime-annotation? c)))]
|
|
rlm@10
|
4342 (process-annotation av v)
|
|
rlm@10
|
4343 (.visitEnd av))))))))
|
|
rlm@10
|
4344
|
|
rlm@10
|
4345 (defn alter-var-root
|
|
rlm@10
|
4346 "Atomically alters the root binding of var v by applying f to its
|
|
rlm@10
|
4347 current value plus any args"
|
|
rlm@10
|
4348 {:added "1.0"}
|
|
rlm@10
|
4349 [^clojure.lang.Var v f & args] (.alterRoot v f args))
|
|
rlm@10
|
4350
|
|
rlm@10
|
4351 (defn bound?
|
|
rlm@10
|
4352 "Returns true if all of the vars provided as arguments have any bound value, root or thread-local.
|
|
rlm@10
|
4353 Implies that deref'ing the provided vars will succeed. Returns true if no vars are provided."
|
|
rlm@10
|
4354 {:added "1.2"}
|
|
rlm@10
|
4355 [& vars]
|
|
rlm@10
|
4356 (every? #(.isBound ^clojure.lang.Var %) vars))
|
|
rlm@10
|
4357
|
|
rlm@10
|
4358 (defn thread-bound?
|
|
rlm@10
|
4359 "Returns true if all of the vars provided as arguments have thread-local bindings.
|
|
rlm@10
|
4360 Implies that set!'ing the provided vars will succeed. Returns true if no vars are provided."
|
|
rlm@10
|
4361 {:added "1.2"}
|
|
rlm@10
|
4362 [& vars]
|
|
rlm@10
|
4363 (every? #(.getThreadBinding ^clojure.lang.Var %) vars))
|
|
rlm@10
|
4364
|
|
rlm@10
|
4365 (defn make-hierarchy
|
|
rlm@10
|
4366 "Creates a hierarchy object for use with derive, isa? etc."
|
|
rlm@10
|
4367 {:added "1.0"}
|
|
rlm@10
|
4368 [] {:parents {} :descendants {} :ancestors {}})
|
|
rlm@10
|
4369
|
|
rlm@10
|
4370 (def ^{:private true}
|
|
rlm@10
|
4371 global-hierarchy (make-hierarchy))
|
|
rlm@10
|
4372
|
|
rlm@10
|
4373 (defn not-empty
|
|
rlm@10
|
4374 "If coll is empty, returns nil, else coll"
|
|
rlm@10
|
4375 {:added "1.0"}
|
|
rlm@10
|
4376 [coll] (when (seq coll) coll))
|
|
rlm@10
|
4377
|
|
rlm@10
|
4378 (defn bases
|
|
rlm@10
|
4379 "Returns the immediate superclass and direct interfaces of c, if any"
|
|
rlm@10
|
4380 {:added "1.0"}
|
|
rlm@10
|
4381 [^Class c]
|
|
rlm@10
|
4382 (when c
|
|
rlm@10
|
4383 (let [i (.getInterfaces c)
|
|
rlm@10
|
4384 s (.getSuperclass c)]
|
|
rlm@10
|
4385 (not-empty
|
|
rlm@10
|
4386 (if s (cons s i) i)))))
|
|
rlm@10
|
4387
|
|
rlm@10
|
4388 (defn supers
|
|
rlm@10
|
4389 "Returns the immediate and indirect superclasses and interfaces of c, if any"
|
|
rlm@10
|
4390 {:added "1.0"}
|
|
rlm@10
|
4391 [^Class class]
|
|
rlm@10
|
4392 (loop [ret (set (bases class)) cs ret]
|
|
rlm@10
|
4393 (if (seq cs)
|
|
rlm@10
|
4394 (let [c (first cs) bs (bases c)]
|
|
rlm@10
|
4395 (recur (into ret bs) (into (disj cs c) bs)))
|
|
rlm@10
|
4396 (not-empty ret))))
|
|
rlm@10
|
4397
|
|
rlm@10
|
4398 (defn isa?
|
|
rlm@10
|
4399 "Returns true if (= child parent), or child is directly or indirectly derived from
|
|
rlm@10
|
4400 parent, either via a Java type inheritance relationship or a
|
|
rlm@10
|
4401 relationship established via derive. h must be a hierarchy obtained
|
|
rlm@10
|
4402 from make-hierarchy, if not supplied defaults to the global
|
|
rlm@10
|
4403 hierarchy"
|
|
rlm@10
|
4404 {:added "1.0"}
|
|
rlm@10
|
4405 ([child parent] (isa? global-hierarchy child parent))
|
|
rlm@10
|
4406 ([h child parent]
|
|
rlm@10
|
4407 (or (= child parent)
|
|
rlm@10
|
4408 (and (class? parent) (class? child)
|
|
rlm@10
|
4409 (. ^Class parent isAssignableFrom child))
|
|
rlm@10
|
4410 (contains? ((:ancestors h) child) parent)
|
|
rlm@10
|
4411 (and (class? child) (some #(contains? ((:ancestors h) %) parent) (supers child)))
|
|
rlm@10
|
4412 (and (vector? parent) (vector? child)
|
|
rlm@10
|
4413 (= (count parent) (count child))
|
|
rlm@10
|
4414 (loop [ret true i 0]
|
|
rlm@10
|
4415 (if (or (not ret) (= i (count parent)))
|
|
rlm@10
|
4416 ret
|
|
rlm@10
|
4417 (recur (isa? h (child i) (parent i)) (inc i))))))))
|
|
rlm@10
|
4418
|
|
rlm@10
|
4419 (defn parents
|
|
rlm@10
|
4420 "Returns the immediate parents of tag, either via a Java type
|
|
rlm@10
|
4421 inheritance relationship or a relationship established via derive. h
|
|
rlm@10
|
4422 must be a hierarchy obtained from make-hierarchy, if not supplied
|
|
rlm@10
|
4423 defaults to the global hierarchy"
|
|
rlm@10
|
4424 {:added "1.0"}
|
|
rlm@10
|
4425 ([tag] (parents global-hierarchy tag))
|
|
rlm@10
|
4426 ([h tag] (not-empty
|
|
rlm@10
|
4427 (let [tp (get (:parents h) tag)]
|
|
rlm@10
|
4428 (if (class? tag)
|
|
rlm@10
|
4429 (into (set (bases tag)) tp)
|
|
rlm@10
|
4430 tp)))))
|
|
rlm@10
|
4431
|
|
rlm@10
|
4432 (defn ancestors
|
|
rlm@10
|
4433 "Returns the immediate and indirect parents of tag, either via a Java type
|
|
rlm@10
|
4434 inheritance relationship or a relationship established via derive. h
|
|
rlm@10
|
4435 must be a hierarchy obtained from make-hierarchy, if not supplied
|
|
rlm@10
|
4436 defaults to the global hierarchy"
|
|
rlm@10
|
4437 {:added "1.0"}
|
|
rlm@10
|
4438 ([tag] (ancestors global-hierarchy tag))
|
|
rlm@10
|
4439 ([h tag] (not-empty
|
|
rlm@10
|
4440 (let [ta (get (:ancestors h) tag)]
|
|
rlm@10
|
4441 (if (class? tag)
|
|
rlm@10
|
4442 (let [superclasses (set (supers tag))]
|
|
rlm@10
|
4443 (reduce into superclasses
|
|
rlm@10
|
4444 (cons ta
|
|
rlm@10
|
4445 (map #(get (:ancestors h) %) superclasses))))
|
|
rlm@10
|
4446 ta)))))
|
|
rlm@10
|
4447
|
|
rlm@10
|
4448 (defn descendants
|
|
rlm@10
|
4449 "Returns the immediate and indirect children of tag, through a
|
|
rlm@10
|
4450 relationship established via derive. h must be a hierarchy obtained
|
|
rlm@10
|
4451 from make-hierarchy, if not supplied defaults to the global
|
|
rlm@10
|
4452 hierarchy. Note: does not work on Java type inheritance
|
|
rlm@10
|
4453 relationships."
|
|
rlm@10
|
4454 {:added "1.0"}
|
|
rlm@10
|
4455 ([tag] (descendants global-hierarchy tag))
|
|
rlm@10
|
4456 ([h tag] (if (class? tag)
|
|
rlm@10
|
4457 (throw (java.lang.UnsupportedOperationException. "Can't get descendants of classes"))
|
|
rlm@10
|
4458 (not-empty (get (:descendants h) tag)))))
|
|
rlm@10
|
4459
|
|
rlm@10
|
4460 (defn derive
|
|
rlm@10
|
4461 "Establishes a parent/child relationship between parent and
|
|
rlm@10
|
4462 tag. Parent must be a namespace-qualified symbol or keyword and
|
|
rlm@10
|
4463 child can be either a namespace-qualified symbol or keyword or a
|
|
rlm@10
|
4464 class. h must be a hierarchy obtained from make-hierarchy, if not
|
|
rlm@10
|
4465 supplied defaults to, and modifies, the global hierarchy."
|
|
rlm@10
|
4466 {:added "1.0"}
|
|
rlm@10
|
4467 ([tag parent]
|
|
rlm@10
|
4468 (assert (namespace parent))
|
|
rlm@10
|
4469 (assert (or (class? tag) (and (instance? clojure.lang.Named tag) (namespace tag))))
|
|
rlm@10
|
4470
|
|
rlm@10
|
4471 (alter-var-root #'global-hierarchy derive tag parent) nil)
|
|
rlm@10
|
4472 ([h tag parent]
|
|
rlm@10
|
4473 (assert (not= tag parent))
|
|
rlm@10
|
4474 (assert (or (class? tag) (instance? clojure.lang.Named tag)))
|
|
rlm@10
|
4475 (assert (instance? clojure.lang.Named parent))
|
|
rlm@10
|
4476
|
|
rlm@10
|
4477 (let [tp (:parents h)
|
|
rlm@10
|
4478 td (:descendants h)
|
|
rlm@10
|
4479 ta (:ancestors h)
|
|
rlm@10
|
4480 tf (fn [m source sources target targets]
|
|
rlm@10
|
4481 (reduce (fn [ret k]
|
|
rlm@10
|
4482 (assoc ret k
|
|
rlm@10
|
4483 (reduce conj (get targets k #{}) (cons target (targets target)))))
|
|
rlm@10
|
4484 m (cons source (sources source))))]
|
|
rlm@10
|
4485 (or
|
|
rlm@10
|
4486 (when-not (contains? (tp tag) parent)
|
|
rlm@10
|
4487 (when (contains? (ta tag) parent)
|
|
rlm@10
|
4488 (throw (Exception. (print-str tag "already has" parent "as ancestor"))))
|
|
rlm@10
|
4489 (when (contains? (ta parent) tag)
|
|
rlm@10
|
4490 (throw (Exception. (print-str "Cyclic derivation:" parent "has" tag "as ancestor"))))
|
|
rlm@10
|
4491 {:parents (assoc (:parents h) tag (conj (get tp tag #{}) parent))
|
|
rlm@10
|
4492 :ancestors (tf (:ancestors h) tag td parent ta)
|
|
rlm@10
|
4493 :descendants (tf (:descendants h) parent ta tag td)})
|
|
rlm@10
|
4494 h))))
|
|
rlm@10
|
4495
|
|
rlm@10
|
4496 (declare flatten)
|
|
rlm@10
|
4497
|
|
rlm@10
|
4498 (defn underive
|
|
rlm@10
|
4499 "Removes a parent/child relationship between parent and
|
|
rlm@10
|
4500 tag. h must be a hierarchy obtained from make-hierarchy, if not
|
|
rlm@10
|
4501 supplied defaults to, and modifies, the global hierarchy."
|
|
rlm@10
|
4502 {:added "1.0"}
|
|
rlm@10
|
4503 ([tag parent] (alter-var-root #'global-hierarchy underive tag parent) nil)
|
|
rlm@10
|
4504 ([h tag parent]
|
|
rlm@10
|
4505 (let [parentMap (:parents h)
|
|
rlm@10
|
4506 childsParents (if (parentMap tag)
|
|
rlm@10
|
4507 (disj (parentMap tag) parent) #{})
|
|
rlm@10
|
4508 newParents (if (not-empty childsParents)
|
|
rlm@10
|
4509 (assoc parentMap tag childsParents)
|
|
rlm@10
|
4510 (dissoc parentMap tag))
|
|
rlm@10
|
4511 deriv-seq (flatten (map #(cons (key %) (interpose (key %) (val %)))
|
|
rlm@10
|
4512 (seq newParents)))]
|
|
rlm@10
|
4513 (if (contains? (parentMap tag) parent)
|
|
rlm@10
|
4514 (reduce #(apply derive %1 %2) (make-hierarchy)
|
|
rlm@10
|
4515 (partition 2 deriv-seq))
|
|
rlm@10
|
4516 h))))
|
|
rlm@10
|
4517
|
|
rlm@10
|
4518
|
|
rlm@10
|
4519 (defn distinct?
|
|
rlm@10
|
4520 "Returns true if no two of the arguments are ="
|
|
rlm@10
|
4521 {:tag Boolean
|
|
rlm@10
|
4522 :added "1.0"}
|
|
rlm@10
|
4523 ([x] true)
|
|
rlm@10
|
4524 ([x y] (not (= x y)))
|
|
rlm@10
|
4525 ([x y & more]
|
|
rlm@10
|
4526 (if (not= x y)
|
|
rlm@10
|
4527 (loop [s #{x y} [x & etc :as xs] more]
|
|
rlm@10
|
4528 (if xs
|
|
rlm@10
|
4529 (if (contains? s x)
|
|
rlm@10
|
4530 false
|
|
rlm@10
|
4531 (recur (conj s x) etc))
|
|
rlm@10
|
4532 true))
|
|
rlm@10
|
4533 false)))
|
|
rlm@10
|
4534
|
|
rlm@10
|
4535 (defn resultset-seq
|
|
rlm@10
|
4536 "Creates and returns a lazy sequence of structmaps corresponding to
|
|
rlm@10
|
4537 the rows in the java.sql.ResultSet rs"
|
|
rlm@10
|
4538 {:added "1.0"}
|
|
rlm@10
|
4539 [^java.sql.ResultSet rs]
|
|
rlm@10
|
4540 (let [rsmeta (. rs (getMetaData))
|
|
rlm@10
|
4541 idxs (range 1 (inc (. rsmeta (getColumnCount))))
|
|
rlm@10
|
4542 keys (map (comp keyword #(.toLowerCase ^String %))
|
|
rlm@10
|
4543 (map (fn [i] (. rsmeta (getColumnLabel i))) idxs))
|
|
rlm@10
|
4544 check-keys
|
|
rlm@10
|
4545 (or (apply distinct? keys)
|
|
rlm@10
|
4546 (throw (Exception. "ResultSet must have unique column labels")))
|
|
rlm@10
|
4547 row-struct (apply create-struct keys)
|
|
rlm@10
|
4548 row-values (fn [] (map (fn [^Integer i] (. rs (getObject i))) idxs))
|
|
rlm@10
|
4549 rows (fn thisfn []
|
|
rlm@10
|
4550 (when (. rs (next))
|
|
rlm@10
|
4551 (cons (apply struct row-struct (row-values)) (lazy-seq (thisfn)))))]
|
|
rlm@10
|
4552 (rows)))
|
|
rlm@10
|
4553
|
|
rlm@10
|
4554 (defn iterator-seq
|
|
rlm@10
|
4555 "Returns a seq on a java.util.Iterator. Note that most collections
|
|
rlm@10
|
4556 providing iterators implement Iterable and thus support seq directly."
|
|
rlm@10
|
4557 {:added "1.0"}
|
|
rlm@10
|
4558 [iter]
|
|
rlm@10
|
4559 (clojure.lang.IteratorSeq/create iter))
|
|
rlm@10
|
4560
|
|
rlm@10
|
4561 (defn enumeration-seq
|
|
rlm@10
|
4562 "Returns a seq on a java.util.Enumeration"
|
|
rlm@10
|
4563 {:added "1.0"}
|
|
rlm@10
|
4564 [e]
|
|
rlm@10
|
4565 (clojure.lang.EnumerationSeq/create e))
|
|
rlm@10
|
4566
|
|
rlm@10
|
4567 (defn format
|
|
rlm@10
|
4568 "Formats a string using java.lang.String.format, see java.util.Formatter for format
|
|
rlm@10
|
4569 string syntax"
|
|
rlm@10
|
4570 {:tag String
|
|
rlm@10
|
4571 :added "1.0"}
|
|
rlm@10
|
4572 [fmt & args]
|
|
rlm@10
|
4573 (String/format fmt (to-array args)))
|
|
rlm@10
|
4574
|
|
rlm@10
|
4575 (defn printf
|
|
rlm@10
|
4576 "Prints formatted output, as per format"
|
|
rlm@10
|
4577 {:added "1.0"}
|
|
rlm@10
|
4578 [fmt & args]
|
|
rlm@10
|
4579 (print (apply format fmt args)))
|
|
rlm@10
|
4580
|
|
rlm@10
|
4581 (declare gen-class)
|
|
rlm@10
|
4582
|
|
rlm@10
|
4583 (defmacro with-loading-context [& body]
|
|
rlm@10
|
4584 `((fn loading# []
|
|
rlm@10
|
4585 (. clojure.lang.Var (pushThreadBindings {clojure.lang.Compiler/LOADER
|
|
rlm@10
|
4586 (.getClassLoader (.getClass ^Object loading#))}))
|
|
rlm@10
|
4587 (try
|
|
rlm@10
|
4588 ~@body
|
|
rlm@10
|
4589 (finally
|
|
rlm@10
|
4590 (. clojure.lang.Var (popThreadBindings)))))))
|
|
rlm@10
|
4591
|
|
rlm@10
|
4592 (defmacro ns
|
|
rlm@10
|
4593 "Sets *ns* to the namespace named by name (unevaluated), creating it
|
|
rlm@10
|
4594 if needed. references can be zero or more of: (:refer-clojure ...)
|
|
rlm@10
|
4595 (:require ...) (:use ...) (:import ...) (:load ...) (:gen-class)
|
|
rlm@10
|
4596 with the syntax of refer-clojure/require/use/import/load/gen-class
|
|
rlm@10
|
4597 respectively, except the arguments are unevaluated and need not be
|
|
rlm@10
|
4598 quoted. (:gen-class ...), when supplied, defaults to :name
|
|
rlm@10
|
4599 corresponding to the ns name, :main true, :impl-ns same as ns, and
|
|
rlm@10
|
4600 :init-impl-ns true. All options of gen-class are
|
|
rlm@10
|
4601 supported. The :gen-class directive is ignored when not
|
|
rlm@10
|
4602 compiling. If :gen-class is not supplied, when compiled only an
|
|
rlm@10
|
4603 nsname__init.class will be generated. If :refer-clojure is not used, a
|
|
rlm@10
|
4604 default (refer 'clojure) is used. Use of ns is preferred to
|
|
rlm@10
|
4605 individual calls to in-ns/require/use/import:
|
|
rlm@10
|
4606
|
|
rlm@10
|
4607 (ns foo.bar
|
|
rlm@10
|
4608 (:refer-clojure :exclude [ancestors printf])
|
|
rlm@10
|
4609 (:require (clojure.contrib sql sql.tests))
|
|
rlm@10
|
4610 (:use (my.lib this that))
|
|
rlm@10
|
4611 (:import (java.util Date Timer Random)
|
|
rlm@10
|
4612 (java.sql Connection Statement)))"
|
|
rlm@10
|
4613 {:arglists '([name docstring? attr-map? references*])
|
|
rlm@10
|
4614 :added "1.0"}
|
|
rlm@10
|
4615 [name & references]
|
|
rlm@10
|
4616 (let [process-reference
|
|
rlm@10
|
4617 (fn [[kname & args]]
|
|
rlm@10
|
4618 `(~(symbol "clojure.core" (clojure.core/name kname))
|
|
rlm@10
|
4619 ~@(map #(list 'quote %) args)))
|
|
rlm@10
|
4620 docstring (when (string? (first references)) (first references))
|
|
rlm@10
|
4621 references (if docstring (next references) references)
|
|
rlm@10
|
4622 name (if docstring
|
|
rlm@10
|
4623 (vary-meta name assoc :doc docstring)
|
|
rlm@10
|
4624 name)
|
|
rlm@10
|
4625 metadata (when (map? (first references)) (first references))
|
|
rlm@10
|
4626 references (if metadata (next references) references)
|
|
rlm@10
|
4627 name (if metadata
|
|
rlm@10
|
4628 (vary-meta name merge metadata)
|
|
rlm@10
|
4629 name)
|
|
rlm@10
|
4630 gen-class-clause (first (filter #(= :gen-class (first %)) references))
|
|
rlm@10
|
4631 gen-class-call
|
|
rlm@10
|
4632 (when gen-class-clause
|
|
rlm@10
|
4633 (list* `gen-class :name (.replace (str name) \- \_) :impl-ns name :main true (next gen-class-clause)))
|
|
rlm@10
|
4634 references (remove #(= :gen-class (first %)) references)
|
|
rlm@10
|
4635 ;ns-effect (clojure.core/in-ns name)
|
|
rlm@10
|
4636 ]
|
|
rlm@10
|
4637 `(do
|
|
rlm@10
|
4638 (clojure.core/in-ns '~name)
|
|
rlm@10
|
4639 (with-loading-context
|
|
rlm@10
|
4640 ~@(when gen-class-call (list gen-class-call))
|
|
rlm@10
|
4641 ~@(when (and (not= name 'clojure.core) (not-any? #(= :refer-clojure (first %)) references))
|
|
rlm@10
|
4642 `((clojure.core/refer '~'clojure.core)))
|
|
rlm@10
|
4643 ~@(map process-reference references)))))
|
|
rlm@10
|
4644
|
|
rlm@10
|
4645 (defmacro refer-clojure
|
|
rlm@10
|
4646 "Same as (refer 'clojure.core <filters>)"
|
|
rlm@10
|
4647 {:added "1.0"}
|
|
rlm@10
|
4648 [& filters]
|
|
rlm@10
|
4649 `(clojure.core/refer '~'clojure.core ~@filters))
|
|
rlm@10
|
4650
|
|
rlm@10
|
4651 (defmacro defonce
|
|
rlm@10
|
4652 "defs name to have the root value of the expr iff the named var has no root value,
|
|
rlm@10
|
4653 else expr is unevaluated"
|
|
rlm@10
|
4654 {:added "1.0"}
|
|
rlm@10
|
4655 [name expr]
|
|
rlm@10
|
4656 `(let [v# (def ~name)]
|
|
rlm@10
|
4657 (when-not (.hasRoot v#)
|
|
rlm@10
|
4658 (def ~name ~expr))))
|
|
rlm@10
|
4659
|
|
rlm@10
|
4660 ;;;;;;;;;;; require/use/load, contributed by Stephen C. Gilardi ;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
4661
|
|
rlm@10
|
4662 (defonce
|
|
rlm@10
|
4663 ^{:private true
|
|
rlm@10
|
4664 :doc "A ref to a sorted set of symbols representing loaded libs"}
|
|
rlm@10
|
4665 *loaded-libs* (ref (sorted-set)))
|
|
rlm@10
|
4666
|
|
rlm@10
|
4667 (defonce
|
|
rlm@10
|
4668 ^{:private true
|
|
rlm@10
|
4669 :doc "the set of paths currently being loaded by this thread"}
|
|
rlm@10
|
4670 *pending-paths* #{})
|
|
rlm@10
|
4671
|
|
rlm@10
|
4672 (defonce
|
|
rlm@10
|
4673 ^{:private true :doc
|
|
rlm@10
|
4674 "True while a verbose load is pending"}
|
|
rlm@10
|
4675 *loading-verbosely* false)
|
|
rlm@10
|
4676
|
|
rlm@10
|
4677 (defn- throw-if
|
|
rlm@10
|
4678 "Throws an exception with a message if pred is true"
|
|
rlm@10
|
4679 [pred fmt & args]
|
|
rlm@10
|
4680 (when pred
|
|
rlm@10
|
4681 (let [^String message (apply format fmt args)
|
|
rlm@10
|
4682 exception (Exception. message)
|
|
rlm@10
|
4683 raw-trace (.getStackTrace exception)
|
|
rlm@10
|
4684 boring? #(not= (.getMethodName ^StackTraceElement %) "doInvoke")
|
|
rlm@10
|
4685 trace (into-array (drop 2 (drop-while boring? raw-trace)))]
|
|
rlm@10
|
4686 (.setStackTrace exception trace)
|
|
rlm@10
|
4687 (throw exception))))
|
|
rlm@10
|
4688
|
|
rlm@10
|
4689 (defn- libspec?
|
|
rlm@10
|
4690 "Returns true if x is a libspec"
|
|
rlm@10
|
4691 [x]
|
|
rlm@10
|
4692 (or (symbol? x)
|
|
rlm@10
|
4693 (and (vector? x)
|
|
rlm@10
|
4694 (or
|
|
rlm@10
|
4695 (nil? (second x))
|
|
rlm@10
|
4696 (keyword? (second x))))))
|
|
rlm@10
|
4697
|
|
rlm@10
|
4698 (defn- prependss
|
|
rlm@10
|
4699 "Prepends a symbol or a seq to coll"
|
|
rlm@10
|
4700 [x coll]
|
|
rlm@10
|
4701 (if (symbol? x)
|
|
rlm@10
|
4702 (cons x coll)
|
|
rlm@10
|
4703 (concat x coll)))
|
|
rlm@10
|
4704
|
|
rlm@10
|
4705 (defn- root-resource
|
|
rlm@10
|
4706 "Returns the root directory path for a lib"
|
|
rlm@10
|
4707 {:tag String}
|
|
rlm@10
|
4708 [lib]
|
|
rlm@10
|
4709 (str \/
|
|
rlm@10
|
4710 (.. (name lib)
|
|
rlm@10
|
4711 (replace \- \_)
|
|
rlm@10
|
4712 (replace \. \/))))
|
|
rlm@10
|
4713
|
|
rlm@10
|
4714 (defn- root-directory
|
|
rlm@10
|
4715 "Returns the root resource path for a lib"
|
|
rlm@10
|
4716 [lib]
|
|
rlm@10
|
4717 (let [d (root-resource lib)]
|
|
rlm@10
|
4718 (subs d 0 (.lastIndexOf d "/"))))
|
|
rlm@10
|
4719
|
|
rlm@10
|
4720 (declare load)
|
|
rlm@10
|
4721
|
|
rlm@10
|
4722 (defn- load-one
|
|
rlm@10
|
4723 "Loads a lib given its name. If need-ns, ensures that the associated
|
|
rlm@10
|
4724 namespace exists after loading. If require, records the load so any
|
|
rlm@10
|
4725 duplicate loads can be skipped."
|
|
rlm@10
|
4726 [lib need-ns require]
|
|
rlm@10
|
4727 (load (root-resource lib))
|
|
rlm@10
|
4728 (throw-if (and need-ns (not (find-ns lib)))
|
|
rlm@10
|
4729 "namespace '%s' not found after loading '%s'"
|
|
rlm@10
|
4730 lib (root-resource lib))
|
|
rlm@10
|
4731 (when require
|
|
rlm@10
|
4732 (dosync
|
|
rlm@10
|
4733 (commute *loaded-libs* conj lib))))
|
|
rlm@10
|
4734
|
|
rlm@10
|
4735 (defn- load-all
|
|
rlm@10
|
4736 "Loads a lib given its name and forces a load of any libs it directly or
|
|
rlm@10
|
4737 indirectly loads. If need-ns, ensures that the associated namespace
|
|
rlm@10
|
4738 exists after loading. If require, records the load so any duplicate loads
|
|
rlm@10
|
4739 can be skipped."
|
|
rlm@10
|
4740 [lib need-ns require]
|
|
rlm@10
|
4741 (dosync
|
|
rlm@10
|
4742 (commute *loaded-libs* #(reduce conj %1 %2)
|
|
rlm@10
|
4743 (binding [*loaded-libs* (ref (sorted-set))]
|
|
rlm@10
|
4744 (load-one lib need-ns require)
|
|
rlm@10
|
4745 @*loaded-libs*))))
|
|
rlm@10
|
4746
|
|
rlm@10
|
4747 (defn- load-lib
|
|
rlm@10
|
4748 "Loads a lib with options"
|
|
rlm@10
|
4749 [prefix lib & options]
|
|
rlm@10
|
4750 (throw-if (and prefix (pos? (.indexOf (name lib) (int \.))))
|
|
rlm@10
|
4751 "lib names inside prefix lists must not contain periods")
|
|
rlm@10
|
4752 (let [lib (if prefix (symbol (str prefix \. lib)) lib)
|
|
rlm@10
|
4753 opts (apply hash-map options)
|
|
rlm@10
|
4754 {:keys [as reload reload-all require use verbose]} opts
|
|
rlm@10
|
4755 loaded (contains? @*loaded-libs* lib)
|
|
rlm@10
|
4756 load (cond reload-all
|
|
rlm@10
|
4757 load-all
|
|
rlm@10
|
4758 (or reload (not require) (not loaded))
|
|
rlm@10
|
4759 load-one)
|
|
rlm@10
|
4760 need-ns (or as use)
|
|
rlm@10
|
4761 filter-opts (select-keys opts '(:exclude :only :rename))]
|
|
rlm@10
|
4762 (binding [*loading-verbosely* (or *loading-verbosely* verbose)]
|
|
rlm@10
|
4763 (if load
|
|
rlm@10
|
4764 (load lib need-ns require)
|
|
rlm@10
|
4765 (throw-if (and need-ns (not (find-ns lib)))
|
|
rlm@10
|
4766 "namespace '%s' not found" lib))
|
|
rlm@10
|
4767 (when (and need-ns *loading-verbosely*)
|
|
rlm@10
|
4768 (printf "(clojure.core/in-ns '%s)\n" (ns-name *ns*)))
|
|
rlm@10
|
4769 (when as
|
|
rlm@10
|
4770 (when *loading-verbosely*
|
|
rlm@10
|
4771 (printf "(clojure.core/alias '%s '%s)\n" as lib))
|
|
rlm@10
|
4772 (alias as lib))
|
|
rlm@10
|
4773 (when use
|
|
rlm@10
|
4774 (when *loading-verbosely*
|
|
rlm@10
|
4775 (printf "(clojure.core/refer '%s" lib)
|
|
rlm@10
|
4776 (doseq [opt filter-opts]
|
|
rlm@10
|
4777 (printf " %s '%s" (key opt) (print-str (val opt))))
|
|
rlm@10
|
4778 (printf ")\n"))
|
|
rlm@10
|
4779 (apply refer lib (mapcat seq filter-opts))))))
|
|
rlm@10
|
4780
|
|
rlm@10
|
4781 (defn- load-libs
|
|
rlm@10
|
4782 "Loads libs, interpreting libspecs, prefix lists, and flags for
|
|
rlm@10
|
4783 forwarding to load-lib"
|
|
rlm@10
|
4784 [& args]
|
|
rlm@10
|
4785 (let [flags (filter keyword? args)
|
|
rlm@10
|
4786 opts (interleave flags (repeat true))
|
|
rlm@10
|
4787 args (filter (complement keyword?) args)]
|
|
rlm@10
|
4788 ; check for unsupported options
|
|
rlm@10
|
4789 (let [supported #{:as :reload :reload-all :require :use :verbose}
|
|
rlm@10
|
4790 unsupported (seq (remove supported flags))]
|
|
rlm@10
|
4791 (throw-if unsupported
|
|
rlm@10
|
4792 (apply str "Unsupported option(s) supplied: "
|
|
rlm@10
|
4793 (interpose \, unsupported))))
|
|
rlm@10
|
4794 ; check a load target was specified
|
|
rlm@10
|
4795 (throw-if (not (seq args)) "Nothing specified to load")
|
|
rlm@10
|
4796 (doseq [arg args]
|
|
rlm@10
|
4797 (if (libspec? arg)
|
|
rlm@10
|
4798 (apply load-lib nil (prependss arg opts))
|
|
rlm@10
|
4799 (let [[prefix & args] arg]
|
|
rlm@10
|
4800 (throw-if (nil? prefix) "prefix cannot be nil")
|
|
rlm@10
|
4801 (doseq [arg args]
|
|
rlm@10
|
4802 (apply load-lib prefix (prependss arg opts))))))))
|
|
rlm@10
|
4803
|
|
rlm@10
|
4804 ;; Public
|
|
rlm@10
|
4805
|
|
rlm@10
|
4806
|
|
rlm@10
|
4807 (defn require
|
|
rlm@10
|
4808 "Loads libs, skipping any that are already loaded. Each argument is
|
|
rlm@10
|
4809 either a libspec that identifies a lib, a prefix list that identifies
|
|
rlm@10
|
4810 multiple libs whose names share a common prefix, or a flag that modifies
|
|
rlm@10
|
4811 how all the identified libs are loaded. Use :require in the ns macro
|
|
rlm@10
|
4812 in preference to calling this directly.
|
|
rlm@10
|
4813
|
|
rlm@10
|
4814 Libs
|
|
rlm@10
|
4815
|
|
rlm@10
|
4816 A 'lib' is a named set of resources in classpath whose contents define a
|
|
rlm@10
|
4817 library of Clojure code. Lib names are symbols and each lib is associated
|
|
rlm@10
|
4818 with a Clojure namespace and a Java package that share its name. A lib's
|
|
rlm@10
|
4819 name also locates its root directory within classpath using Java's
|
|
rlm@10
|
4820 package name to classpath-relative path mapping. All resources in a lib
|
|
rlm@10
|
4821 should be contained in the directory structure under its root directory.
|
|
rlm@10
|
4822 All definitions a lib makes should be in its associated namespace.
|
|
rlm@10
|
4823
|
|
rlm@10
|
4824 'require loads a lib by loading its root resource. The root resource path
|
|
rlm@10
|
4825 is derived from the lib name in the following manner:
|
|
rlm@10
|
4826 Consider a lib named by the symbol 'x.y.z; it has the root directory
|
|
rlm@10
|
4827 <classpath>/x/y/, and its root resource is <classpath>/x/y/z.clj. The root
|
|
rlm@10
|
4828 resource should contain code to create the lib's namespace (usually by using
|
|
rlm@10
|
4829 the ns macro) and load any additional lib resources.
|
|
rlm@10
|
4830
|
|
rlm@10
|
4831 Libspecs
|
|
rlm@10
|
4832
|
|
rlm@10
|
4833 A libspec is a lib name or a vector containing a lib name followed by
|
|
rlm@10
|
4834 options expressed as sequential keywords and arguments.
|
|
rlm@10
|
4835
|
|
rlm@10
|
4836 Recognized options: :as
|
|
rlm@10
|
4837 :as takes a symbol as its argument and makes that symbol an alias to the
|
|
rlm@10
|
4838 lib's namespace in the current namespace.
|
|
rlm@10
|
4839
|
|
rlm@10
|
4840 Prefix Lists
|
|
rlm@10
|
4841
|
|
rlm@10
|
4842 It's common for Clojure code to depend on several libs whose names have
|
|
rlm@10
|
4843 the same prefix. When specifying libs, prefix lists can be used to reduce
|
|
rlm@10
|
4844 repetition. A prefix list contains the shared prefix followed by libspecs
|
|
rlm@10
|
4845 with the shared prefix removed from the lib names. After removing the
|
|
rlm@10
|
4846 prefix, the names that remain must not contain any periods.
|
|
rlm@10
|
4847
|
|
rlm@10
|
4848 Flags
|
|
rlm@10
|
4849
|
|
rlm@10
|
4850 A flag is a keyword.
|
|
rlm@10
|
4851 Recognized flags: :reload, :reload-all, :verbose
|
|
rlm@10
|
4852 :reload forces loading of all the identified libs even if they are
|
|
rlm@10
|
4853 already loaded
|
|
rlm@10
|
4854 :reload-all implies :reload and also forces loading of all libs that the
|
|
rlm@10
|
4855 identified libs directly or indirectly load via require or use
|
|
rlm@10
|
4856 :verbose triggers printing information about each load, alias, and refer
|
|
rlm@10
|
4857
|
|
rlm@10
|
4858 Example:
|
|
rlm@10
|
4859
|
|
rlm@10
|
4860 The following would load the libraries clojure.zip and clojure.set
|
|
rlm@10
|
4861 abbreviated as 's'.
|
|
rlm@10
|
4862
|
|
rlm@10
|
4863 (require '(clojure zip [set :as s]))"
|
|
rlm@10
|
4864 {:added "1.0"}
|
|
rlm@10
|
4865
|
|
rlm@10
|
4866 [& args]
|
|
rlm@10
|
4867 (apply load-libs :require args))
|
|
rlm@10
|
4868
|
|
rlm@10
|
4869 (defn use
|
|
rlm@10
|
4870 "Like 'require, but also refers to each lib's namespace using
|
|
rlm@10
|
4871 clojure.core/refer. Use :use in the ns macro in preference to calling
|
|
rlm@10
|
4872 this directly.
|
|
rlm@10
|
4873
|
|
rlm@10
|
4874 'use accepts additional options in libspecs: :exclude, :only, :rename.
|
|
rlm@10
|
4875 The arguments and semantics for :exclude, :only, and :rename are the same
|
|
rlm@10
|
4876 as those documented for clojure.core/refer."
|
|
rlm@10
|
4877 {:added "1.0"}
|
|
rlm@10
|
4878 [& args] (apply load-libs :require :use args))
|
|
rlm@10
|
4879
|
|
rlm@10
|
4880 (defn loaded-libs
|
|
rlm@10
|
4881 "Returns a sorted set of symbols naming the currently loaded libs"
|
|
rlm@10
|
4882 {:added "1.0"}
|
|
rlm@10
|
4883 [] @*loaded-libs*)
|
|
rlm@10
|
4884
|
|
rlm@10
|
4885 (defn load
|
|
rlm@10
|
4886 "Loads Clojure code from resources in classpath. A path is interpreted as
|
|
rlm@10
|
4887 classpath-relative if it begins with a slash or relative to the root
|
|
rlm@10
|
4888 directory for the current namespace otherwise."
|
|
rlm@10
|
4889 {:added "1.0"}
|
|
rlm@10
|
4890 [& paths]
|
|
rlm@10
|
4891 (doseq [^String path paths]
|
|
rlm@10
|
4892 (let [^String path (if (.startsWith path "/")
|
|
rlm@10
|
4893 path
|
|
rlm@10
|
4894 (str (root-directory (ns-name *ns*)) \/ path))]
|
|
rlm@10
|
4895 (when *loading-verbosely*
|
|
rlm@10
|
4896 (printf "(clojure.core/load \"%s\")\n" path)
|
|
rlm@10
|
4897 (flush))
|
|
rlm@10
|
4898 ; (throw-if (*pending-paths* path)
|
|
rlm@10
|
4899 ; "cannot load '%s' again while it is loading"
|
|
rlm@10
|
4900 ; path)
|
|
rlm@10
|
4901 (when-not (*pending-paths* path)
|
|
rlm@10
|
4902 (binding [*pending-paths* (conj *pending-paths* path)]
|
|
rlm@10
|
4903 (clojure.lang.RT/load (.substring path 1)))))))
|
|
rlm@10
|
4904
|
|
rlm@10
|
4905 (defn compile
|
|
rlm@10
|
4906 "Compiles the namespace named by the symbol lib into a set of
|
|
rlm@10
|
4907 classfiles. The source for the lib must be in a proper
|
|
rlm@10
|
4908 classpath-relative directory. The output files will go into the
|
|
rlm@10
|
4909 directory specified by *compile-path*, and that directory too must
|
|
rlm@10
|
4910 be in the classpath."
|
|
rlm@10
|
4911 {:added "1.0"}
|
|
rlm@10
|
4912 [lib]
|
|
rlm@10
|
4913 (binding [*compile-files* true]
|
|
rlm@10
|
4914 (load-one lib true true))
|
|
rlm@10
|
4915 lib)
|
|
rlm@10
|
4916
|
|
rlm@10
|
4917 ;;;;;;;;;;;;; nested associative ops ;;;;;;;;;;;
|
|
rlm@10
|
4918
|
|
rlm@10
|
4919 (defn get-in
|
|
rlm@10
|
4920 "Returns the value in a nested associative structure,
|
|
rlm@10
|
4921 where ks is a sequence of ke(ys. Returns nil if the key is not present,
|
|
rlm@10
|
4922 or the not-found value if supplied."
|
|
rlm@10
|
4923 {:added "1.2"}
|
|
rlm@10
|
4924 ([m ks]
|
|
rlm@10
|
4925 (reduce get m ks))
|
|
rlm@10
|
4926 ([m ks not-found]
|
|
rlm@10
|
4927 (loop [sentinel (Object.)
|
|
rlm@10
|
4928 m m
|
|
rlm@10
|
4929 ks (seq ks)]
|
|
rlm@10
|
4930 (if ks
|
|
rlm@10
|
4931 (let [m (get m (first ks) sentinel)]
|
|
rlm@10
|
4932 (if (identical? sentinel m)
|
|
rlm@10
|
4933 not-found
|
|
rlm@10
|
4934 (recur sentinel m (next ks))))
|
|
rlm@10
|
4935 m))))
|
|
rlm@10
|
4936
|
|
rlm@10
|
4937 (defn assoc-in
|
|
rlm@10
|
4938 "Associates a value in a nested associative structure, where ks is a
|
|
rlm@10
|
4939 sequence of keys and v is the new value and returns a new nested structure.
|
|
rlm@10
|
4940 If any levels do not exist, hash-maps will be created."
|
|
rlm@10
|
4941 {:added "1.0"}
|
|
rlm@10
|
4942 [m [k & ks] v]
|
|
rlm@10
|
4943 (if ks
|
|
rlm@10
|
4944 (assoc m k (assoc-in (get m k) ks v))
|
|
rlm@10
|
4945 (assoc m k v)))
|
|
rlm@10
|
4946
|
|
rlm@10
|
4947 (defn update-in
|
|
rlm@10
|
4948 "'Updates' a value in a nested associative structure, where ks is a
|
|
rlm@10
|
4949 sequence of keys and f is a function that will take the old value
|
|
rlm@10
|
4950 and any supplied args and return the new value, and returns a new
|
|
rlm@10
|
4951 nested structure. If any levels do not exist, hash-maps will be
|
|
rlm@10
|
4952 created."
|
|
rlm@10
|
4953 {:added "1.0"}
|
|
rlm@10
|
4954 ([m [k & ks] f & args]
|
|
rlm@10
|
4955 (if ks
|
|
rlm@10
|
4956 (assoc m k (apply update-in (get m k) ks f args))
|
|
rlm@10
|
4957 (assoc m k (apply f (get m k) args)))))
|
|
rlm@10
|
4958
|
|
rlm@10
|
4959
|
|
rlm@10
|
4960 (defn empty?
|
|
rlm@10
|
4961 "Returns true if coll has no items - same as (not (seq coll)).
|
|
rlm@10
|
4962 Please use the idiom (seq x) rather than (not (empty? x))"
|
|
rlm@10
|
4963 {:added "1.0"}
|
|
rlm@10
|
4964 [coll] (not (seq coll)))
|
|
rlm@10
|
4965
|
|
rlm@10
|
4966 (defn coll?
|
|
rlm@10
|
4967 "Returns true if x implements IPersistentCollection"
|
|
rlm@10
|
4968 {:added "1.0"}
|
|
rlm@10
|
4969 [x] (instance? clojure.lang.IPersistentCollection x))
|
|
rlm@10
|
4970
|
|
rlm@10
|
4971 (defn list?
|
|
rlm@10
|
4972 "Returns true if x implements IPersistentList"
|
|
rlm@10
|
4973 {:added "1.0"}
|
|
rlm@10
|
4974 [x] (instance? clojure.lang.IPersistentList x))
|
|
rlm@10
|
4975
|
|
rlm@10
|
4976 (defn set?
|
|
rlm@10
|
4977 "Returns true if x implements IPersistentSet"
|
|
rlm@10
|
4978 {:added "1.0"}
|
|
rlm@10
|
4979 [x] (instance? clojure.lang.IPersistentSet x))
|
|
rlm@10
|
4980
|
|
rlm@10
|
4981 (defn ifn?
|
|
rlm@10
|
4982 "Returns true if x implements IFn. Note that many data structures
|
|
rlm@10
|
4983 (e.g. sets and maps) implement IFn"
|
|
rlm@10
|
4984 {:added "1.0"}
|
|
rlm@10
|
4985 [x] (instance? clojure.lang.IFn x))
|
|
rlm@10
|
4986
|
|
rlm@10
|
4987 (defn fn?
|
|
rlm@10
|
4988 "Returns true if x implements Fn, i.e. is an object created via fn."
|
|
rlm@10
|
4989 {:added "1.0"}
|
|
rlm@10
|
4990 [x] (instance? clojure.lang.Fn x))
|
|
rlm@10
|
4991
|
|
rlm@10
|
4992
|
|
rlm@10
|
4993 (defn associative?
|
|
rlm@10
|
4994 "Returns true if coll implements Associative"
|
|
rlm@10
|
4995 {:added "1.0"}
|
|
rlm@10
|
4996 [coll] (instance? clojure.lang.Associative coll))
|
|
rlm@10
|
4997
|
|
rlm@10
|
4998 (defn sequential?
|
|
rlm@10
|
4999 "Returns true if coll implements Sequential"
|
|
rlm@10
|
5000 {:added "1.0"}
|
|
rlm@10
|
5001 [coll] (instance? clojure.lang.Sequential coll))
|
|
rlm@10
|
5002
|
|
rlm@10
|
5003 (defn sorted?
|
|
rlm@10
|
5004 "Returns true if coll implements Sorted"
|
|
rlm@10
|
5005 {:added "1.0"}
|
|
rlm@10
|
5006 [coll] (instance? clojure.lang.Sorted coll))
|
|
rlm@10
|
5007
|
|
rlm@10
|
5008 (defn counted?
|
|
rlm@10
|
5009 "Returns true if coll implements count in constant time"
|
|
rlm@10
|
5010 {:added "1.0"}
|
|
rlm@10
|
5011 [coll] (instance? clojure.lang.Counted coll))
|
|
rlm@10
|
5012
|
|
rlm@10
|
5013 (defn reversible?
|
|
rlm@10
|
5014 "Returns true if coll implements Reversible"
|
|
rlm@10
|
5015 {:added "1.0"}
|
|
rlm@10
|
5016 [coll] (instance? clojure.lang.Reversible coll))
|
|
rlm@10
|
5017
|
|
rlm@10
|
5018 (def
|
|
rlm@10
|
5019 ^{:doc "bound in a repl thread to the most recent value printed"
|
|
rlm@10
|
5020 :added "1.0"}
|
|
rlm@10
|
5021 *1)
|
|
rlm@10
|
5022
|
|
rlm@10
|
5023 (def
|
|
rlm@10
|
5024 ^{:doc "bound in a repl thread to the second most recent value printed"
|
|
rlm@10
|
5025 :added "1.0"}
|
|
rlm@10
|
5026 *2)
|
|
rlm@10
|
5027
|
|
rlm@10
|
5028 (def
|
|
rlm@10
|
5029 ^{:doc "bound in a repl thread to the third most recent value printed"
|
|
rlm@10
|
5030 :added "1.0"}
|
|
rlm@10
|
5031 *3)
|
|
rlm@10
|
5032
|
|
rlm@10
|
5033 (def
|
|
rlm@10
|
5034 ^{:doc "bound in a repl thread to the most recent exception caught by the repl"
|
|
rlm@10
|
5035 :added "1.0"}
|
|
rlm@10
|
5036 *e)
|
|
rlm@10
|
5037
|
|
rlm@10
|
5038 (defn trampoline
|
|
rlm@10
|
5039 "trampoline can be used to convert algorithms requiring mutual
|
|
rlm@10
|
5040 recursion without stack consumption. Calls f with supplied args, if
|
|
rlm@10
|
5041 any. If f returns a fn, calls that fn with no arguments, and
|
|
rlm@10
|
5042 continues to repeat, until the return value is not a fn, then
|
|
rlm@10
|
5043 returns that non-fn value. Note that if you want to return a fn as a
|
|
rlm@10
|
5044 final value, you must wrap it in some data structure and unpack it
|
|
rlm@10
|
5045 after trampoline returns."
|
|
rlm@10
|
5046 {:added "1.0"}
|
|
rlm@10
|
5047 ([f]
|
|
rlm@10
|
5048 (let [ret (f)]
|
|
rlm@10
|
5049 (if (fn? ret)
|
|
rlm@10
|
5050 (recur ret)
|
|
rlm@10
|
5051 ret)))
|
|
rlm@10
|
5052 ([f & args]
|
|
rlm@10
|
5053 (trampoline #(apply f args))))
|
|
rlm@10
|
5054
|
|
rlm@10
|
5055 (defn intern
|
|
rlm@10
|
5056 "Finds or creates a var named by the symbol name in the namespace
|
|
rlm@10
|
5057 ns (which can be a symbol or a namespace), setting its root binding
|
|
rlm@10
|
5058 to val if supplied. The namespace must exist. The var will adopt any
|
|
rlm@10
|
5059 metadata from the name symbol. Returns the var."
|
|
rlm@10
|
5060 {:added "1.0"}
|
|
rlm@10
|
5061 ([ns ^clojure.lang.Symbol name]
|
|
rlm@10
|
5062 (let [v (clojure.lang.Var/intern (the-ns ns) name)]
|
|
rlm@10
|
5063 (when (meta name) (.setMeta v (meta name)))
|
|
rlm@10
|
5064 v))
|
|
rlm@10
|
5065 ([ns name val]
|
|
rlm@10
|
5066 (let [v (clojure.lang.Var/intern (the-ns ns) name val)]
|
|
rlm@10
|
5067 (when (meta name) (.setMeta v (meta name)))
|
|
rlm@10
|
5068 v)))
|
|
rlm@10
|
5069
|
|
rlm@10
|
5070 (defmacro while
|
|
rlm@10
|
5071 "Repeatedly executes body while test expression is true. Presumes
|
|
rlm@10
|
5072 some side-effect will cause test to become false/nil. Returns nil"
|
|
rlm@10
|
5073 {:added "1.0"}
|
|
rlm@10
|
5074 [test & body]
|
|
rlm@10
|
5075 `(loop []
|
|
rlm@10
|
5076 (when ~test
|
|
rlm@10
|
5077 ~@body
|
|
rlm@10
|
5078 (recur))))
|
|
rlm@10
|
5079
|
|
rlm@10
|
5080 (defn memoize
|
|
rlm@10
|
5081 "Returns a memoized version of a referentially transparent function. The
|
|
rlm@10
|
5082 memoized version of the function keeps a cache of the mapping from arguments
|
|
rlm@10
|
5083 to results and, when calls with the same arguments are repeated often, has
|
|
rlm@10
|
5084 higher performance at the expense of higher memory use."
|
|
rlm@10
|
5085 {:added "1.0"}
|
|
rlm@10
|
5086 [f]
|
|
rlm@10
|
5087 (let [mem (atom {})]
|
|
rlm@10
|
5088 (fn [& args]
|
|
rlm@10
|
5089 (if-let [e (find @mem args)]
|
|
rlm@10
|
5090 (val e)
|
|
rlm@10
|
5091 (let [ret (apply f args)]
|
|
rlm@10
|
5092 (swap! mem assoc args ret)
|
|
rlm@10
|
5093 ret)))))
|
|
rlm@10
|
5094
|
|
rlm@10
|
5095 (defmacro condp
|
|
rlm@10
|
5096 "Takes a binary predicate, an expression, and a set of clauses.
|
|
rlm@10
|
5097 Each clause can take the form of either:
|
|
rlm@10
|
5098
|
|
rlm@10
|
5099 test-expr result-expr
|
|
rlm@10
|
5100
|
|
rlm@10
|
5101 test-expr :>> result-fn
|
|
rlm@10
|
5102
|
|
rlm@10
|
5103 Note :>> is an ordinary keyword.
|
|
rlm@10
|
5104
|
|
rlm@10
|
5105 For each clause, (pred test-expr expr) is evaluated. If it returns
|
|
rlm@10
|
5106 logical true, the clause is a match. If a binary clause matches, the
|
|
rlm@10
|
5107 result-expr is returned, if a ternary clause matches, its result-fn,
|
|
rlm@10
|
5108 which must be a unary function, is called with the result of the
|
|
rlm@10
|
5109 predicate as its argument, the result of that call being the return
|
|
rlm@10
|
5110 value of condp. A single default expression can follow the clauses,
|
|
rlm@10
|
5111 and its value will be returned if no clause matches. If no default
|
|
rlm@10
|
5112 expression is provided and no clause matches, an
|
|
rlm@10
|
5113 IllegalArgumentException is thrown."
|
|
rlm@10
|
5114 {:added "1.0"}
|
|
rlm@10
|
5115
|
|
rlm@10
|
5116 [pred expr & clauses]
|
|
rlm@10
|
5117 (let [gpred (gensym "pred__")
|
|
rlm@10
|
5118 gexpr (gensym "expr__")
|
|
rlm@10
|
5119 emit (fn emit [pred expr args]
|
|
rlm@10
|
5120 (let [[[a b c :as clause] more]
|
|
rlm@10
|
5121 (split-at (if (= :>> (second args)) 3 2) args)
|
|
rlm@10
|
5122 n (count clause)]
|
|
rlm@10
|
5123 (cond
|
|
rlm@10
|
5124 (= 0 n) `(throw (IllegalArgumentException. (str "No matching clause: " ~expr)))
|
|
rlm@10
|
5125 (= 1 n) a
|
|
rlm@10
|
5126 (= 2 n) `(if (~pred ~a ~expr)
|
|
rlm@10
|
5127 ~b
|
|
rlm@10
|
5128 ~(emit pred expr more))
|
|
rlm@10
|
5129 :else `(if-let [p# (~pred ~a ~expr)]
|
|
rlm@10
|
5130 (~c p#)
|
|
rlm@10
|
5131 ~(emit pred expr more)))))
|
|
rlm@10
|
5132 gres (gensym "res__")]
|
|
rlm@10
|
5133 `(let [~gpred ~pred
|
|
rlm@10
|
5134 ~gexpr ~expr]
|
|
rlm@10
|
5135 ~(emit gpred gexpr clauses))))
|
|
rlm@10
|
5136
|
|
rlm@10
|
5137 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; var documentation ;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
5138
|
|
rlm@10
|
5139 (alter-meta! #'*agent* assoc :added "1.0")
|
|
rlm@10
|
5140 (alter-meta! #'in-ns assoc :added "1.0")
|
|
rlm@10
|
5141 (alter-meta! #'load-file assoc :added "1.0")
|
|
rlm@10
|
5142
|
|
rlm@10
|
5143 (defmacro add-doc-and-meta {:private true} [name docstring meta]
|
|
rlm@10
|
5144 `(alter-meta! (var ~name) merge (assoc ~meta :doc ~docstring)))
|
|
rlm@10
|
5145
|
|
rlm@10
|
5146 (add-doc-and-meta *file*
|
|
rlm@10
|
5147 "The path of the file being evaluated, as a String.
|
|
rlm@10
|
5148
|
|
rlm@10
|
5149 Evaluates to nil when there is no file, eg. in the REPL."
|
|
rlm@10
|
5150 {:added "1.0"})
|
|
rlm@10
|
5151
|
|
rlm@10
|
5152 (add-doc-and-meta *command-line-args*
|
|
rlm@10
|
5153 "A sequence of the supplied command line arguments, or nil if
|
|
rlm@10
|
5154 none were supplied"
|
|
rlm@10
|
5155 {:added "1.0"})
|
|
rlm@10
|
5156
|
|
rlm@10
|
5157 (add-doc-and-meta *warn-on-reflection*
|
|
rlm@10
|
5158 "When set to true, the compiler will emit warnings when reflection is
|
|
rlm@10
|
5159 needed to resolve Java method calls or field accesses.
|
|
rlm@10
|
5160
|
|
rlm@10
|
5161 Defaults to false."
|
|
rlm@10
|
5162 {:added "1.0"})
|
|
rlm@10
|
5163
|
|
rlm@10
|
5164 (add-doc-and-meta *compile-path*
|
|
rlm@10
|
5165 "Specifies the directory where 'compile' will write out .class
|
|
rlm@10
|
5166 files. This directory must be in the classpath for 'compile' to
|
|
rlm@10
|
5167 work.
|
|
rlm@10
|
5168
|
|
rlm@10
|
5169 Defaults to \"classes\""
|
|
rlm@10
|
5170 {:added "1.0"})
|
|
rlm@10
|
5171
|
|
rlm@10
|
5172 (add-doc-and-meta *compile-files*
|
|
rlm@10
|
5173 "Set to true when compiling files, false otherwise."
|
|
rlm@10
|
5174 {:added "1.0"})
|
|
rlm@10
|
5175
|
|
rlm@10
|
5176 (add-doc-and-meta *ns*
|
|
rlm@10
|
5177 "A clojure.lang.Namespace object representing the current namespace."
|
|
rlm@10
|
5178 {:added "1.0"})
|
|
rlm@10
|
5179
|
|
rlm@10
|
5180 (add-doc-and-meta *in*
|
|
rlm@10
|
5181 "A java.io.Reader object representing standard input for read operations.
|
|
rlm@10
|
5182
|
|
rlm@10
|
5183 Defaults to System/in, wrapped in a LineNumberingPushbackReader"
|
|
rlm@10
|
5184 {:added "1.0"})
|
|
rlm@10
|
5185
|
|
rlm@10
|
5186 (add-doc-and-meta *out*
|
|
rlm@10
|
5187 "A java.io.Writer object representing standard output for print operations.
|
|
rlm@10
|
5188
|
|
rlm@10
|
5189 Defaults to System/out"
|
|
rlm@10
|
5190 {:added "1.0"})
|
|
rlm@10
|
5191
|
|
rlm@10
|
5192 (add-doc-and-meta *err*
|
|
rlm@10
|
5193 "A java.io.Writer object representing standard error for print operations.
|
|
rlm@10
|
5194
|
|
rlm@10
|
5195 Defaults to System/err, wrapped in a PrintWriter"
|
|
rlm@10
|
5196 {:added "1.0"})
|
|
rlm@10
|
5197
|
|
rlm@10
|
5198 (add-doc-and-meta *flush-on-newline*
|
|
rlm@10
|
5199 "When set to true, output will be flushed whenever a newline is printed.
|
|
rlm@10
|
5200
|
|
rlm@10
|
5201 Defaults to true."
|
|
rlm@10
|
5202 {:added "1.0"})
|
|
rlm@10
|
5203
|
|
rlm@10
|
5204 (add-doc-and-meta *print-meta*
|
|
rlm@10
|
5205 "If set to logical true, when printing an object, its metadata will also
|
|
rlm@10
|
5206 be printed in a form that can be read back by the reader.
|
|
rlm@10
|
5207
|
|
rlm@10
|
5208 Defaults to false."
|
|
rlm@10
|
5209 {:added "1.0"})
|
|
rlm@10
|
5210
|
|
rlm@10
|
5211 (add-doc-and-meta *print-dup*
|
|
rlm@10
|
5212 "When set to logical true, objects will be printed in a way that preserves
|
|
rlm@10
|
5213 their type when read in later.
|
|
rlm@10
|
5214
|
|
rlm@10
|
5215 Defaults to false."
|
|
rlm@10
|
5216 {:added "1.0"})
|
|
rlm@10
|
5217
|
|
rlm@10
|
5218 (add-doc-and-meta *print-readably*
|
|
rlm@10
|
5219 "When set to logical false, strings and characters will be printed with
|
|
rlm@10
|
5220 non-alphanumeric characters converted to the appropriate escape sequences.
|
|
rlm@10
|
5221
|
|
rlm@10
|
5222 Defaults to true"
|
|
rlm@10
|
5223 {:added "1.0"})
|
|
rlm@10
|
5224
|
|
rlm@10
|
5225 (add-doc-and-meta *read-eval*
|
|
rlm@10
|
5226 "When set to logical false, the EvalReader (#=(...)) is disabled in the
|
|
rlm@10
|
5227 read/load in the thread-local binding.
|
|
rlm@10
|
5228 Example: (binding [*read-eval* false] (read-string \"#=(eval (def x 3))\"))
|
|
rlm@10
|
5229
|
|
rlm@10
|
5230 Defaults to true"
|
|
rlm@10
|
5231 {:added "1.0"})
|
|
rlm@10
|
5232
|
|
rlm@10
|
5233 (defn future?
|
|
rlm@10
|
5234 "Returns true if x is a future"
|
|
rlm@10
|
5235 {:added "1.1"}
|
|
rlm@10
|
5236 [x] (instance? java.util.concurrent.Future x))
|
|
rlm@10
|
5237
|
|
rlm@10
|
5238 (defn future-done?
|
|
rlm@10
|
5239 "Returns true if future f is done"
|
|
rlm@10
|
5240 {:added "1.1"}
|
|
rlm@10
|
5241 [^java.util.concurrent.Future f] (.isDone f))
|
|
rlm@10
|
5242
|
|
rlm@10
|
5243
|
|
rlm@10
|
5244 (defmacro letfn
|
|
rlm@10
|
5245 "Takes a vector of function specs and a body, and generates a set of
|
|
rlm@10
|
5246 bindings of functions to their names. All of the names are available
|
|
rlm@10
|
5247 in all of the definitions of the functions, as well as the body.
|
|
rlm@10
|
5248
|
|
rlm@10
|
5249 fnspec ==> (fname [params*] exprs) or (fname ([params*] exprs)+)"
|
|
rlm@10
|
5250 {:added "1.0"}
|
|
rlm@10
|
5251 [fnspecs & body]
|
|
rlm@10
|
5252 `(letfn* ~(vec (interleave (map first fnspecs)
|
|
rlm@10
|
5253 (map #(cons `fn %) fnspecs)))
|
|
rlm@10
|
5254 ~@body))
|
|
rlm@10
|
5255
|
|
rlm@10
|
5256
|
|
rlm@10
|
5257 ;;;;;;; case ;;;;;;;;;;;;;
|
|
rlm@10
|
5258 (defn- shift-mask [shift mask x]
|
|
rlm@10
|
5259 (-> x (bit-shift-right shift) (bit-and mask)))
|
|
rlm@10
|
5260
|
|
rlm@10
|
5261 (defn- min-hash
|
|
rlm@10
|
5262 "takes a collection of keys and returns [shift mask]"
|
|
rlm@10
|
5263 [keys]
|
|
rlm@10
|
5264 (let [hashes (map hash keys)
|
|
rlm@10
|
5265 cnt (count keys)]
|
|
rlm@10
|
5266 (when-not (apply distinct? hashes)
|
|
rlm@10
|
5267 (throw (IllegalArgumentException. "Hashes must be distinct")))
|
|
rlm@10
|
5268 (or (first
|
|
rlm@10
|
5269 (filter (fn [[s m]]
|
|
rlm@10
|
5270 (apply distinct? (map #(shift-mask s m %) hashes)))
|
|
rlm@10
|
5271 (for [mask (map #(dec (bit-shift-left 1 %)) (range 1 14))
|
|
rlm@10
|
5272 shift (range 0 31)]
|
|
rlm@10
|
5273 [shift mask])))
|
|
rlm@10
|
5274 (throw (IllegalArgumentException. "No distinct mapping found")))))
|
|
rlm@10
|
5275
|
|
rlm@10
|
5276 (defmacro case
|
|
rlm@10
|
5277 "Takes an expression, and a set of clauses.
|
|
rlm@10
|
5278
|
|
rlm@10
|
5279 Each clause can take the form of either:
|
|
rlm@10
|
5280
|
|
rlm@10
|
5281 test-constant result-expr
|
|
rlm@10
|
5282
|
|
rlm@10
|
5283 (test-constant1 ... test-constantN) result-expr
|
|
rlm@10
|
5284
|
|
rlm@10
|
5285 The test-constants are not evaluated. They must be compile-time
|
|
rlm@10
|
5286 literals, and need not be quoted. If the expression is equal to a
|
|
rlm@10
|
5287 test-constant, the corresponding result-expr is returned. A single
|
|
rlm@10
|
5288 default expression can follow the clauses, and its value will be
|
|
rlm@10
|
5289 returned if no clause matches. If no default expression is provided
|
|
rlm@10
|
5290 and no clause matches, an IllegalArgumentException is thrown.
|
|
rlm@10
|
5291
|
|
rlm@10
|
5292 Unlike cond and condp, case does a constant-time dispatch, the
|
|
rlm@10
|
5293 clauses are not considered sequentially. All manner of constant
|
|
rlm@10
|
5294 expressions are acceptable in case, including numbers, strings,
|
|
rlm@10
|
5295 symbols, keywords, and (Clojure) composites thereof. Note that since
|
|
rlm@10
|
5296 lists are used to group multiple constants that map to the same
|
|
rlm@10
|
5297 expression, a vector can be used to match a list if needed. The
|
|
rlm@10
|
5298 test-constants need not be all of the same type."
|
|
rlm@10
|
5299 {:added "1.2"}
|
|
rlm@10
|
5300
|
|
rlm@10
|
5301 [e & clauses]
|
|
rlm@10
|
5302 (let [ge (with-meta (gensym) {:tag Object})
|
|
rlm@10
|
5303 default (if (odd? (count clauses))
|
|
rlm@10
|
5304 (last clauses)
|
|
rlm@10
|
5305 `(throw (IllegalArgumentException. (str "No matching clause: " ~ge))))
|
|
rlm@10
|
5306 cases (partition 2 clauses)
|
|
rlm@10
|
5307 case-map (reduce (fn [m [test expr]]
|
|
rlm@10
|
5308 (if (seq? test)
|
|
rlm@10
|
5309 (into m (zipmap test (repeat expr)))
|
|
rlm@10
|
5310 (assoc m test expr)))
|
|
rlm@10
|
5311 {} cases)
|
|
rlm@10
|
5312 [shift mask] (if (seq case-map) (min-hash (keys case-map)) [0 0])
|
|
rlm@10
|
5313
|
|
rlm@10
|
5314 hmap (reduce (fn [m [test expr :as te]]
|
|
rlm@10
|
5315 (assoc m (shift-mask shift mask (hash test)) te))
|
|
rlm@10
|
5316 (sorted-map) case-map)]
|
|
rlm@10
|
5317 `(let [~ge ~e]
|
|
rlm@10
|
5318 ~(condp = (count clauses)
|
|
rlm@10
|
5319 0 default
|
|
rlm@10
|
5320 1 default
|
|
rlm@10
|
5321 `(case* ~ge ~shift ~mask ~(key (first hmap)) ~(key (last hmap)) ~default ~hmap
|
|
rlm@10
|
5322 ~(every? keyword? (keys case-map)))))))
|
|
rlm@10
|
5323
|
|
rlm@10
|
5324 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; helper files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
5325 (alter-meta! (find-ns 'clojure.core) assoc :doc "Fundamental library of the Clojure language")
|
|
rlm@10
|
5326 (load "core_proxy")
|
|
rlm@10
|
5327 (load "core_print")
|
|
rlm@10
|
5328 (load "genclass")
|
|
rlm@10
|
5329 (load "core_deftype")
|
|
rlm@10
|
5330 (load "core/protocols")
|
|
rlm@10
|
5331 (load "gvec")
|
|
rlm@10
|
5332
|
|
rlm@10
|
5333 ;; redefine reduce with internal-reduce
|
|
rlm@10
|
5334 #_(defn reduce
|
|
rlm@10
|
5335 "f should be a function of 2 arguments. If val is not supplied,
|
|
rlm@10
|
5336 returns the result of applying f to the first 2 items in coll, then
|
|
rlm@10
|
5337 applying f to that result and the 3rd item, etc. If coll contains no
|
|
rlm@10
|
5338 items, f must accept no arguments as well, and reduce returns the
|
|
rlm@10
|
5339 result of calling f with no arguments. If coll has only 1 item, it
|
|
rlm@10
|
5340 is returned and f is not called. If val is supplied, returns the
|
|
rlm@10
|
5341 result of applying f to val and the first item in coll, then
|
|
rlm@10
|
5342 applying f to that result and the 2nd item, etc. If coll contains no
|
|
rlm@10
|
5343 items, returns val and f is not called."
|
|
rlm@10
|
5344 {:added "1.0"}
|
|
rlm@10
|
5345 ([f coll]
|
|
rlm@10
|
5346 (if-let [s (seq coll)]
|
|
rlm@10
|
5347 (reduce f (first s) (next s))
|
|
rlm@10
|
5348 (f)))
|
|
rlm@10
|
5349 ([f val coll]
|
|
rlm@10
|
5350 (let [s (seq coll)]
|
|
rlm@10
|
5351 (clojure.core.protocols/internal-reduce s f val))))
|
|
rlm@10
|
5352
|
|
rlm@10
|
5353 (require '[clojure.java.io :as jio])
|
|
rlm@10
|
5354
|
|
rlm@10
|
5355 (defn- normalize-slurp-opts
|
|
rlm@10
|
5356 [opts]
|
|
rlm@10
|
5357 (if (string? (first opts))
|
|
rlm@10
|
5358 (do
|
|
rlm@10
|
5359 (println "WARNING: (slurp f enc) is deprecated, use (slurp f :encoding enc).")
|
|
rlm@10
|
5360 [:encoding (first opts)])
|
|
rlm@10
|
5361 opts))
|
|
rlm@10
|
5362
|
|
rlm@10
|
5363 (defn slurp
|
|
rlm@10
|
5364 "Reads the file named by f using the encoding enc into a string
|
|
rlm@10
|
5365 and returns it."
|
|
rlm@10
|
5366 {:added "1.0"}
|
|
rlm@10
|
5367 ([f & opts]
|
|
rlm@10
|
5368 (let [opts (normalize-slurp-opts opts)
|
|
rlm@10
|
5369 sb (StringBuilder.)]
|
|
rlm@10
|
5370 (with-open [#^java.io.Reader r (apply jio/reader f opts)]
|
|
rlm@10
|
5371 (loop [c (.read r)]
|
|
rlm@10
|
5372 (if (neg? c)
|
|
rlm@10
|
5373 (str sb)
|
|
rlm@10
|
5374 (do
|
|
rlm@10
|
5375 (.append sb (char c))
|
|
rlm@10
|
5376 (recur (.read r)))))))))
|
|
rlm@10
|
5377
|
|
rlm@10
|
5378 (defn spit
|
|
rlm@10
|
5379 "Opposite of slurp. Opens f with writer, writes content, then
|
|
rlm@10
|
5380 closes f. Options passed to clojure.java.io/writer."
|
|
rlm@10
|
5381 {:added "1.2"}
|
|
rlm@10
|
5382 [f content & options]
|
|
rlm@10
|
5383 (with-open [#^java.io.Writer w (apply jio/writer f options)]
|
|
rlm@10
|
5384 (.write w (str content))))
|
|
rlm@10
|
5385
|
|
rlm@10
|
5386 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; futures (needs proxy);;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
5387 (defn future-call
|
|
rlm@10
|
5388 "Takes a function of no args and yields a future object that will
|
|
rlm@10
|
5389 invoke the function in another thread, and will cache the result and
|
|
rlm@10
|
5390 return it on all subsequent calls to deref/@. If the computation has
|
|
rlm@10
|
5391 not yet finished, calls to deref/@ will block."
|
|
rlm@10
|
5392 {:added "1.1"}
|
|
rlm@10
|
5393 [^Callable f]
|
|
rlm@10
|
5394 (let [fut (.submit clojure.lang.Agent/soloExecutor f)]
|
|
rlm@10
|
5395 (reify
|
|
rlm@10
|
5396 clojure.lang.IDeref
|
|
rlm@10
|
5397 (deref [_] (.get fut))
|
|
rlm@10
|
5398 java.util.concurrent.Future
|
|
rlm@10
|
5399 (get [_] (.get fut))
|
|
rlm@10
|
5400 (get [_ timeout unit] (.get fut timeout unit))
|
|
rlm@10
|
5401 (isCancelled [_] (.isCancelled fut))
|
|
rlm@10
|
5402 (isDone [_] (.isDone fut))
|
|
rlm@10
|
5403 (cancel [_ interrupt?] (.cancel fut interrupt?)))))
|
|
rlm@10
|
5404
|
|
rlm@10
|
5405 (defmacro future
|
|
rlm@10
|
5406 "Takes a body of expressions and yields a future object that will
|
|
rlm@10
|
5407 invoke the body in another thread, and will cache the result and
|
|
rlm@10
|
5408 return it on all subsequent calls to deref/@. If the computation has
|
|
rlm@10
|
5409 not yet finished, calls to deref/@ will block."
|
|
rlm@10
|
5410 {:added "1.1"}
|
|
rlm@10
|
5411 [& body] `(future-call (^{:once true} fn* [] ~@body)))
|
|
rlm@10
|
5412
|
|
rlm@10
|
5413
|
|
rlm@10
|
5414 (defn future-cancel
|
|
rlm@10
|
5415 "Cancels the future, if possible."
|
|
rlm@10
|
5416 {:added "1.1"}
|
|
rlm@10
|
5417 [^java.util.concurrent.Future f] (.cancel f true))
|
|
rlm@10
|
5418
|
|
rlm@10
|
5419 (defn future-cancelled?
|
|
rlm@10
|
5420 "Returns true if future f is cancelled"
|
|
rlm@10
|
5421 {:added "1.1"}
|
|
rlm@10
|
5422 [^java.util.concurrent.Future f] (.isCancelled f))
|
|
rlm@10
|
5423
|
|
rlm@10
|
5424 (defn pmap
|
|
rlm@10
|
5425 "Like map, except f is applied in parallel. Semi-lazy in that the
|
|
rlm@10
|
5426 parallel computation stays ahead of the consumption, but doesn't
|
|
rlm@10
|
5427 realize the entire result unless required. Only useful for
|
|
rlm@10
|
5428 computationally intensive functions where the time of f dominates
|
|
rlm@10
|
5429 the coordination overhead."
|
|
rlm@10
|
5430 {:added "1.0"}
|
|
rlm@10
|
5431 ([f coll]
|
|
rlm@10
|
5432 (let [n (+ 2 (.. Runtime getRuntime availableProcessors))
|
|
rlm@10
|
5433 rets (map #(future (f %)) coll)
|
|
rlm@10
|
5434 step (fn step [[x & xs :as vs] fs]
|
|
rlm@10
|
5435 (lazy-seq
|
|
rlm@10
|
5436 (if-let [s (seq fs)]
|
|
rlm@10
|
5437 (cons (deref x) (step xs (rest s)))
|
|
rlm@10
|
5438 (map deref vs))))]
|
|
rlm@10
|
5439 (step rets (drop n rets))))
|
|
rlm@10
|
5440 ([f coll & colls]
|
|
rlm@10
|
5441 (let [step (fn step [cs]
|
|
rlm@10
|
5442 (lazy-seq
|
|
rlm@10
|
5443 (let [ss (map seq cs)]
|
|
rlm@10
|
5444 (when (every? identity ss)
|
|
rlm@10
|
5445 (cons (map first ss) (step (map rest ss)))))))]
|
|
rlm@10
|
5446 (pmap #(apply f %) (step (cons coll colls))))))
|
|
rlm@10
|
5447
|
|
rlm@10
|
5448 (defn pcalls
|
|
rlm@10
|
5449 "Executes the no-arg fns in parallel, returning a lazy sequence of
|
|
rlm@10
|
5450 their values"
|
|
rlm@10
|
5451 {:added "1.0"}
|
|
rlm@10
|
5452 [& fns] (pmap #(%) fns))
|
|
rlm@10
|
5453
|
|
rlm@10
|
5454 (defmacro pvalues
|
|
rlm@10
|
5455 "Returns a lazy sequence of the values of the exprs, which are
|
|
rlm@10
|
5456 evaluated in parallel"
|
|
rlm@10
|
5457 {:added "1.0"}
|
|
rlm@10
|
5458 [& exprs]
|
|
rlm@10
|
5459 `(pcalls ~@(map #(list `fn [] %) exprs)))
|
|
rlm@10
|
5460
|
|
rlm@10
|
5461
|
|
rlm@10
|
5462 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; clojure version number ;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
5463
|
|
rlm@10
|
5464 (let [version-stream (.getResourceAsStream (clojure.lang.RT/baseLoader)
|
|
rlm@10
|
5465 "clojure/version.properties")
|
|
rlm@10
|
5466 properties (doto (new java.util.Properties) (.load version-stream))
|
|
rlm@10
|
5467 prop (fn [k] (.getProperty properties (str "clojure.version." k)))
|
|
rlm@10
|
5468 clojure-version {:major (Integer/valueOf ^String (prop "major"))
|
|
rlm@10
|
5469 :minor (Integer/valueOf ^String (prop "minor"))
|
|
rlm@10
|
5470 :incremental (Integer/valueOf ^String (prop "incremental"))
|
|
rlm@10
|
5471 :qualifier (prop "qualifier")}]
|
|
rlm@10
|
5472 (def *clojure-version*
|
|
rlm@10
|
5473 (if (not (= (prop "interim") "false"))
|
|
rlm@10
|
5474 (clojure.lang.RT/assoc clojure-version :interim true)
|
|
rlm@10
|
5475 clojure-version)))
|
|
rlm@10
|
5476
|
|
rlm@10
|
5477 (add-doc-and-meta *clojure-version*
|
|
rlm@10
|
5478 "The version info for Clojure core, as a map containing :major :minor
|
|
rlm@10
|
5479 :incremental and :qualifier keys. Feature releases may increment
|
|
rlm@10
|
5480 :minor and/or :major, bugfix releases will increment :incremental.
|
|
rlm@10
|
5481 Possible values of :qualifier include \"GA\", \"SNAPSHOT\", \"RC-x\" \"BETA-x\""
|
|
rlm@10
|
5482 {:added "1.0"})
|
|
rlm@10
|
5483
|
|
rlm@10
|
5484 (defn
|
|
rlm@10
|
5485 clojure-version
|
|
rlm@10
|
5486 "Returns clojure version as a printable string."
|
|
rlm@10
|
5487 {:added "1.0"}
|
|
rlm@10
|
5488 []
|
|
rlm@10
|
5489 (str (:major *clojure-version*)
|
|
rlm@10
|
5490 "."
|
|
rlm@10
|
5491 (:minor *clojure-version*)
|
|
rlm@10
|
5492 (when-let [i (:incremental *clojure-version*)]
|
|
rlm@10
|
5493 (str "." i))
|
|
rlm@10
|
5494 (when-let [q (:qualifier *clojure-version*)]
|
|
rlm@10
|
5495 (when (pos? (count q)) (str "-" q)))
|
|
rlm@10
|
5496 (when (:interim *clojure-version*)
|
|
rlm@10
|
5497 "-SNAPSHOT")))
|
|
rlm@10
|
5498
|
|
rlm@10
|
5499 (defn promise
|
|
rlm@10
|
5500 "Alpha - subject to change.
|
|
rlm@10
|
5501 Returns a promise object that can be read with deref/@, and set,
|
|
rlm@10
|
5502 once only, with deliver. Calls to deref/@ prior to delivery will
|
|
rlm@10
|
5503 block. All subsequent derefs will return the same delivered value
|
|
rlm@10
|
5504 without blocking."
|
|
rlm@10
|
5505 {:added "1.1"}
|
|
rlm@10
|
5506 []
|
|
rlm@10
|
5507 (let [d (java.util.concurrent.CountDownLatch. 1)
|
|
rlm@10
|
5508 v (atom nil)]
|
|
rlm@10
|
5509 (reify
|
|
rlm@10
|
5510 clojure.lang.IDeref
|
|
rlm@10
|
5511 (deref [_] (.await d) @v)
|
|
rlm@10
|
5512 clojure.lang.IFn
|
|
rlm@10
|
5513 (invoke [this x]
|
|
rlm@10
|
5514 (locking d
|
|
rlm@10
|
5515 (if (pos? (.getCount d))
|
|
rlm@10
|
5516 (do (reset! v x)
|
|
rlm@10
|
5517 (.countDown d)
|
|
rlm@10
|
5518 this)
|
|
rlm@10
|
5519 (throw (IllegalStateException. "Multiple deliver calls to a promise"))))))))
|
|
rlm@10
|
5520
|
|
rlm@10
|
5521 (defn deliver
|
|
rlm@10
|
5522 "Alpha - subject to change.
|
|
rlm@10
|
5523 Delivers the supplied value to the promise, releasing any pending
|
|
rlm@10
|
5524 derefs. A subsequent call to deliver on a promise will throw an exception."
|
|
rlm@10
|
5525 {:added "1.1"}
|
|
rlm@10
|
5526 [promise val] (promise val))
|
|
rlm@10
|
5527
|
|
rlm@10
|
5528
|
|
rlm@10
|
5529
|
|
rlm@10
|
5530 (defn flatten
|
|
rlm@10
|
5531 "Takes any nested combination of sequential things (lists, vectors,
|
|
rlm@10
|
5532 etc.) and returns their contents as a single, flat sequence.
|
|
rlm@10
|
5533 (flatten nil) returns nil."
|
|
rlm@10
|
5534 {:added "1.2"}
|
|
rlm@10
|
5535 [x]
|
|
rlm@10
|
5536 (filter (complement sequential?)
|
|
rlm@10
|
5537 (rest (tree-seq sequential? seq x))))
|
|
rlm@10
|
5538
|
|
rlm@10
|
5539 (defn group-by
|
|
rlm@10
|
5540 "Returns a map of the elements of coll keyed by the result of
|
|
rlm@10
|
5541 f on each element. The value at each key will be a vector of the
|
|
rlm@10
|
5542 corresponding elements, in the order they appeared in coll."
|
|
rlm@10
|
5543 {:added "1.2"}
|
|
rlm@10
|
5544 [f coll]
|
|
rlm@10
|
5545 (persistent!
|
|
rlm@10
|
5546 (reduce
|
|
rlm@10
|
5547 (fn [ret x]
|
|
rlm@10
|
5548 (let [k (f x)]
|
|
rlm@10
|
5549 (assoc! ret k (conj (get ret k []) x))))
|
|
rlm@10
|
5550 (transient {}) coll)))
|
|
rlm@10
|
5551
|
|
rlm@10
|
5552 (defn partition-by
|
|
rlm@10
|
5553 "Applies f to each value in coll, splitting it each time f returns
|
|
rlm@10
|
5554 a new value. Returns a lazy seq of partitions."
|
|
rlm@10
|
5555 {:added "1.2"}
|
|
rlm@10
|
5556 [f coll]
|
|
rlm@10
|
5557 (lazy-seq
|
|
rlm@10
|
5558 (when-let [s (seq coll)]
|
|
rlm@10
|
5559 (let [fst (first s)
|
|
rlm@10
|
5560 fv (f fst)
|
|
rlm@10
|
5561 run (cons fst (take-while #(= fv (f %)) (rest s)))]
|
|
rlm@10
|
5562 (cons run (partition-by f (drop (count run) s)))))))
|
|
rlm@10
|
5563
|
|
rlm@10
|
5564 (defn frequencies
|
|
rlm@10
|
5565 "Returns a map from distinct items in coll to the number of times
|
|
rlm@10
|
5566 they appear."
|
|
rlm@10
|
5567 {:added "1.2"}
|
|
rlm@10
|
5568 [coll]
|
|
rlm@10
|
5569 (persistent!
|
|
rlm@10
|
5570 (reduce (fn [counts x]
|
|
rlm@10
|
5571 (assoc! counts x (inc (get counts x 0))))
|
|
rlm@10
|
5572 (transient {}) coll)))
|
|
rlm@10
|
5573
|
|
rlm@10
|
5574 (defn reductions
|
|
rlm@10
|
5575 "Returns a lazy seq of the intermediate values of the reduction (as
|
|
rlm@10
|
5576 per reduce) of coll by f, starting with init."
|
|
rlm@10
|
5577 {:added "1.2"}
|
|
rlm@10
|
5578 ([f coll]
|
|
rlm@10
|
5579 (lazy-seq
|
|
rlm@10
|
5580 (if-let [s (seq coll)]
|
|
rlm@10
|
5581 (reductions f (first s) (rest s))
|
|
rlm@10
|
5582 (list (f)))))
|
|
rlm@10
|
5583 ([f init coll]
|
|
rlm@10
|
5584 (cons init
|
|
rlm@10
|
5585 (lazy-seq
|
|
rlm@10
|
5586 (when-let [s (seq coll)]
|
|
rlm@10
|
5587 (reductions f (f init (first s)) (rest s)))))))
|
|
rlm@10
|
5588
|
|
rlm@10
|
5589 (defn rand-nth
|
|
rlm@10
|
5590 "Return a random element of the (sequential) collection. Will have
|
|
rlm@10
|
5591 the same performance characteristics as nth for the given
|
|
rlm@10
|
5592 collection."
|
|
rlm@10
|
5593 {:added "1.2"}
|
|
rlm@10
|
5594 [coll]
|
|
rlm@10
|
5595 (nth coll (rand-int (count coll))))
|
|
rlm@10
|
5596
|
|
rlm@10
|
5597 (defn partition-all
|
|
rlm@10
|
5598 "Returns a lazy sequence of lists like partition, but may include
|
|
rlm@10
|
5599 partitions with fewer than n items at the end."
|
|
rlm@10
|
5600 {:added "1.2"}
|
|
rlm@10
|
5601 ([n coll]
|
|
rlm@10
|
5602 (partition-all n n coll))
|
|
rlm@10
|
5603 ([n step coll]
|
|
rlm@10
|
5604 (lazy-seq
|
|
rlm@10
|
5605 (when-let [s (seq coll)]
|
|
rlm@10
|
5606 (cons (take n s) (partition-all n step (drop step s)))))))
|
|
rlm@10
|
5607
|
|
rlm@10
|
5608 (defn shuffle
|
|
rlm@10
|
5609 "Return a random permutation of coll"
|
|
rlm@10
|
5610 {:added "1.2"}
|
|
rlm@10
|
5611 [coll]
|
|
rlm@10
|
5612 (let [al (java.util.ArrayList. coll)]
|
|
rlm@10
|
5613 (java.util.Collections/shuffle al)
|
|
rlm@10
|
5614 (clojure.lang.RT/vector (.toArray al))))
|
|
rlm@10
|
5615
|
|
rlm@10
|
5616 (defn map-indexed
|
|
rlm@10
|
5617 "Returns a lazy sequence consisting of the result of applying f to 0
|
|
rlm@10
|
5618 and the first item of coll, followed by applying f to 1 and the second
|
|
rlm@10
|
5619 item in coll, etc, until coll is exhausted. Thus function f should
|
|
rlm@10
|
5620 accept 2 arguments, index and item."
|
|
rlm@10
|
5621 {:added "1.2"}
|
|
rlm@10
|
5622 [f coll]
|
|
rlm@10
|
5623 (letfn [(mapi [idx coll]
|
|
rlm@10
|
5624 (lazy-seq
|
|
rlm@10
|
5625 (when-let [s (seq coll)]
|
|
rlm@10
|
5626 (if (chunked-seq? s)
|
|
rlm@10
|
5627 (let [c (chunk-first s)
|
|
rlm@10
|
5628 size (int (count c))
|
|
rlm@10
|
5629 b (chunk-buffer size)]
|
|
rlm@10
|
5630 (dotimes [i size]
|
|
rlm@10
|
5631 (chunk-append b (f (+ idx i) (.nth c i))))
|
|
rlm@10
|
5632 (chunk-cons (chunk b) (mapi (+ idx size) (chunk-rest s))))
|
|
rlm@10
|
5633 (cons (f idx (first s)) (mapi (inc idx) (rest s)))))))]
|
|
rlm@10
|
5634 (mapi 0 coll)))
|
|
rlm@10
|
5635
|
|
rlm@10
|
5636 (defn keep
|
|
rlm@10
|
5637 "Returns a lazy sequence of the non-nil results of (f item). Note,
|
|
rlm@10
|
5638 this means false return values will be included. f must be free of
|
|
rlm@10
|
5639 side-effects."
|
|
rlm@10
|
5640 {:added "1.2"}
|
|
rlm@10
|
5641 ([f coll]
|
|
rlm@10
|
5642 (lazy-seq
|
|
rlm@10
|
5643 (when-let [s (seq coll)]
|
|
rlm@10
|
5644 (if (chunked-seq? s)
|
|
rlm@10
|
5645 (let [c (chunk-first s)
|
|
rlm@10
|
5646 size (count c)
|
|
rlm@10
|
5647 b (chunk-buffer size)]
|
|
rlm@10
|
5648 (dotimes [i size]
|
|
rlm@10
|
5649 (let [x (f (.nth c i))]
|
|
rlm@10
|
5650 (when-not (nil? x)
|
|
rlm@10
|
5651 (chunk-append b x))))
|
|
rlm@10
|
5652 (chunk-cons (chunk b) (keep f (chunk-rest s))))
|
|
rlm@10
|
5653 (let [x (f (first s))]
|
|
rlm@10
|
5654 (if (nil? x)
|
|
rlm@10
|
5655 (keep f (rest s))
|
|
rlm@10
|
5656 (cons x (keep f (rest s))))))))))
|
|
rlm@10
|
5657
|
|
rlm@10
|
5658 (defn keep-indexed
|
|
rlm@10
|
5659 "Returns a lazy sequence of the non-nil results of (f index item). Note,
|
|
rlm@10
|
5660 this means false return values will be included. f must be free of
|
|
rlm@10
|
5661 side-effects."
|
|
rlm@10
|
5662 {:added "1.2"}
|
|
rlm@10
|
5663 ([f coll]
|
|
rlm@10
|
5664 (letfn [(keepi [idx coll]
|
|
rlm@10
|
5665 (lazy-seq
|
|
rlm@10
|
5666 (when-let [s (seq coll)]
|
|
rlm@10
|
5667 (if (chunked-seq? s)
|
|
rlm@10
|
5668 (let [c (chunk-first s)
|
|
rlm@10
|
5669 size (count c)
|
|
rlm@10
|
5670 b (chunk-buffer size)]
|
|
rlm@10
|
5671 (dotimes [i size]
|
|
rlm@10
|
5672 (let [x (f (+ idx i) (.nth c i))]
|
|
rlm@10
|
5673 (when-not (nil? x)
|
|
rlm@10
|
5674 (chunk-append b x))))
|
|
rlm@10
|
5675 (chunk-cons (chunk b) (keepi (+ idx size) (chunk-rest s))))
|
|
rlm@10
|
5676 (let [x (f idx (first s))]
|
|
rlm@10
|
5677 (if (nil? x)
|
|
rlm@10
|
5678 (keepi (inc idx) (rest s))
|
|
rlm@10
|
5679 (cons x (keepi (inc idx) (rest s)))))))))]
|
|
rlm@10
|
5680 (keepi 0 coll))))
|
|
rlm@10
|
5681
|
|
rlm@10
|
5682 (defn fnil
|
|
rlm@10
|
5683 "Takes a function f, and returns a function that calls f, replacing
|
|
rlm@10
|
5684 a nil first argument to f with the supplied value x. Higher arity
|
|
rlm@10
|
5685 versions can replace arguments in the second and third
|
|
rlm@10
|
5686 positions (y, z). Note that the function f can take any number of
|
|
rlm@10
|
5687 arguments, not just the one(s) being nil-patched."
|
|
rlm@10
|
5688 {:added "1.2"}
|
|
rlm@10
|
5689 ([f x]
|
|
rlm@10
|
5690 (fn
|
|
rlm@10
|
5691 ([a] (f (if (nil? a) x a)))
|
|
rlm@10
|
5692 ([a b] (f (if (nil? a) x a) b))
|
|
rlm@10
|
5693 ([a b c] (f (if (nil? a) x a) b c))
|
|
rlm@10
|
5694 ([a b c & ds] (apply f (if (nil? a) x a) b c ds))))
|
|
rlm@10
|
5695 ([f x y]
|
|
rlm@10
|
5696 (fn
|
|
rlm@10
|
5697 ([a b] (f (if (nil? a) x a) (if (nil? b) y b)))
|
|
rlm@10
|
5698 ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) c))
|
|
rlm@10
|
5699 ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) c ds))))
|
|
rlm@10
|
5700 ([f x y z]
|
|
rlm@10
|
5701 (fn
|
|
rlm@10
|
5702 ([a b] (f (if (nil? a) x a) (if (nil? b) y b)))
|
|
rlm@10
|
5703 ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c)))
|
|
rlm@10
|
5704 ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c) ds)))))
|
|
rlm@10
|
5705
|
|
rlm@10
|
5706 (defn- ^{:dynamic true} assert-valid-fdecl
|
|
rlm@10
|
5707 "A good fdecl looks like (([a] ...) ([a b] ...)) near the end of defn."
|
|
rlm@10
|
5708 [fdecl]
|
|
rlm@10
|
5709 (if-let [bad-args (seq (remove #(vector? %) (map first fdecl)))]
|
|
rlm@10
|
5710 (throw (IllegalArgumentException. (str "Parameter declaration " (first bad-args) " should be a vector")))))
|
