Mercurial > lasercutter
view src/clojure/core.clj @ 10:ef7dbbd6452c
added clojure source goodness
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 21 Aug 2010 06:25:44 -0400 |
parents | |
children |
line wrap: on
line source
1 ; Copyright (c) Rich Hickey. All rights reserved.2 ; The use and distribution terms for this software are covered by the3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)4 ; which can be found in the file epl-v10.html at the root of this distribution.5 ; By using this software in any fashion, you are agreeing to be bound by6 ; the terms of this license.7 ; You must not remove this notice, or any other, from this software.9 (ns clojure.core)11 (def unquote)12 (def unquote-splicing)14 (def15 ^{:arglists '([& items])16 :doc "Creates a new list containing the items."17 :added "1.0"}18 list (. clojure.lang.PersistentList creator))20 (def21 ^{:arglists '([x seq])22 :doc "Returns a new seq where x is the first element and seq is23 the rest."24 :added "1.0"}26 cons (fn* cons [x seq] (. clojure.lang.RT (cons x seq))))28 ;during bootstrap we don't have destructuring let, loop or fn, will redefine later29 (def30 ^{:macro true31 :added "1.0"}32 let (fn* let [&form &env & decl] (cons 'let* decl)))34 (def35 ^{:macro true36 :added "1.0"}37 loop (fn* loop [&form &env & decl] (cons 'loop* decl)))39 (def40 ^{:macro true41 :added "1.0"}42 fn (fn* fn [&form &env & decl]43 (.withMeta ^clojure.lang.IObj (cons 'fn* decl)44 (.meta ^clojure.lang.IMeta &form))))46 (def47 ^{:arglists '([coll])48 :doc "Returns the first item in the collection. Calls seq on its49 argument. If coll is nil, returns nil."50 :added "1.0"}51 first (fn first [coll] (. clojure.lang.RT (first coll))))53 (def54 ^{:arglists '([coll])55 :tag clojure.lang.ISeq56 :doc "Returns a seq of the items after the first. Calls seq on its57 argument. If there are no more items, returns nil."58 :added "1.0"}59 next (fn next [x] (. clojure.lang.RT (next x))))61 (def62 ^{:arglists '([coll])63 :tag clojure.lang.ISeq64 :doc "Returns a possibly empty seq of the items after the first. Calls seq on its65 argument."66 :added "1.0"}67 rest (fn rest [x] (. clojure.lang.RT (more x))))69 (def70 ^{:arglists '([coll x] [coll x & xs])71 :doc "conj[oin]. Returns a new collection with the xs72 'added'. (conj nil item) returns (item). The 'addition' may73 happen at different 'places' depending on the concrete type."74 :added "1.0"}75 conj (fn conj76 ([coll x] (. clojure.lang.RT (conj coll x)))77 ([coll x & xs]78 (if xs79 (recur (conj coll x) (first xs) (next xs))80 (conj coll x)))))82 (def83 ^{:doc "Same as (first (next x))"84 :arglists '([x])85 :added "1.0"}86 second (fn second [x] (first (next x))))88 (def89 ^{:doc "Same as (first (first x))"90 :arglists '([x])91 :added "1.0"}92 ffirst (fn ffirst [x] (first (first x))))94 (def95 ^{:doc "Same as (next (first x))"96 :arglists '([x])97 :added "1.0"}98 nfirst (fn nfirst [x] (next (first x))))100 (def101 ^{:doc "Same as (first (next x))"102 :arglists '([x])103 :added "1.0"}104 fnext (fn fnext [x] (first (next x))))106 (def107 ^{:doc "Same as (next (next x))"108 :arglists '([x])109 :added "1.0"}110 nnext (fn nnext [x] (next (next x))))112 (def113 ^{:arglists '([coll])114 :doc "Returns a seq on the collection. If the collection is115 empty, returns nil. (seq nil) returns nil. seq also works on116 Strings, native Java arrays (of reference types) and any objects117 that implement Iterable."118 :tag clojure.lang.ISeq119 :added "1.0"}120 seq (fn seq [coll] (. clojure.lang.RT (seq coll))))122 (def123 ^{:arglists '([^Class c x])124 :doc "Evaluates x and tests if it is an instance of the class125 c. Returns true or false"126 :added "1.0"}127 instance? (fn instance? [^Class c x] (. c (isInstance x))))129 (def130 ^{:arglists '([x])131 :doc "Return true if x implements ISeq"132 :added "1.0"}133 seq? (fn seq? [x] (instance? clojure.lang.ISeq x)))135 (def136 ^{:arglists '([x])137 :doc "Return true if x is a Character"138 :added "1.0"}139 char? (fn char? [x] (instance? Character x)))141 (def142 ^{:arglists '([x])143 :doc "Return true if x is a String"144 :added "1.0"}145 string? (fn string? [x] (instance? String x)))147 (def148 ^{:arglists '([x])149 :doc "Return true if x implements IPersistentMap"150 :added "1.0"}151 map? (fn map? [x] (instance? clojure.lang.IPersistentMap x)))153 (def154 ^{:arglists '([x])155 :doc "Return true if x implements IPersistentVector"156 :added "1.0"}157 vector? (fn vector? [x] (instance? clojure.lang.IPersistentVector x)))159 (def160 ^{:arglists '([map key val] [map key val & kvs])161 :doc "assoc[iate]. When applied to a map, returns a new map of the162 same (hashed/sorted) type, that contains the mapping of key(s) to163 val(s). When applied to a vector, returns a new vector that164 contains val at index. Note - index must be <= (count vector)."165 :added "1.0"}166 assoc167 (fn assoc168 ([map key val] (. clojure.lang.RT (assoc map key val)))169 ([map key val & kvs]170 (let [ret (assoc map key val)]171 (if kvs172 (recur ret (first kvs) (second kvs) (nnext kvs))173 ret)))))175 ;;;;;;;;;;;;;;;;; metadata ;;;;;;;;;;;;;;;;;;;;;;;;;;;176 (def177 ^{:arglists '([obj])178 :doc "Returns the metadata of obj, returns nil if there is no metadata."179 :added "1.0"}180 meta (fn meta [x]181 (if (instance? clojure.lang.IMeta x)182 (. ^clojure.lang.IMeta x (meta)))))184 (def185 ^{:arglists '([^clojure.lang.IObj obj m])186 :doc "Returns an object of the same type and value as obj, with187 map m as its metadata."188 :added "1.0"}189 with-meta (fn with-meta [^clojure.lang.IObj x m]190 (. x (withMeta m))))192 (def ^{:private true :dynamic true}193 assert-valid-fdecl (fn [fdecl]))195 (def196 ^{:private true}197 sigs198 (fn [fdecl]199 (assert-valid-fdecl fdecl)200 (let [asig201 (fn [fdecl]202 (let [arglist (first fdecl)203 ;elide implicit macro args204 arglist (if (clojure.lang.Util/equals '&form (first arglist))205 (clojure.lang.RT/subvec arglist 2 (clojure.lang.RT/count arglist))206 arglist)207 body (next fdecl)]208 (if (map? (first body))209 (if (next body)210 (with-meta arglist (conj (if (meta arglist) (meta arglist) {}) (first body)))211 arglist)212 arglist)))]213 (if (seq? (first fdecl))214 (loop [ret [] fdecls fdecl]215 (if fdecls216 (recur (conj ret (asig (first fdecls))) (next fdecls))217 (seq ret)))218 (list (asig fdecl))))))221 (def222 ^{:arglists '([coll])223 :doc "Return the last item in coll, in linear time"224 :added "1.0"}225 last (fn last [s]226 (if (next s)227 (recur (next s))228 (first s))))230 (def231 ^{:arglists '([coll])232 :doc "Return a seq of all but the last item in coll, in linear time"233 :added "1.0"}234 butlast (fn butlast [s]235 (loop [ret [] s s]236 (if (next s)237 (recur (conj ret (first s)) (next s))238 (seq ret)))))240 (def242 ^{:doc "Same as (def name (fn [params* ] exprs*)) or (def243 name (fn ([params* ] exprs*)+)) with any doc-string or attrs added244 to the var metadata"245 :arglists '([name doc-string? attr-map? [params*] body]246 [name doc-string? attr-map? ([params*] body)+ attr-map?])247 :added "1.0"}248 defn (fn defn [&form &env name & fdecl]249 (let [m (if (string? (first fdecl))250 {:doc (first fdecl)}251 {})252 fdecl (if (string? (first fdecl))253 (next fdecl)254 fdecl)255 m (if (map? (first fdecl))256 (conj m (first fdecl))257 m)258 fdecl (if (map? (first fdecl))259 (next fdecl)260 fdecl)261 fdecl (if (vector? (first fdecl))262 (list fdecl)263 fdecl)264 m (if (map? (last fdecl))265 (conj m (last fdecl))266 m)267 fdecl (if (map? (last fdecl))268 (butlast fdecl)269 fdecl)270 m (conj {:arglists (list 'quote (sigs fdecl))} m)271 m (let [inline (:inline m)272 ifn (first inline)273 iname (second inline)]274 ;; same as: (if (and (= 'fn ifn) (not (symbol? iname))) ...)275 (if (if (clojure.lang.Util/equiv 'fn ifn)276 (if (instance? clojure.lang.Symbol iname) false true))277 ;; inserts the same fn name to the inline fn if it does not have one278 (assoc m :inline (cons ifn (cons (clojure.lang.Symbol/intern (.concat (.getName name) "__inliner"))279 (next inline))))280 m))281 m (conj (if (meta name) (meta name) {}) m)]282 (list 'def (with-meta name m)283 (list '.withMeta (cons `fn (cons name fdecl)) (list '.meta (list 'var name)))))))285 (. (var defn) (setMacro))287 (defn cast288 "Throws a ClassCastException if x is not a c, else returns x."289 {:added "1.0"}290 [^Class c x]291 (. c (cast x)))293 (defn to-array294 "Returns an array of Objects containing the contents of coll, which295 can be any Collection. Maps to java.util.Collection.toArray()."296 {:tag "[Ljava.lang.Object;"297 :added "1.0"}298 [coll] (. clojure.lang.RT (toArray coll)))300 (defn vector301 "Creates a new vector containing the args."302 {:added "1.0"}303 ([] [])304 ([a] [a])305 ([a b] [a b])306 ([a b c] [a b c])307 ([a b c d] [a b c d])308 ([a b c d & args]309 (. clojure.lang.LazilyPersistentVector (create (cons a (cons b (cons c (cons d args))))))))311 (defn vec312 "Creates a new vector containing the contents of coll."313 {:added "1.0"}314 ([coll]315 (if (instance? java.util.Collection coll)316 (clojure.lang.LazilyPersistentVector/create coll)317 (. clojure.lang.LazilyPersistentVector (createOwning (to-array coll))))))319 (defn hash-map320 "keyval => key val321 Returns a new hash map with supplied mappings."322 {:added "1.0"}323 ([] {})324 ([& keyvals]325 (. clojure.lang.PersistentHashMap (createWithCheck keyvals))))327 (defn hash-set328 "Returns a new hash set with supplied keys."329 {:added "1.0"}330 ([] #{})331 ([& keys]332 (clojure.lang.PersistentHashSet/createWithCheck keys)))334 (defn sorted-map335 "keyval => key val336 Returns a new sorted map with supplied mappings."337 {:added "1.0"}338 ([& keyvals]339 (clojure.lang.PersistentTreeMap/create keyvals)))341 (defn sorted-map-by342 "keyval => key val343 Returns a new sorted map with supplied mappings, using the supplied comparator."344 {:added "1.0"}345 ([comparator & keyvals]346 (clojure.lang.PersistentTreeMap/create comparator keyvals)))348 (defn sorted-set349 "Returns a new sorted set with supplied keys."350 {:added "1.0"}351 ([& keys]352 (clojure.lang.PersistentTreeSet/create keys)))354 (defn sorted-set-by355 "Returns a new sorted set with supplied keys, using the supplied comparator."356 {:added "1.1"}357 ([comparator & keys]358 (clojure.lang.PersistentTreeSet/create comparator keys)))361 ;;;;;;;;;;;;;;;;;;;;362 (defn nil?363 "Returns true if x is nil, false otherwise."364 {:tag Boolean365 :added "1.0"}366 [x] (clojure.lang.Util/identical x nil))368 (def370 ^{:doc "Like defn, but the resulting function name is declared as a371 macro and will be used as a macro by the compiler when it is372 called."373 :arglists '([name doc-string? attr-map? [params*] body]374 [name doc-string? attr-map? ([params*] body)+ attr-map?])375 :added "1.0"}376 defmacro (fn [&form &env377 name & args]378 (let [prefix (loop [p (list name) args args]379 (let [f (first args)]380 (if (string? f)381 (recur (cons f p) (next args))382 (if (map? f)383 (recur (cons f p) (next args))384 p))))385 fdecl (loop [fd args]386 (if (string? (first fd))387 (recur (next fd))388 (if (map? (first fd))389 (recur (next fd))390 fd)))391 fdecl (if (vector? (first fdecl))392 (list fdecl)393 fdecl)394 add-implicit-args (fn [fd]395 (let [args (first fd)]396 (cons (vec (cons '&form (cons '&env args))) (next fd))))397 add-args (fn [acc ds]398 (if (nil? ds)399 acc400 (let [d (first ds)]401 (if (map? d)402 (conj acc d)403 (recur (conj acc (add-implicit-args d)) (next ds))))))404 fdecl (seq (add-args [] fdecl))405 decl (loop [p prefix d fdecl]406 (if p407 (recur (next p) (cons (first p) d))408 d))]409 (list 'do410 (cons `defn decl)411 (list '. (list 'var name) '(setMacro))412 (list 'var name)))))415 (. (var defmacro) (setMacro))417 (defmacro when418 "Evaluates test. If logical true, evaluates body in an implicit do."419 {:added "1.0"}420 [test & body]421 (list 'if test (cons 'do body)))423 (defmacro when-not424 "Evaluates test. If logical false, evaluates body in an implicit do."425 {:added "1.0"}426 [test & body]427 (list 'if test nil (cons 'do body)))429 (defn false?430 "Returns true if x is the value false, false otherwise."431 {:tag Boolean,432 :added "1.0"}433 [x] (clojure.lang.Util/identical x false))435 (defn true?436 "Returns true if x is the value true, false otherwise."437 {:tag Boolean,438 :added "1.0"}439 [x] (clojure.lang.Util/identical x true))441 (defn not442 "Returns true if x is logical false, false otherwise."443 {:tag Boolean444 :added "1.0"}445 [x] (if x false true))447 (defn str448 "With no args, returns the empty string. With one arg x, returns449 x.toString(). (str nil) returns the empty string. With more than450 one arg, returns the concatenation of the str values of the args."451 {:tag String452 :added "1.0"}453 ([] "")454 ([^Object x]455 (if (nil? x) "" (. x (toString))))456 ([x & ys]457 ((fn [^StringBuilder sb more]458 (if more459 (recur (. sb (append (str (first more)))) (next more))460 (str sb)))461 (new StringBuilder ^String (str x)) ys)))464 (defn symbol?465 "Return true if x is a Symbol"466 {:added "1.0"}467 [x] (instance? clojure.lang.Symbol x))469 (defn keyword?470 "Return true if x is a Keyword"471 {:added "1.0"}472 [x] (instance? clojure.lang.Keyword x))474 (defn symbol475 "Returns a Symbol with the given namespace and name."476 {:tag clojure.lang.Symbol477 :added "1.0"}478 ([name] (if (symbol? name) name (clojure.lang.Symbol/intern name)))479 ([ns name] (clojure.lang.Symbol/intern ns name)))481 (defn gensym482 "Returns a new symbol with a unique name. If a prefix string is483 supplied, the name is prefix# where # is some unique number. If484 prefix is not supplied, the prefix is 'G__'."485 {:added "1.0"}486 ([] (gensym "G__"))487 ([prefix-string] (. clojure.lang.Symbol (intern (str prefix-string (str (. clojure.lang.RT (nextID))))))))489 (defmacro cond490 "Takes a set of test/expr pairs. It evaluates each test one at a491 time. If a test returns logical true, cond evaluates and returns492 the value of the corresponding expr and doesn't evaluate any of the493 other tests or exprs. (cond) returns nil."494 {:added "1.0"}495 [& clauses]496 (when clauses497 (list 'if (first clauses)498 (if (next clauses)499 (second clauses)500 (throw (IllegalArgumentException.501 "cond requires an even number of forms")))502 (cons 'clojure.core/cond (next (next clauses))))))504 (defn keyword505 "Returns a Keyword with the given namespace and name. Do not use :506 in the keyword strings, it will be added automatically."507 {:tag clojure.lang.Keyword508 :added "1.0"}509 ([name] (cond (keyword? name) name510 (symbol? name) (clojure.lang.Keyword/intern ^clojure.lang.Symbol name)511 (string? name) (clojure.lang.Keyword/intern ^String name)))512 ([ns name] (clojure.lang.Keyword/intern ns name)))514 (defn spread515 {:private true}516 [arglist]517 (cond518 (nil? arglist) nil519 (nil? (next arglist)) (seq (first arglist))520 :else (cons (first arglist) (spread (next arglist)))))522 (defn list*523 "Creates a new list containing the items prepended to the rest, the524 last of which will be treated as a sequence."525 {:added "1.0"}526 ([args] (seq args))527 ([a args] (cons a args))528 ([a b args] (cons a (cons b args)))529 ([a b c args] (cons a (cons b (cons c args))))530 ([a b c d & more]531 (cons a (cons b (cons c (cons d (spread more)))))))533 (defn apply534 "Applies fn f to the argument list formed by prepending args to argseq."535 {:arglists '([f args* argseq])536 :added "1.0"}537 ([^clojure.lang.IFn f args]538 (. f (applyTo (seq args))))539 ([^clojure.lang.IFn f x args]540 (. f (applyTo (list* x args))))541 ([^clojure.lang.IFn f x y args]542 (. f (applyTo (list* x y args))))543 ([^clojure.lang.IFn f x y z args]544 (. f (applyTo (list* x y z args))))545 ([^clojure.lang.IFn f a b c d & args]546 (. f (applyTo (cons a (cons b (cons c (cons d (spread args)))))))))548 (defn vary-meta549 "Returns an object of the same type and value as obj, with550 (apply f (meta obj) args) as its metadata."551 {:added "1.0"}552 [obj f & args]553 (with-meta obj (apply f (meta obj) args)))555 (defmacro lazy-seq556 "Takes a body of expressions that returns an ISeq or nil, and yields557 a Seqable object that will invoke the body only the first time seq558 is called, and will cache the result and return it on all subsequent559 seq calls."560 {:added "1.0"}561 [& body]562 (list 'new 'clojure.lang.LazySeq (list* '^{:once true} fn* [] body)))564 (defn ^clojure.lang.ChunkBuffer chunk-buffer [capacity]565 (clojure.lang.ChunkBuffer. capacity))567 (defn chunk-append [^clojure.lang.ChunkBuffer b x]568 (.add b x))570 (defn chunk [^clojure.lang.ChunkBuffer b]571 (.chunk b))573 (defn ^clojure.lang.IChunk chunk-first [^clojure.lang.IChunkedSeq s]574 (.chunkedFirst s))576 (defn ^clojure.lang.ISeq chunk-rest [^clojure.lang.IChunkedSeq s]577 (.chunkedMore s))579 (defn ^clojure.lang.ISeq chunk-next [^clojure.lang.IChunkedSeq s]580 (.chunkedNext s))582 (defn chunk-cons [chunk rest]583 (if (clojure.lang.Numbers/isZero (clojure.lang.RT/count chunk))584 rest585 (clojure.lang.ChunkedCons. chunk rest)))587 (defn chunked-seq? [s]588 (instance? clojure.lang.IChunkedSeq s))590 (defn concat591 "Returns a lazy seq representing the concatenation of the elements in the supplied colls."592 {:added "1.0"}593 ([] (lazy-seq nil))594 ([x] (lazy-seq x))595 ([x y]596 (lazy-seq597 (let [s (seq x)]598 (if s599 (if (chunked-seq? s)600 (chunk-cons (chunk-first s) (concat (chunk-rest s) y))601 (cons (first s) (concat (rest s) y)))602 y))))603 ([x y & zs]604 (let [cat (fn cat [xys zs]605 (lazy-seq606 (let [xys (seq xys)]607 (if xys608 (if (chunked-seq? xys)609 (chunk-cons (chunk-first xys)610 (cat (chunk-rest xys) zs))611 (cons (first xys) (cat (rest xys) zs)))612 (when zs613 (cat (first zs) (next zs)))))))]614 (cat (concat x y) zs))))616 ;;;;;;;;;;;;;;;;at this point all the support for syntax-quote exists;;;;;;;;;;;;;;;;;;;;;;617 (defmacro delay618 "Takes a body of expressions and yields a Delay object that will619 invoke the body only the first time it is forced (with force or deref/@), and620 will cache the result and return it on all subsequent force621 calls."622 {:added "1.0"}623 [& body]624 (list 'new 'clojure.lang.Delay (list* `^{:once true} fn* [] body)))626 (defn delay?627 "returns true if x is a Delay created with delay"628 {:added "1.0"}629 [x] (instance? clojure.lang.Delay x))631 (defn force632 "If x is a Delay, returns the (possibly cached) value of its expression, else returns x"633 {:added "1.0"}634 [x] (. clojure.lang.Delay (force x)))636 (defmacro if-not637 "Evaluates test. If logical false, evaluates and returns then expr,638 otherwise else expr, if supplied, else nil."639 {:added "1.0"}640 ([test then] `(if-not ~test ~then nil))641 ([test then else]642 `(if (not ~test) ~then ~else)))644 (defn identical?645 "Tests if 2 arguments are the same object"646 {:inline (fn [x y] `(. clojure.lang.Util identical ~x ~y))647 :inline-arities #{2}648 :added "1.0"}649 ([x y] (clojure.lang.Util/identical x y)))651 (defn =652 "Equality. Returns true if x equals y, false if not. Same as653 Java x.equals(y) except it also works for nil, and compares654 numbers and collections in a type-independent manner. Clojure's immutable data655 structures define equals() (and thus =) as a value, not an identity,656 comparison."657 {:inline (fn [x y] `(. clojure.lang.Util equiv ~x ~y))658 :inline-arities #{2}659 :added "1.0"}660 ([x] true)661 ([x y] (clojure.lang.Util/equiv x y))662 ([x y & more]663 (if (= x y)664 (if (next more)665 (recur y (first more) (next more))666 (= y (first more)))667 false)))669 (defn not=670 "Same as (not (= obj1 obj2))"671 {:tag Boolean672 :added "1.0"}673 ([x] false)674 ([x y] (not (= x y)))675 ([x y & more]676 (not (apply = x y more))))680 (defn compare681 "Comparator. Returns a negative number, zero, or a positive number682 when x is logically 'less than', 'equal to', or 'greater than'683 y. Same as Java x.compareTo(y) except it also works for nil, and684 compares numbers and collections in a type-independent manner. x685 must implement Comparable"686 {687 :inline (fn [x y] `(. clojure.lang.Util compare ~x ~y))688 :added "1.0"}689 [x y] (. clojure.lang.Util (compare x y)))691 (defmacro and692 "Evaluates exprs one at a time, from left to right. If a form693 returns logical false (nil or false), and returns that value and694 doesn't evaluate any of the other expressions, otherwise it returns695 the value of the last expr. (and) returns true."696 {:added "1.0"}697 ([] true)698 ([x] x)699 ([x & next]700 `(let [and# ~x]701 (if and# (and ~@next) and#))))703 (defmacro or704 "Evaluates exprs one at a time, from left to right. If a form705 returns a logical true value, or returns that value and doesn't706 evaluate any of the other expressions, otherwise it returns the707 value of the last expression. (or) returns nil."708 {:added "1.0"}709 ([] nil)710 ([x] x)711 ([x & next]712 `(let [or# ~x]713 (if or# or# (or ~@next)))))715 ;;;;;;;;;;;;;;;;;;; sequence fns ;;;;;;;;;;;;;;;;;;;;;;;716 (defn zero?717 "Returns true if num is zero, else false"718 {719 :inline (fn [x] `(. clojure.lang.Numbers (isZero ~x)))720 :added "1.0"}721 [x] (. clojure.lang.Numbers (isZero x)))723 (defn count724 "Returns the number of items in the collection. (count nil) returns725 0. Also works on strings, arrays, and Java Collections and Maps"726 {727 :inline (fn [x] `(. clojure.lang.RT (count ~x)))728 :added "1.0"}729 [coll] (clojure.lang.RT/count coll))731 (defn int732 "Coerce to int"733 {734 :inline (fn [x] `(. clojure.lang.RT (intCast ~x)))735 :added "1.0"}736 [x] (. clojure.lang.RT (intCast x)))738 (defn nth739 "Returns the value at the index. get returns nil if index out of740 bounds, nth throws an exception unless not-found is supplied. nth741 also works for strings, Java arrays, regex Matchers and Lists, and,742 in O(n) time, for sequences."743 {:inline (fn [c i & nf] `(. clojure.lang.RT (nth ~c ~i ~@nf)))744 :inline-arities #{2 3}745 :added "1.0"}746 ([coll index] (. clojure.lang.RT (nth coll index)))747 ([coll index not-found] (. clojure.lang.RT (nth coll index not-found))))749 (defn <750 "Returns non-nil if nums are in monotonically increasing order,751 otherwise false."752 {:inline (fn [x y] `(. clojure.lang.Numbers (lt ~x ~y)))753 :inline-arities #{2}754 :added "1.0"}755 ([x] true)756 ([x y] (. clojure.lang.Numbers (lt x y)))757 ([x y & more]758 (if (< x y)759 (if (next more)760 (recur y (first more) (next more))761 (< y (first more)))762 false)))764 (defn inc765 "Returns a number one greater than num."766 {:inline (fn [x] `(. clojure.lang.Numbers (inc ~x)))767 :added "1.0"}768 [x] (. clojure.lang.Numbers (inc x)))770 ;; reduce is defined again later after InternalReduce loads771 (def772 ^{:arglists '([f coll] [f val coll])773 :doc "f should be a function of 2 arguments. If val is not supplied,774 returns the result of applying f to the first 2 items in coll, then775 applying f to that result and the 3rd item, etc. If coll contains no776 items, f must accept no arguments as well, and reduce returns the777 result of calling f with no arguments. If coll has only 1 item, it778 is returned and f is not called. If val is supplied, returns the779 result of applying f to val and the first item in coll, then780 applying f to that result and the 2nd item, etc. If coll contains no781 items, returns val and f is not called."782 :added "1.0"}783 reduce784 (fn r785 ([f coll]786 (let [s (seq coll)]787 (if s788 (r f (first s) (next s))789 (f))))790 ([f val coll]791 (let [s (seq coll)]792 (if s793 (if (chunked-seq? s)794 (recur f795 (.reduce (chunk-first s) f val)796 (chunk-next s))797 (recur f (f val (first s)) (next s)))798 val)))))800 (defn reverse801 "Returns a seq of the items in coll in reverse order. Not lazy."802 {:added "1.0"}803 [coll]804 (reduce conj () coll))806 ;;math stuff807 (defn +808 "Returns the sum of nums. (+) returns 0."809 {:inline (fn [x y] `(. clojure.lang.Numbers (add ~x ~y)))810 :inline-arities #{2}811 :added "1.0"}812 ([] 0)813 ([x] (cast Number x))814 ([x y] (. clojure.lang.Numbers (add x y)))815 ([x y & more]816 (reduce + (+ x y) more)))818 (defn *819 "Returns the product of nums. (*) returns 1."820 {:inline (fn [x y] `(. clojure.lang.Numbers (multiply ~x ~y)))821 :inline-arities #{2}822 :added "1.0"}823 ([] 1)824 ([x] (cast Number x))825 ([x y] (. clojure.lang.Numbers (multiply x y)))826 ([x y & more]827 (reduce * (* x y) more)))829 (defn /830 "If no denominators are supplied, returns 1/numerator,831 else returns numerator divided by all of the denominators."832 {:inline (fn [x y] `(. clojure.lang.Numbers (divide ~x ~y)))833 :inline-arities #{2}834 :added "1.0"}835 ([x] (/ 1 x))836 ([x y] (. clojure.lang.Numbers (divide x y)))837 ([x y & more]838 (reduce / (/ x y) more)))840 (defn -841 "If no ys are supplied, returns the negation of x, else subtracts842 the ys from x and returns the result."843 {:inline (fn [& args] `(. clojure.lang.Numbers (minus ~@args)))844 :inline-arities #{1 2}845 :added "1.0"}846 ([x] (. clojure.lang.Numbers (minus x)))847 ([x y] (. clojure.lang.Numbers (minus x y)))848 ([x y & more]849 (reduce - (- x y) more)))851 (defn <=852 "Returns non-nil if nums are in monotonically non-decreasing order,853 otherwise false."854 {:inline (fn [x y] `(. clojure.lang.Numbers (lte ~x ~y)))855 :inline-arities #{2}856 :added "1.0"}857 ([x] true)858 ([x y] (. clojure.lang.Numbers (lte x y)))859 ([x y & more]860 (if (<= x y)861 (if (next more)862 (recur y (first more) (next more))863 (<= y (first more)))864 false)))866 (defn >867 "Returns non-nil if nums are in monotonically decreasing order,868 otherwise false."869 {:inline (fn [x y] `(. clojure.lang.Numbers (gt ~x ~y)))870 :inline-arities #{2}871 :added "1.0"}872 ([x] true)873 ([x y] (. clojure.lang.Numbers (gt x y)))874 ([x y & more]875 (if (> x y)876 (if (next more)877 (recur y (first more) (next more))878 (> y (first more)))879 false)))881 (defn >=882 "Returns non-nil if nums are in monotonically non-increasing order,883 otherwise false."884 {:inline (fn [x y] `(. clojure.lang.Numbers (gte ~x ~y)))885 :inline-arities #{2}886 :added "1.0"}887 ([x] true)888 ([x y] (. clojure.lang.Numbers (gte x y)))889 ([x y & more]890 (if (>= x y)891 (if (next more)892 (recur y (first more) (next more))893 (>= y (first more)))894 false)))896 (defn ==897 "Returns non-nil if nums all have the same value, otherwise false"898 {:inline (fn [x y] `(. clojure.lang.Numbers (equiv ~x ~y)))899 :inline-arities #{2}900 :added "1.0"}901 ([x] true)902 ([x y] (. clojure.lang.Numbers (equiv x y)))903 ([x y & more]904 (if (== x y)905 (if (next more)906 (recur y (first more) (next more))907 (== y (first more)))908 false)))910 (defn max911 "Returns the greatest of the nums."912 {:added "1.0"}913 ([x] x)914 ([x y] (if (> x y) x y))915 ([x y & more]916 (reduce max (max x y) more)))918 (defn min919 "Returns the least of the nums."920 {:added "1.0"}921 ([x] x)922 ([x y] (if (< x y) x y))923 ([x y & more]924 (reduce min (min x y) more)))926 (defn dec927 "Returns a number one less than num."928 {:inline (fn [x] `(. clojure.lang.Numbers (dec ~x)))929 :added "1.0"}930 [x] (. clojure.lang.Numbers (dec x)))932 (defn unchecked-inc933 "Returns a number one greater than x, an int or long.934 Note - uses a primitive operator subject to overflow."935 {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_inc ~x)))936 :added "1.0"}937 [x] (. clojure.lang.Numbers (unchecked_inc x)))939 (defn unchecked-dec940 "Returns a number one less than x, an int or long.941 Note - uses a primitive operator subject to overflow."942 {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_dec ~x)))943 :added "1.0"}944 [x] (. clojure.lang.Numbers (unchecked_dec x)))946 (defn unchecked-negate947 "Returns the negation of x, an int or long.948 Note - uses a primitive operator subject to overflow."949 {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_negate ~x)))950 :added "1.0"}951 [x] (. clojure.lang.Numbers (unchecked_negate x)))953 (defn unchecked-add954 "Returns the sum of x and y, both int or long.955 Note - uses a primitive operator subject to overflow."956 {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_add ~x ~y)))957 :added "1.0"}958 [x y] (. clojure.lang.Numbers (unchecked_add x y)))960 (defn unchecked-subtract961 "Returns the difference of x and y, both int or long.962 Note - uses a primitive operator subject to overflow."963 {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_subtract ~x ~y)))964 :added "1.0"}965 [x y] (. clojure.lang.Numbers (unchecked_subtract x y)))967 (defn unchecked-multiply968 "Returns the product of x and y, both int or long.969 Note - uses a primitive operator subject to overflow."970 {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_multiply ~x ~y)))971 :added "1.0"}972 [x y] (. clojure.lang.Numbers (unchecked_multiply x y)))974 (defn unchecked-divide975 "Returns the division of x by y, both int or long.976 Note - uses a primitive operator subject to truncation."977 {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_divide ~x ~y)))978 :added "1.0"}979 [x y] (. clojure.lang.Numbers (unchecked_divide x y)))981 (defn unchecked-remainder982 "Returns the remainder of division of x by y, both int or long.983 Note - uses a primitive operator subject to truncation."984 {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_remainder ~x ~y)))985 :added "1.0"}986 [x y] (. clojure.lang.Numbers (unchecked_remainder x y)))988 (defn pos?989 "Returns true if num is greater than zero, else false"990 {991 :inline (fn [x] `(. clojure.lang.Numbers (isPos ~x)))992 :added "1.0"}993 [x] (. clojure.lang.Numbers (isPos x)))995 (defn neg?996 "Returns true if num is less than zero, else false"997 {998 :inline (fn [x] `(. clojure.lang.Numbers (isNeg ~x)))999 :added "1.0"}1000 [x] (. clojure.lang.Numbers (isNeg x)))1002 (defn quot1003 "quot[ient] of dividing numerator by denominator."1004 {:added "1.0"}1005 [num div]1006 (. clojure.lang.Numbers (quotient num div)))1008 (defn rem1009 "remainder of dividing numerator by denominator."1010 {:added "1.0"}1011 [num div]1012 (. clojure.lang.Numbers (remainder num div)))1014 (defn rationalize1015 "returns the rational value of num"1016 {:added "1.0"}1017 [num]1018 (. clojure.lang.Numbers (rationalize num)))1020 ;;Bit ops1022 (defn bit-not1023 "Bitwise complement"1024 {:inline (fn [x] `(. clojure.lang.Numbers (not ~x)))1025 :added "1.0"}1026 [x] (. clojure.lang.Numbers not x))1029 (defn bit-and1030 "Bitwise and"1031 {:inline (fn [x y] `(. clojure.lang.Numbers (and ~x ~y)))1032 :added "1.0"}1033 [x y] (. clojure.lang.Numbers and x y))1035 (defn bit-or1036 "Bitwise or"1037 {:inline (fn [x y] `(. clojure.lang.Numbers (or ~x ~y)))1038 :added "1.0"}1039 [x y] (. clojure.lang.Numbers or x y))1041 (defn bit-xor1042 "Bitwise exclusive or"1043 {:inline (fn [x y] `(. clojure.lang.Numbers (xor ~x ~y)))1044 :added "1.0"}1045 [x y] (. clojure.lang.Numbers xor x y))1047 (defn bit-and-not1048 "Bitwise and with complement"1049 {:added "1.0"}1050 [x y] (. clojure.lang.Numbers andNot x y))1053 (defn bit-clear1054 "Clear bit at index n"1055 {:added "1.0"}1056 [x n] (. clojure.lang.Numbers clearBit x n))1058 (defn bit-set1059 "Set bit at index n"1060 {:added "1.0"}1061 [x n] (. clojure.lang.Numbers setBit x n))1063 (defn bit-flip1064 "Flip bit at index n"1065 {:added "1.0"}1066 [x n] (. clojure.lang.Numbers flipBit x n))1068 (defn bit-test1069 "Test bit at index n"1070 {:added "1.0"}1071 [x n] (. clojure.lang.Numbers testBit x n))1074 (defn bit-shift-left1075 "Bitwise shift left"1076 {:inline (fn [x n] `(. clojure.lang.Numbers (shiftLeft ~x ~n)))1077 :added "1.0"}1078 [x n] (. clojure.lang.Numbers shiftLeft x n))1080 (defn bit-shift-right1081 "Bitwise shift right"1082 {:inline (fn [x n] `(. clojure.lang.Numbers (shiftRight ~x ~n)))1083 :added "1.0"}1084 [x n] (. clojure.lang.Numbers shiftRight x n))1086 (defn even?1087 "Returns true if n is even, throws an exception if n is not an integer"1088 {:added "1.0"}1089 [n] (zero? (bit-and n 1)))1091 (defn odd?1092 "Returns true if n is odd, throws an exception if n is not an integer"1093 {:added "1.0"}1094 [n] (not (even? n)))1097 ;;1099 (defn complement1100 "Takes a fn f and returns a fn that takes the same arguments as f,1101 has the same effects, if any, and returns the opposite truth value."1102 {:added "1.0"}1103 [f]1104 (fn1105 ([] (not (f)))1106 ([x] (not (f x)))1107 ([x y] (not (f x y)))1108 ([x y & zs] (not (apply f x y zs)))))1110 (defn constantly1111 "Returns a function that takes any number of arguments and returns x."1112 {:added "1.0"}1113 [x] (fn [& args] x))1115 (defn identity1116 "Returns its argument."1117 {:added "1.0"}1118 [x] x)1120 ;;Collection stuff1126 ;;list stuff1127 (defn peek1128 "For a list or queue, same as first, for a vector, same as, but much1129 more efficient than, last. If the collection is empty, returns nil."1130 {:added "1.0"}1131 [coll] (. clojure.lang.RT (peek coll)))1133 (defn pop1134 "For a list or queue, returns a new list/queue without the first1135 item, for a vector, returns a new vector without the last item. If1136 the collection is empty, throws an exception. Note - not the same1137 as next/butlast."1138 {:added "1.0"}1139 [coll] (. clojure.lang.RT (pop coll)))1141 ;;map stuff1143 (defn contains?1144 "Returns true if key is present in the given collection, otherwise1145 returns false. Note that for numerically indexed collections like1146 vectors and Java arrays, this tests if the numeric key is within the1147 range of indexes. 'contains?' operates constant or logarithmic time;1148 it will not perform a linear search for a value. See also 'some'."1149 {:added "1.0"}1150 [coll key] (. clojure.lang.RT (contains coll key)))1152 (defn get1153 "Returns the value mapped to key, not-found or nil if key not present."1154 {:inline (fn [m k & nf] `(. clojure.lang.RT (get ~m ~k ~@nf)))1155 :inline-arities #{2 3}1156 :added "1.0"}1157 ([map key]1158 (. clojure.lang.RT (get map key)))1159 ([map key not-found]1160 (. clojure.lang.RT (get map key not-found))))1162 (defn dissoc1163 "dissoc[iate]. Returns a new map of the same (hashed/sorted) type,1164 that does not contain a mapping for key(s)."1165 {:added "1.0"}1166 ([map] map)1167 ([map key]1168 (. clojure.lang.RT (dissoc map key)))1169 ([map key & ks]1170 (let [ret (dissoc map key)]1171 (if ks1172 (recur ret (first ks) (next ks))1173 ret))))1175 (defn disj1176 "disj[oin]. Returns a new set of the same (hashed/sorted) type, that1177 does not contain key(s)."1178 {:added "1.0"}1179 ([set] set)1180 ([^clojure.lang.IPersistentSet set key]1181 (when set1182 (. set (disjoin key))))1183 ([set key & ks]1184 (when set1185 (let [ret (disj set key)]1186 (if ks1187 (recur ret (first ks) (next ks))1188 ret)))))1190 (defn find1191 "Returns the map entry for key, or nil if key not present."1192 {:added "1.0"}1193 [map key] (. clojure.lang.RT (find map key)))1195 (defn select-keys1196 "Returns a map containing only those entries in map whose key is in keys"1197 {:added "1.0"}1198 [map keyseq]1199 (loop [ret {} keys (seq keyseq)]1200 (if keys1201 (let [entry (. clojure.lang.RT (find map (first keys)))]1202 (recur1203 (if entry1204 (conj ret entry)1205 ret)1206 (next keys)))1207 ret)))1209 (defn keys1210 "Returns a sequence of the map's keys."1211 {:added "1.0"}1212 [map] (. clojure.lang.RT (keys map)))1214 (defn vals1215 "Returns a sequence of the map's values."1216 {:added "1.0"}1217 [map] (. clojure.lang.RT (vals map)))1219 (defn key1220 "Returns the key of the map entry."1221 {:added "1.0"}1222 [^java.util.Map$Entry e]1223 (. e (getKey)))1225 (defn val1226 "Returns the value in the map entry."1227 {:added "1.0"}1228 [^java.util.Map$Entry e]1229 (. e (getValue)))1231 (defn rseq1232 "Returns, in constant time, a seq of the items in rev (which1233 can be a vector or sorted-map), in reverse order. If rev is empty returns nil"1234 {:added "1.0"}1235 [^clojure.lang.Reversible rev]1236 (. rev (rseq)))1238 (defn name1239 "Returns the name String of a string, symbol or keyword."1240 {:tag String1241 :added "1.0"}1242 [^clojure.lang.Named x]1243 (if (string? x) x (. x (getName))))1245 (defn namespace1246 "Returns the namespace String of a symbol or keyword, or nil if not present."1247 {:tag String1248 :added "1.0"}1249 [^clojure.lang.Named x]1250 (. x (getNamespace)))1252 (defmacro locking1253 "Executes exprs in an implicit do, while holding the monitor of x.1254 Will release the monitor of x in all circumstances."1255 {:added "1.0"}1256 [x & body]1257 `(let [lockee# ~x]1258 (try1259 (monitor-enter lockee#)1260 ~@body1261 (finally1262 (monitor-exit lockee#)))))1264 (defmacro ..1265 "form => fieldName-symbol or (instanceMethodName-symbol args*)1267 Expands into a member access (.) of the first member on the first1268 argument, followed by the next member on the result, etc. For1269 instance:1271 (.. System (getProperties) (get \"os.name\"))1273 expands to:1275 (. (. System (getProperties)) (get \"os.name\"))1277 but is easier to write, read, and understand."1278 {:added "1.0"}1279 ([x form] `(. ~x ~form))1280 ([x form & more] `(.. (. ~x ~form) ~@more)))1282 (defmacro ->1283 "Threads the expr through the forms. Inserts x as the1284 second item in the first form, making a list of it if it is not a1285 list already. If there are more forms, inserts the first form as the1286 second item in second form, etc."1287 {:added "1.0"}1288 ([x] x)1289 ([x form] (if (seq? form)1290 (with-meta `(~(first form) ~x ~@(next form)) (meta form))1291 (list form x)))1292 ([x form & more] `(-> (-> ~x ~form) ~@more)))1294 (defmacro ->>1295 "Threads the expr through the forms. Inserts x as the1296 last item in the first form, making a list of it if it is not a1297 list already. If there are more forms, inserts the first form as the1298 last item in second form, etc."1299 {:added "1.1"}1300 ([x form] (if (seq? form)1301 (with-meta `(~(first form) ~@(next form) ~x) (meta form))1302 (list form x)))1303 ([x form & more] `(->> (->> ~x ~form) ~@more)))1305 ;;multimethods1306 (def global-hierarchy)1308 (defmacro defmulti1309 "Creates a new multimethod with the associated dispatch function.1310 The docstring and attribute-map are optional.1312 Options are key-value pairs and may be one of:1313 :default the default dispatch value, defaults to :default1314 :hierarchy the isa? hierarchy to use for dispatching1315 defaults to the global hierarchy"1316 {:arglists '([name docstring? attr-map? dispatch-fn & options])1317 :added "1.0"}1318 [mm-name & options]1319 (let [docstring (if (string? (first options))1320 (first options)1321 nil)1322 options (if (string? (first options))1323 (next options)1324 options)1325 m (if (map? (first options))1326 (first options)1327 {})1328 options (if (map? (first options))1329 (next options)1330 options)1331 dispatch-fn (first options)1332 options (next options)1333 m (assoc m :tag 'clojure.lang.MultiFn)1334 m (if docstring1335 (assoc m :doc docstring)1336 m)1337 m (if (meta mm-name)1338 (conj (meta mm-name) m)1339 m)]1340 (when (= (count options) 1)1341 (throw (Exception. "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)")))1342 (let [options (apply hash-map options)1343 default (get options :default :default)1344 hierarchy (get options :hierarchy #'global-hierarchy)]1345 `(let [v# (def ~mm-name)]1346 (when-not (and (.hasRoot v#) (instance? clojure.lang.MultiFn (deref v#)))1347 (def ~(with-meta mm-name m)1348 (new clojure.lang.MultiFn ~(name mm-name) ~dispatch-fn ~default ~hierarchy)))))))1350 (defmacro defmethod1351 "Creates and installs a new method of multimethod associated with dispatch-value. "1352 {:added "1.0"}1353 [multifn dispatch-val & fn-tail]1354 `(. ~(with-meta multifn {:tag 'clojure.lang.MultiFn}) addMethod ~dispatch-val (fn ~@fn-tail)))1356 (defn remove-all-methods1357 "Removes all of the methods of multimethod."1358 {:added "1.2"}1359 [^clojure.lang.MultiFn multifn]1360 (.reset multifn))1362 (defn remove-method1363 "Removes the method of multimethod associated with dispatch-value."1364 {:added "1.0"}1365 [^clojure.lang.MultiFn multifn dispatch-val]1366 (. multifn removeMethod dispatch-val))1368 (defn prefer-method1369 "Causes the multimethod to prefer matches of dispatch-val-x over dispatch-val-y1370 when there is a conflict"1371 {:added "1.0"}1372 [^clojure.lang.MultiFn multifn dispatch-val-x dispatch-val-y]1373 (. multifn preferMethod dispatch-val-x dispatch-val-y))1375 (defn methods1376 "Given a multimethod, returns a map of dispatch values -> dispatch fns"1377 {:added "1.0"}1378 [^clojure.lang.MultiFn multifn] (.getMethodTable multifn))1380 (defn get-method1381 "Given a multimethod and a dispatch value, returns the dispatch fn1382 that would apply to that value, or nil if none apply and no default"1383 {:added "1.0"}1384 [^clojure.lang.MultiFn multifn dispatch-val] (.getMethod multifn dispatch-val))1386 (defn prefers1387 "Given a multimethod, returns a map of preferred value -> set of other values"1388 {:added "1.0"}1389 [^clojure.lang.MultiFn multifn] (.getPreferTable multifn))1391 ;;;;;;;;; var stuff1393 (defmacro ^{:private true} assert-args [fnname & pairs]1394 `(do (when-not ~(first pairs)1395 (throw (IllegalArgumentException.1396 ~(str fnname " requires " (second pairs)))))1397 ~(let [more (nnext pairs)]1398 (when more1399 (list* `assert-args fnname more)))))1401 (defmacro if-let1402 "bindings => binding-form test1404 If test is true, evaluates then with binding-form bound to the value of1405 test, if not, yields else"1406 {:added "1.0"}1407 ([bindings then]1408 `(if-let ~bindings ~then nil))1409 ([bindings then else & oldform]1410 (assert-args if-let1411 (and (vector? bindings) (nil? oldform)) "a vector for its binding"1412 (= 2 (count bindings)) "exactly 2 forms in binding vector")1413 (let [form (bindings 0) tst (bindings 1)]1414 `(let [temp# ~tst]1415 (if temp#1416 (let [~form temp#]1417 ~then)1418 ~else)))))1420 (defmacro when-let1421 "bindings => binding-form test1423 When test is true, evaluates body with binding-form bound to the value of test"1424 {:added "1.0"}1425 [bindings & body]1426 (assert-args when-let1427 (vector? bindings) "a vector for its binding"1428 (= 2 (count bindings)) "exactly 2 forms in binding vector")1429 (let [form (bindings 0) tst (bindings 1)]1430 `(let [temp# ~tst]1431 (when temp#1432 (let [~form temp#]1433 ~@body)))))1435 (defn push-thread-bindings1436 "WARNING: This is a low-level function. Prefer high-level macros like1437 binding where ever possible.1439 Takes a map of Var/value pairs. Binds each Var to the associated value for1440 the current thread. Each call *MUST* be accompanied by a matching call to1441 pop-thread-bindings wrapped in a try-finally!1443 (push-thread-bindings bindings)1444 (try1445 ...1446 (finally1447 (pop-thread-bindings)))"1448 {:added "1.1"}1449 [bindings]1450 (clojure.lang.Var/pushThreadBindings bindings))1452 (defn pop-thread-bindings1453 "Pop one set of bindings pushed with push-binding before. It is an error to1454 pop bindings without pushing before."1455 {:added "1.1"}1456 []1457 (clojure.lang.Var/popThreadBindings))1459 (defn get-thread-bindings1460 "Get a map with the Var/value pairs which is currently in effect for the1461 current thread."1462 {:added "1.1"}1463 []1464 (clojure.lang.Var/getThreadBindings))1466 (defmacro binding1467 "binding => var-symbol init-expr1469 Creates new bindings for the (already-existing) vars, with the1470 supplied initial values, executes the exprs in an implicit do, then1471 re-establishes the bindings that existed before. The new bindings1472 are made in parallel (unlike let); all init-exprs are evaluated1473 before the vars are bound to their new values."1474 {:added "1.0"}1475 [bindings & body]1476 (assert-args binding1477 (vector? bindings) "a vector for its binding"1478 (even? (count bindings)) "an even number of forms in binding vector")1479 (let [var-ize (fn [var-vals]1480 (loop [ret [] vvs (seq var-vals)]1481 (if vvs1482 (recur (conj (conj ret `(var ~(first vvs))) (second vvs))1483 (next (next vvs)))1484 (seq ret))))]1485 `(let []1486 (push-thread-bindings (hash-map ~@(var-ize bindings)))1487 (try1488 ~@body1489 (finally1490 (pop-thread-bindings))))))1492 (defn with-bindings*1493 "Takes a map of Var/value pairs. Installs for the given Vars the associated1494 values as thread-local bindings. Then calls f with the supplied arguments.1495 Pops the installed bindings after f returned. Returns whatever f returns."1496 {:added "1.1"}1497 [binding-map f & args]1498 (push-thread-bindings binding-map)1499 (try1500 (apply f args)1501 (finally1502 (pop-thread-bindings))))1504 (defmacro with-bindings1505 "Takes a map of Var/value pairs. Installs for the given Vars the associated1506 values as thread-local bindings. The executes body. Pops the installed1507 bindings after body was evaluated. Returns the value of body."1508 {:added "1.1"}1509 [binding-map & body]1510 `(with-bindings* ~binding-map (fn [] ~@body)))1512 (defn bound-fn*1513 "Returns a function, which will install the same bindings in effect as in1514 the thread at the time bound-fn* was called and then call f with any given1515 arguments. This may be used to define a helper function which runs on a1516 different thread, but needs the same bindings in place."1517 {:added "1.1"}1518 [f]1519 (let [bindings (get-thread-bindings)]1520 (fn [& args]1521 (apply with-bindings* bindings f args))))1523 (defmacro bound-fn1524 "Returns a function defined by the given fntail, which will install the1525 same bindings in effect as in the thread at the time bound-fn was called.1526 This may be used to define a helper function which runs on a different1527 thread, but needs the same bindings in place."1528 {:added "1.1"}1529 [& fntail]1530 `(bound-fn* (fn ~@fntail)))1532 (defn find-var1533 "Returns the global var named by the namespace-qualified symbol, or1534 nil if no var with that name."1535 {:added "1.0"}1536 [sym] (. clojure.lang.Var (find sym)))1538 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Refs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;1539 (defn ^{:private true}1540 setup-reference [^clojure.lang.ARef r options]1541 (let [opts (apply hash-map options)]1542 (when (:meta opts)1543 (.resetMeta r (:meta opts)))1544 (when (:validator opts)1545 (.setValidator r (:validator opts)))1546 r))1548 (defn agent1549 "Creates and returns an agent with an initial value of state and1550 zero or more options (in any order):1552 :meta metadata-map1554 :validator validate-fn1556 :error-handler handler-fn1558 :error-mode mode-keyword1560 If metadata-map is supplied, it will be come the metadata on the1561 agent. validate-fn must be nil or a side-effect-free fn of one1562 argument, which will be passed the intended new state on any state1563 change. If the new state is unacceptable, the validate-fn should1564 return false or throw an exception. handler-fn is called if an1565 action throws an exception or if validate-fn rejects a new state --1566 see set-error-handler! for details. The mode-keyword may be either1567 :continue (the default if an error-handler is given) or :fail (the1568 default if no error-handler is given) -- see set-error-mode! for1569 details."1570 {:added "1.0"}1571 ([state & options]1572 (let [a (new clojure.lang.Agent state)1573 opts (apply hash-map options)]1574 (setup-reference a options)1575 (when (:error-handler opts)1576 (.setErrorHandler a (:error-handler opts)))1577 (.setErrorMode a (or (:error-mode opts)1578 (if (:error-handler opts) :continue :fail)))1579 a)))1581 (defn send1582 "Dispatch an action to an agent. Returns the agent immediately.1583 Subsequently, in a thread from a thread pool, the state of the agent1584 will be set to the value of:1586 (apply action-fn state-of-agent args)"1587 {:added "1.0"}1588 [^clojure.lang.Agent a f & args]1589 (. a (dispatch f args false)))1591 (defn send-off1592 "Dispatch a potentially blocking action to an agent. Returns the1593 agent immediately. Subsequently, in a separate thread, the state of1594 the agent will be set to the value of:1596 (apply action-fn state-of-agent args)"1597 {:added "1.0"}1598 [^clojure.lang.Agent a f & args]1599 (. a (dispatch f args true)))1601 (defn release-pending-sends1602 "Normally, actions sent directly or indirectly during another action1603 are held until the action completes (changes the agent's1604 state). This function can be used to dispatch any pending sent1605 actions immediately. This has no impact on actions sent during a1606 transaction, which are still held until commit. If no action is1607 occurring, does nothing. Returns the number of actions dispatched."1608 {:added "1.0"}1609 [] (clojure.lang.Agent/releasePendingSends))1611 (defn add-watch1612 "Alpha - subject to change.1613 Adds a watch function to an agent/atom/var/ref reference. The watch1614 fn must be a fn of 4 args: a key, the reference, its old-state, its1615 new-state. Whenever the reference's state might have been changed,1616 any registered watches will have their functions called. The watch fn1617 will be called synchronously, on the agent's thread if an agent,1618 before any pending sends if agent or ref. Note that an atom's or1619 ref's state may have changed again prior to the fn call, so use1620 old/new-state rather than derefing the reference. Note also that watch1621 fns may be called from multiple threads simultaneously. Var watchers1622 are triggered only by root binding changes, not thread-local1623 set!s. Keys must be unique per reference, and can be used to remove1624 the watch with remove-watch, but are otherwise considered opaque by1625 the watch mechanism."1626 {:added "1.0"}1627 [^clojure.lang.IRef reference key fn] (.addWatch reference key fn))1629 (defn remove-watch1630 "Alpha - subject to change.1631 Removes a watch (set by add-watch) from a reference"1632 {:added "1.0"}1633 [^clojure.lang.IRef reference key]1634 (.removeWatch reference key))1636 (defn agent-error1637 "Returns the exception thrown during an asynchronous action of the1638 agent if the agent is failed. Returns nil if the agent is not1639 failed."1640 {:added "1.2"}1641 [^clojure.lang.Agent a] (.getError a))1643 (defn restart-agent1644 "When an agent is failed, changes the agent state to new-state and1645 then un-fails the agent so that sends are allowed again. If1646 a :clear-actions true option is given, any actions queued on the1647 agent that were being held while it was failed will be discarded,1648 otherwise those held actions will proceed. The new-state must pass1649 the validator if any, or restart will throw an exception and the1650 agent will remain failed with its old state and error. Watchers, if1651 any, will NOT be notified of the new state. Throws an exception if1652 the agent is not failed."1653 {:added "1.2"}1654 [^clojure.lang.Agent a, new-state & options]1655 (let [opts (apply hash-map options)]1656 (.restart a new-state (if (:clear-actions opts) true false))))1658 (defn set-error-handler!1659 "Sets the error-handler of agent a to handler-fn. If an action1660 being run by the agent throws an exception or doesn't pass the1661 validator fn, handler-fn will be called with two arguments: the1662 agent and the exception."1663 {:added "1.2"}1664 [^clojure.lang.Agent a, handler-fn]1665 (.setErrorHandler a handler-fn))1667 (defn error-handler1668 "Returns the error-handler of agent a, or nil if there is none.1669 See set-error-handler!"1670 {:added "1.2"}1671 [^clojure.lang.Agent a]1672 (.getErrorHandler a))1674 (defn set-error-mode!1675 "Sets the error-mode of agent a to mode-keyword, which must be1676 either :fail or :continue. If an action being run by the agent1677 throws an exception or doesn't pass the validator fn, an1678 error-handler may be called (see set-error-handler!), after which,1679 if the mode is :continue, the agent will continue as if neither the1680 action that caused the error nor the error itself ever happened.1682 If the mode is :fail, the agent will become failed and will stop1683 accepting new 'send' and 'send-off' actions, and any previously1684 queued actions will be held until a 'restart-agent'. Deref will1685 still work, returning the state of the agent before the error."1686 {:added "1.2"}1687 [^clojure.lang.Agent a, mode-keyword]1688 (.setErrorMode a mode-keyword))1690 (defn error-mode1691 "Returns the error-mode of agent a. See set-error-mode!"1692 {:added "1.2"}1693 [^clojure.lang.Agent a]1694 (.getErrorMode a))1696 (defn agent-errors1697 "DEPRECATED: Use 'agent-error' instead.1698 Returns a sequence of the exceptions thrown during asynchronous1699 actions of the agent."1700 {:added "1.0"1701 :deprecated "1.2"}1702 [a]1703 (when-let [e (agent-error a)]1704 (list e)))1706 (defn clear-agent-errors1707 "DEPRECATED: Use 'restart-agent' instead.1708 Clears any exceptions thrown during asynchronous actions of the1709 agent, allowing subsequent actions to occur."1710 {:added "1.0"1711 :deprecated "1.2"}1712 [^clojure.lang.Agent a] (restart-agent a (.deref a)))1714 (defn shutdown-agents1715 "Initiates a shutdown of the thread pools that back the agent1716 system. Running actions will complete, but no new actions will be1717 accepted"1718 {:added "1.0"}1719 [] (. clojure.lang.Agent shutdown))1721 (defn ref1722 "Creates and returns a Ref with an initial value of x and zero or1723 more options (in any order):1725 :meta metadata-map1727 :validator validate-fn1729 :min-history (default 0)1730 :max-history (default 10)1732 If metadata-map is supplied, it will be come the metadata on the1733 ref. validate-fn must be nil or a side-effect-free fn of one1734 argument, which will be passed the intended new state on any state1735 change. If the new state is unacceptable, the validate-fn should1736 return false or throw an exception. validate-fn will be called on1737 transaction commit, when all refs have their final values.1739 Normally refs accumulate history dynamically as needed to deal with1740 read demands. If you know in advance you will need history you can1741 set :min-history to ensure it will be available when first needed (instead1742 of after a read fault). History is limited, and the limit can be set1743 with :max-history."1744 {:added "1.0"}1745 ([x] (new clojure.lang.Ref x))1746 ([x & options]1747 (let [r ^clojure.lang.Ref (setup-reference (ref x) options)1748 opts (apply hash-map options)]1749 (when (:max-history opts)1750 (.setMaxHistory r (:max-history opts)))1751 (when (:min-history opts)1752 (.setMinHistory r (:min-history opts)))1753 r)))1755 (defn deref1756 "Also reader macro: @ref/@agent/@var/@atom/@delay/@future. Within a transaction,1757 returns the in-transaction-value of ref, else returns the1758 most-recently-committed value of ref. When applied to a var, agent1759 or atom, returns its current state. When applied to a delay, forces1760 it if not already forced. When applied to a future, will block if1761 computation not complete"1762 {:added "1.0"}1763 [^clojure.lang.IDeref ref] (.deref ref))1765 (defn atom1766 "Creates and returns an Atom with an initial value of x and zero or1767 more options (in any order):1769 :meta metadata-map1771 :validator validate-fn1773 If metadata-map is supplied, it will be come the metadata on the1774 atom. validate-fn must be nil or a side-effect-free fn of one1775 argument, which will be passed the intended new state on any state1776 change. If the new state is unacceptable, the validate-fn should1777 return false or throw an exception."1778 {:added "1.0"}1779 ([x] (new clojure.lang.Atom x))1780 ([x & options] (setup-reference (atom x) options)))1782 (defn swap!1783 "Atomically swaps the value of atom to be:1784 (apply f current-value-of-atom args). Note that f may be called1785 multiple times, and thus should be free of side effects. Returns1786 the value that was swapped in."1787 {:added "1.0"}1788 ([^clojure.lang.Atom atom f] (.swap atom f))1789 ([^clojure.lang.Atom atom f x] (.swap atom f x))1790 ([^clojure.lang.Atom atom f x y] (.swap atom f x y))1791 ([^clojure.lang.Atom atom f x y & args] (.swap atom f x y args)))1793 (defn compare-and-set!1794 "Atomically sets the value of atom to newval if and only if the1795 current value of the atom is identical to oldval. Returns true if1796 set happened, else false"1797 {:added "1.0"}1798 [^clojure.lang.Atom atom oldval newval] (.compareAndSet atom oldval newval))1800 (defn reset!1801 "Sets the value of atom to newval without regard for the1802 current value. Returns newval."1803 {:added "1.0"}1804 [^clojure.lang.Atom atom newval] (.reset atom newval))1806 (defn set-validator!1807 "Sets the validator-fn for a var/ref/agent/atom. validator-fn must be nil or a1808 side-effect-free fn of one argument, which will be passed the intended1809 new state on any state change. If the new state is unacceptable, the1810 validator-fn should return false or throw an exception. If the current state (root1811 value if var) is not acceptable to the new validator, an exception1812 will be thrown and the validator will not be changed."1813 {:added "1.0"}1814 [^clojure.lang.IRef iref validator-fn] (. iref (setValidator validator-fn)))1816 (defn get-validator1817 "Gets the validator-fn for a var/ref/agent/atom."1818 {:added "1.0"}1819 [^clojure.lang.IRef iref] (. iref (getValidator)))1821 (defn alter-meta!1822 "Atomically sets the metadata for a namespace/var/ref/agent/atom to be:1824 (apply f its-current-meta args)1826 f must be free of side-effects"1827 {:added "1.0"}1828 [^clojure.lang.IReference iref f & args] (.alterMeta iref f args))1830 (defn reset-meta!1831 "Atomically resets the metadata for a namespace/var/ref/agent/atom"1832 {:added "1.0"}1833 [^clojure.lang.IReference iref metadata-map] (.resetMeta iref metadata-map))1835 (defn commute1836 "Must be called in a transaction. Sets the in-transaction-value of1837 ref to:1839 (apply fun in-transaction-value-of-ref args)1841 and returns the in-transaction-value of ref.1843 At the commit point of the transaction, sets the value of ref to be:1845 (apply fun most-recently-committed-value-of-ref args)1847 Thus fun should be commutative, or, failing that, you must accept1848 last-one-in-wins behavior. commute allows for more concurrency than1849 ref-set."1850 {:added "1.0"}1852 [^clojure.lang.Ref ref fun & args]1853 (. ref (commute fun args)))1855 (defn alter1856 "Must be called in a transaction. Sets the in-transaction-value of1857 ref to:1859 (apply fun in-transaction-value-of-ref args)1861 and returns the in-transaction-value of ref."1862 {:added "1.0"}1863 [^clojure.lang.Ref ref fun & args]1864 (. ref (alter fun args)))1866 (defn ref-set1867 "Must be called in a transaction. Sets the value of ref.1868 Returns val."1869 {:added "1.0"}1870 [^clojure.lang.Ref ref val]1871 (. ref (set val)))1873 (defn ref-history-count1874 "Returns the history count of a ref"1875 {:added "1.1"}1876 [^clojure.lang.Ref ref]1877 (.getHistoryCount ref))1879 (defn ref-min-history1880 "Gets the min-history of a ref, or sets it and returns the ref"1881 {:added "1.1"}1882 ([^clojure.lang.Ref ref]1883 (.getMinHistory ref))1884 ([^clojure.lang.Ref ref n]1885 (.setMinHistory ref n)))1887 (defn ref-max-history1888 "Gets the max-history of a ref, or sets it and returns the ref"1889 {:added "1.1"}1890 ([^clojure.lang.Ref ref]1891 (.getMaxHistory ref))1892 ([^clojure.lang.Ref ref n]1893 (.setMaxHistory ref n)))1895 (defn ensure1896 "Must be called in a transaction. Protects the ref from modification1897 by other transactions. Returns the in-transaction-value of1898 ref. Allows for more concurrency than (ref-set ref @ref)"1899 {:added "1.0"}1900 [^clojure.lang.Ref ref]1901 (. ref (touch))1902 (. ref (deref)))1904 (defmacro sync1905 "transaction-flags => TBD, pass nil for now1907 Runs the exprs (in an implicit do) in a transaction that encompasses1908 exprs and any nested calls. Starts a transaction if none is already1909 running on this thread. Any uncaught exception will abort the1910 transaction and flow out of sync. The exprs may be run more than1911 once, but any effects on Refs will be atomic."1912 {:added "1.0"}1913 [flags-ignored-for-now & body]1914 `(. clojure.lang.LockingTransaction1915 (runInTransaction (fn [] ~@body))))1918 (defmacro io!1919 "If an io! block occurs in a transaction, throws an1920 IllegalStateException, else runs body in an implicit do. If the1921 first expression in body is a literal string, will use that as the1922 exception message."1923 {:added "1.0"}1924 [& body]1925 (let [message (when (string? (first body)) (first body))1926 body (if message (next body) body)]1927 `(if (clojure.lang.LockingTransaction/isRunning)1928 (throw (new IllegalStateException ~(or message "I/O in transaction")))1929 (do ~@body))))1931 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; fn stuff ;;;;;;;;;;;;;;;;1934 (defn comp1935 "Takes a set of functions and returns a fn that is the composition1936 of those fns. The returned fn takes a variable number of args,1937 applies the rightmost of fns to the args, the next1938 fn (right-to-left) to the result, etc."1939 {:added "1.0"}1940 ([f] f)1941 ([f g]1942 (fn1943 ([] (f (g)))1944 ([x] (f (g x)))1945 ([x y] (f (g x y)))1946 ([x y z] (f (g x y z)))1947 ([x y z & args] (f (apply g x y z args)))))1948 ([f g h]1949 (fn1950 ([] (f (g (h))))1951 ([x] (f (g (h x))))1952 ([x y] (f (g (h x y))))1953 ([x y z] (f (g (h x y z))))1954 ([x y z & args] (f (g (apply h x y z args))))))1955 ([f1 f2 f3 & fs]1956 (let [fs (reverse (list* f1 f2 f3 fs))]1957 (fn [& args]1958 (loop [ret (apply (first fs) args) fs (next fs)]1959 (if fs1960 (recur ((first fs) ret) (next fs))1961 ret))))))1963 (defn juxt1964 "Alpha - name subject to change.1965 Takes a set of functions and returns a fn that is the juxtaposition1966 of those fns. The returned fn takes a variable number of args, and1967 returns a vector containing the result of applying each fn to the1968 args (left-to-right).1969 ((juxt a b c) x) => [(a x) (b x) (c x)]"1970 {:added "1.1"}1971 ([f]1972 (fn1973 ([] [(f)])1974 ([x] [(f x)])1975 ([x y] [(f x y)])1976 ([x y z] [(f x y z)])1977 ([x y z & args] [(apply f x y z args)])))1978 ([f g]1979 (fn1980 ([] [(f) (g)])1981 ([x] [(f x) (g x)])1982 ([x y] [(f x y) (g x y)])1983 ([x y z] [(f x y z) (g x y z)])1984 ([x y z & args] [(apply f x y z args) (apply g x y z args)])))1985 ([f g h]1986 (fn1987 ([] [(f) (g) (h)])1988 ([x] [(f x) (g x) (h x)])1989 ([x y] [(f x y) (g x y) (h x y)])1990 ([x y z] [(f x y z) (g x y z) (h x y z)])1991 ([x y z & args] [(apply f x y z args) (apply g x y z args) (apply h x y z args)])))1992 ([f g h & fs]1993 (let [fs (list* f g h fs)]1994 (fn1995 ([] (reduce #(conj %1 (%2)) [] fs))1996 ([x] (reduce #(conj %1 (%2 x)) [] fs))1997 ([x y] (reduce #(conj %1 (%2 x y)) [] fs))1998 ([x y z] (reduce #(conj %1 (%2 x y z)) [] fs))1999 ([x y z & args] (reduce #(conj %1 (apply %2 x y z args)) [] fs))))))2001 (defn partial2002 "Takes a function f and fewer than the normal arguments to f, and2003 returns a fn that takes a variable number of additional args. When2004 called, the returned function calls f with args + additional args."2005 {:added "1.0"}2006 ([f arg1]2007 (fn [& args] (apply f arg1 args)))2008 ([f arg1 arg2]2009 (fn [& args] (apply f arg1 arg2 args)))2010 ([f arg1 arg2 arg3]2011 (fn [& args] (apply f arg1 arg2 arg3 args)))2012 ([f arg1 arg2 arg3 & more]2013 (fn [& args] (apply f arg1 arg2 arg3 (concat more args)))))2015 ;;;;;;;;;;;;;;;;;;; sequence fns ;;;;;;;;;;;;;;;;;;;;;;;2016 (defn sequence2017 "Coerces coll to a (possibly empty) sequence, if it is not already2018 one. Will not force a lazy seq. (sequence nil) yields ()"2019 {:added "1.0"}2020 [coll]2021 (if (seq? coll) coll2022 (or (seq coll) ())))2024 (defn every?2025 "Returns true if (pred x) is logical true for every x in coll, else2026 false."2027 {:tag Boolean2028 :added "1.0"}2029 [pred coll]2030 (cond2031 (nil? (seq coll)) true2032 (pred (first coll)) (recur pred (next coll))2033 :else false))2035 (def2036 ^{:tag Boolean2037 :doc "Returns false if (pred x) is logical true for every x in2038 coll, else true."2039 :arglists '([pred coll])2040 :added "1.0"}2041 not-every? (comp not every?))2043 (defn some2044 "Returns the first logical true value of (pred x) for any x in coll,2045 else nil. One common idiom is to use a set as pred, for example2046 this will return :fred if :fred is in the sequence, otherwise nil:2047 (some #{:fred} coll)"2048 {:added "1.0"}2049 [pred coll]2050 (when (seq coll)2051 (or (pred (first coll)) (recur pred (next coll)))))2053 (def2054 ^{:tag Boolean2055 :doc "Returns false if (pred x) is logical true for any x in coll,2056 else true."2057 :arglists '([pred coll])2058 :added "1.0"}2059 not-any? (comp not some))2061 ;will be redefed later with arg checks2062 (defmacro dotimes2063 "bindings => name n2065 Repeatedly executes body (presumably for side-effects) with name2066 bound to integers from 0 through n-1."2067 {:added "1.0"}2068 [bindings & body]2069 (let [i (first bindings)2070 n (second bindings)]2071 `(let [n# (int ~n)]2072 (loop [~i (int 0)]2073 (when (< ~i n#)2074 ~@body2075 (recur (inc ~i)))))))2077 (defn map2078 "Returns a lazy sequence consisting of the result of applying f to the2079 set of first items of each coll, followed by applying f to the set2080 of second items in each coll, until any one of the colls is2081 exhausted. Any remaining items in other colls are ignored. Function2082 f should accept number-of-colls arguments."2083 {:added "1.0"}2084 ([f coll]2085 (lazy-seq2086 (when-let [s (seq coll)]2087 (if (chunked-seq? s)2088 (let [c (chunk-first s)2089 size (int (count c))2090 b (chunk-buffer size)]2091 (dotimes [i size]2092 (chunk-append b (f (.nth c i))))2093 (chunk-cons (chunk b) (map f (chunk-rest s))))2094 (cons (f (first s)) (map f (rest s)))))))2095 ([f c1 c2]2096 (lazy-seq2097 (let [s1 (seq c1) s2 (seq c2)]2098 (when (and s1 s2)2099 (cons (f (first s1) (first s2))2100 (map f (rest s1) (rest s2)))))))2101 ([f c1 c2 c3]2102 (lazy-seq2103 (let [s1 (seq c1) s2 (seq c2) s3 (seq c3)]2104 (when (and s1 s2 s3)2105 (cons (f (first s1) (first s2) (first s3))2106 (map f (rest s1) (rest s2) (rest s3)))))))2107 ([f c1 c2 c3 & colls]2108 (let [step (fn step [cs]2109 (lazy-seq2110 (let [ss (map seq cs)]2111 (when (every? identity ss)2112 (cons (map first ss) (step (map rest ss)))))))]2113 (map #(apply f %) (step (conj colls c3 c2 c1))))))2115 (defn mapcat2116 "Returns the result of applying concat to the result of applying map2117 to f and colls. Thus function f should return a collection."2118 {:added "1.0"}2119 [f & colls]2120 (apply concat (apply map f colls)))2122 (defn filter2123 "Returns a lazy sequence of the items in coll for which2124 (pred item) returns true. pred must be free of side-effects."2125 {:added "1.0"}2126 ([pred coll]2127 (lazy-seq2128 (when-let [s (seq coll)]2129 (if (chunked-seq? s)2130 (let [c (chunk-first s)2131 size (count c)2132 b (chunk-buffer size)]2133 (dotimes [i size]2134 (when (pred (.nth c i))2135 (chunk-append b (.nth c i))))2136 (chunk-cons (chunk b) (filter pred (chunk-rest s))))2137 (let [f (first s) r (rest s)]2138 (if (pred f)2139 (cons f (filter pred r))2140 (filter pred r))))))))2143 (defn remove2144 "Returns a lazy sequence of the items in coll for which2145 (pred item) returns false. pred must be free of side-effects."2146 {:added "1.0"}2147 [pred coll]2148 (filter (complement pred) coll))2150 (defn take2151 "Returns a lazy sequence of the first n items in coll, or all items if2152 there are fewer than n."2153 {:added "1.0"}2154 [n coll]2155 (lazy-seq2156 (when (pos? n)2157 (when-let [s (seq coll)]2158 (cons (first s) (take (dec n) (rest s)))))))2160 (defn take-while2161 "Returns a lazy sequence of successive items from coll while2162 (pred item) returns true. pred must be free of side-effects."2163 {:added "1.0"}2164 [pred coll]2165 (lazy-seq2166 (when-let [s (seq coll)]2167 (when (pred (first s))2168 (cons (first s) (take-while pred (rest s)))))))2170 (defn drop2171 "Returns a lazy sequence of all but the first n items in coll."2172 {:added "1.0"}2173 [n coll]2174 (let [step (fn [n coll]2175 (let [s (seq coll)]2176 (if (and (pos? n) s)2177 (recur (dec n) (rest s))2178 s)))]2179 (lazy-seq (step n coll))))2181 (defn drop-last2182 "Return a lazy sequence of all but the last n (default 1) items in coll"2183 {:added "1.0"}2184 ([s] (drop-last 1 s))2185 ([n s] (map (fn [x _] x) s (drop n s))))2187 (defn take-last2188 "Returns a seq of the last n items in coll. Depending on the type2189 of coll may be no better than linear time. For vectors, see also subvec."2190 {:added "1.1"}2191 [n coll]2192 (loop [s (seq coll), lead (seq (drop n coll))]2193 (if lead2194 (recur (next s) (next lead))2195 s)))2197 (defn drop-while2198 "Returns a lazy sequence of the items in coll starting from the first2199 item for which (pred item) returns nil."2200 {:added "1.0"}2201 [pred coll]2202 (let [step (fn [pred coll]2203 (let [s (seq coll)]2204 (if (and s (pred (first s)))2205 (recur pred (rest s))2206 s)))]2207 (lazy-seq (step pred coll))))2209 (defn cycle2210 "Returns a lazy (infinite!) sequence of repetitions of the items in coll."2211 {:added "1.0"}2212 [coll] (lazy-seq2213 (when-let [s (seq coll)]2214 (concat s (cycle s)))))2216 (defn split-at2217 "Returns a vector of [(take n coll) (drop n coll)]"2218 {:added "1.0"}2219 [n coll]2220 [(take n coll) (drop n coll)])2222 (defn split-with2223 "Returns a vector of [(take-while pred coll) (drop-while pred coll)]"2224 {:added "1.0"}2225 [pred coll]2226 [(take-while pred coll) (drop-while pred coll)])2228 (defn repeat2229 "Returns a lazy (infinite!, or length n if supplied) sequence of xs."2230 {:added "1.0"}2231 ([x] (lazy-seq (cons x (repeat x))))2232 ([n x] (take n (repeat x))))2234 (defn replicate2235 "Returns a lazy seq of n xs."2236 {:added "1.0"}2237 [n x] (take n (repeat x)))2239 (defn iterate2240 "Returns a lazy sequence of x, (f x), (f (f x)) etc. f must be free of side-effects"2241 {:added "1.0"}2242 [f x] (cons x (lazy-seq (iterate f (f x)))))2244 (defn range2245 "Returns a lazy seq of nums from start (inclusive) to end2246 (exclusive), by step, where start defaults to 0, step to 1, and end2247 to infinity."2248 {:added "1.0"}2249 ([] (range 0 Double/POSITIVE_INFINITY 1))2250 ([end] (range 0 end 1))2251 ([start end] (range start end 1))2252 ([start end step]2253 (lazy-seq2254 (let [b (chunk-buffer 32)2255 comp (if (pos? step) < >)]2256 (loop [i start]2257 (if (and (< (count b) 32)2258 (comp i end))2259 (do2260 (chunk-append b i)2261 (recur (+ i step)))2262 (chunk-cons (chunk b)2263 (when (comp i end)2264 (range i end step)))))))))2266 (defn merge2267 "Returns a map that consists of the rest of the maps conj-ed onto2268 the first. If a key occurs in more than one map, the mapping from2269 the latter (left-to-right) will be the mapping in the result."2270 {:added "1.0"}2271 [& maps]2272 (when (some identity maps)2273 (reduce #(conj (or %1 {}) %2) maps)))2275 (defn merge-with2276 "Returns a map that consists of the rest of the maps conj-ed onto2277 the first. If a key occurs in more than one map, the mapping(s)2278 from the latter (left-to-right) will be combined with the mapping in2279 the result by calling (f val-in-result val-in-latter)."2280 {:added "1.0"}2281 [f & maps]2282 (when (some identity maps)2283 (let [merge-entry (fn [m e]2284 (let [k (key e) v (val e)]2285 (if (contains? m k)2286 (assoc m k (f (get m k) v))2287 (assoc m k v))))2288 merge2 (fn [m1 m2]2289 (reduce merge-entry (or m1 {}) (seq m2)))]2290 (reduce merge2 maps))))2294 (defn zipmap2295 "Returns a map with the keys mapped to the corresponding vals."2296 {:added "1.0"}2297 [keys vals]2298 (loop [map {}2299 ks (seq keys)2300 vs (seq vals)]2301 (if (and ks vs)2302 (recur (assoc map (first ks) (first vs))2303 (next ks)2304 (next vs))2305 map)))2307 (defmacro declare2308 "defs the supplied var names with no bindings, useful for making forward declarations."2309 {:added "1.0"}2310 [& names] `(do ~@(map #(list 'def (vary-meta % assoc :declared true)) names)))2312 (defn line-seq2313 "Returns the lines of text from rdr as a lazy sequence of strings.2314 rdr must implement java.io.BufferedReader."2315 {:added "1.0"}2316 [^java.io.BufferedReader rdr]2317 (when-let [line (.readLine rdr)]2318 (cons line (lazy-seq (line-seq rdr)))))2320 (defn comparator2321 "Returns an implementation of java.util.Comparator based upon pred."2322 {:added "1.0"}2323 [pred]2324 (fn [x y]2325 (cond (pred x y) -1 (pred y x) 1 :else 0)))2327 (defn sort2328 "Returns a sorted sequence of the items in coll. If no comparator is2329 supplied, uses compare. comparator must2330 implement java.util.Comparator."2331 {:added "1.0"}2332 ([coll]2333 (sort compare coll))2334 ([^java.util.Comparator comp coll]2335 (if (seq coll)2336 (let [a (to-array coll)]2337 (. java.util.Arrays (sort a comp))2338 (seq a))2339 ())))2341 (defn sort-by2342 "Returns a sorted sequence of the items in coll, where the sort2343 order is determined by comparing (keyfn item). If no comparator is2344 supplied, uses compare. comparator must2345 implement java.util.Comparator."2346 {:added "1.0"}2347 ([keyfn coll]2348 (sort-by keyfn compare coll))2349 ([keyfn ^java.util.Comparator comp coll]2350 (sort (fn [x y] (. comp (compare (keyfn x) (keyfn y)))) coll)))2352 (defn partition2353 "Returns a lazy sequence of lists of n items each, at offsets step2354 apart. If step is not supplied, defaults to n, i.e. the partitions2355 do not overlap. If a pad collection is supplied, use its elements as2356 necessary to complete last partition upto n items. In case there are2357 not enough padding elements, return a partition with less than n items."2358 {:added "1.0"}2359 ([n coll]2360 (partition n n coll))2361 ([n step coll]2362 (lazy-seq2363 (when-let [s (seq coll)]2364 (let [p (take n s)]2365 (when (= n (count p))2366 (cons p (partition n step (drop step s))))))))2367 ([n step pad coll]2368 (lazy-seq2369 (when-let [s (seq coll)]2370 (let [p (take n s)]2371 (if (= n (count p))2372 (cons p (partition n step pad (drop step s)))2373 (list (take n (concat p pad)))))))))2375 ;; evaluation2377 (defn eval2378 "Evaluates the form data structure (not text!) and returns the result."2379 {:added "1.0"}2380 [form] (. clojure.lang.Compiler (eval form)))2382 (defmacro doseq2383 "Repeatedly executes body (presumably for side-effects) with2384 bindings and filtering as provided by \"for\". Does not retain2385 the head of the sequence. Returns nil."2386 {:added "1.0"}2387 [seq-exprs & body]2388 (assert-args doseq2389 (vector? seq-exprs) "a vector for its binding"2390 (even? (count seq-exprs)) "an even number of forms in binding vector")2391 (let [step (fn step [recform exprs]2392 (if-not exprs2393 [true `(do ~@body)]2394 (let [k (first exprs)2395 v (second exprs)]2396 (if (keyword? k)2397 (let [steppair (step recform (nnext exprs))2398 needrec (steppair 0)2399 subform (steppair 1)]2400 (cond2401 (= k :let) [needrec `(let ~v ~subform)]2402 (= k :while) [false `(when ~v2403 ~subform2404 ~@(when needrec [recform]))]2405 (= k :when) [false `(if ~v2406 (do2407 ~subform2408 ~@(when needrec [recform]))2409 ~recform)]))2410 (let [seq- (gensym "seq_")2411 chunk- (with-meta (gensym "chunk_")2412 {:tag 'clojure.lang.IChunk})2413 count- (gensym "count_")2414 i- (gensym "i_")2415 recform `(recur (next ~seq-) nil (int 0) (int 0))2416 steppair (step recform (nnext exprs))2417 needrec (steppair 0)2418 subform (steppair 1)2419 recform-chunk2420 `(recur ~seq- ~chunk- ~count- (unchecked-inc ~i-))2421 steppair-chunk (step recform-chunk (nnext exprs))2422 subform-chunk (steppair-chunk 1)]2423 [true2424 `(loop [~seq- (seq ~v), ~chunk- nil,2425 ~count- (int 0), ~i- (int 0)]2426 (if (< ~i- ~count-)2427 (let [~k (.nth ~chunk- ~i-)]2428 ~subform-chunk2429 ~@(when needrec [recform-chunk]))2430 (when-let [~seq- (seq ~seq-)]2431 (if (chunked-seq? ~seq-)2432 (let [c# (chunk-first ~seq-)]2433 (recur (chunk-rest ~seq-) c#2434 (int (count c#)) (int 0)))2435 (let [~k (first ~seq-)]2436 ~subform2437 ~@(when needrec [recform]))))))])))))]2438 (nth (step nil (seq seq-exprs)) 1)))2440 (defn dorun2441 "When lazy sequences are produced via functions that have side2442 effects, any effects other than those needed to produce the first2443 element in the seq do not occur until the seq is consumed. dorun can2444 be used to force any effects. Walks through the successive nexts of2445 the seq, does not retain the head and returns nil."2446 {:added "1.0"}2447 ([coll]2448 (when (seq coll)2449 (recur (next coll))))2450 ([n coll]2451 (when (and (seq coll) (pos? n))2452 (recur (dec n) (next coll)))))2454 (defn doall2455 "When lazy sequences are produced via functions that have side2456 effects, any effects other than those needed to produce the first2457 element in the seq do not occur until the seq is consumed. doall can2458 be used to force any effects. Walks through the successive nexts of2459 the seq, retains the head and returns it, thus causing the entire2460 seq to reside in memory at one time."2461 {:added "1.0"}2462 ([coll]2463 (dorun coll)2464 coll)2465 ([n coll]2466 (dorun n coll)2467 coll))2469 (defn await2470 "Blocks the current thread (indefinitely!) until all actions2471 dispatched thus far, from this thread or agent, to the agent(s) have2472 occurred. Will block on failed agents. Will never return if2473 a failed agent is restarted with :clear-actions true."2474 {:added "1.0"}2475 [& agents]2476 (io! "await in transaction"2477 (when *agent*2478 (throw (new Exception "Can't await in agent action")))2479 (let [latch (new java.util.concurrent.CountDownLatch (count agents))2480 count-down (fn [agent] (. latch (countDown)) agent)]2481 (doseq [agent agents]2482 (send agent count-down))2483 (. latch (await)))))2485 (defn await1 [^clojure.lang.Agent a]2486 (when (pos? (.getQueueCount a))2487 (await a))2488 a)2490 (defn await-for2491 "Blocks the current thread until all actions dispatched thus2492 far (from this thread or agent) to the agents have occurred, or the2493 timeout (in milliseconds) has elapsed. Returns nil if returning due2494 to timeout, non-nil otherwise."2495 {:added "1.0"}2496 [timeout-ms & agents]2497 (io! "await-for in transaction"2498 (when *agent*2499 (throw (new Exception "Can't await in agent action")))2500 (let [latch (new java.util.concurrent.CountDownLatch (count agents))2501 count-down (fn [agent] (. latch (countDown)) agent)]2502 (doseq [agent agents]2503 (send agent count-down))2504 (. latch (await timeout-ms (. java.util.concurrent.TimeUnit MILLISECONDS))))))2506 (defmacro dotimes2507 "bindings => name n2509 Repeatedly executes body (presumably for side-effects) with name2510 bound to integers from 0 through n-1."2511 {:added "1.0"}2512 [bindings & body]2513 (assert-args dotimes2514 (vector? bindings) "a vector for its binding"2515 (= 2 (count bindings)) "exactly 2 forms in binding vector")2516 (let [i (first bindings)2517 n (second bindings)]2518 `(let [n# (int ~n)]2519 (loop [~i (int 0)]2520 (when (< ~i n#)2521 ~@body2522 (recur (unchecked-inc ~i)))))))2524 #_(defn into2525 "Returns a new coll consisting of to-coll with all of the items of2526 from-coll conjoined."2527 {:added "1.0"}2528 [to from]2529 (let [ret to items (seq from)]2530 (if items2531 (recur (conj ret (first items)) (next items))2532 ret)))2534 ;;;;;;;;;;;;;;;;;;;;; editable collections ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;2535 (defn transient2536 "Alpha - subject to change.2537 Returns a new, transient version of the collection, in constant time."2538 {:added "1.1"}2539 [^clojure.lang.IEditableCollection coll]2540 (.asTransient coll))2542 (defn persistent!2543 "Alpha - subject to change.2544 Returns a new, persistent version of the transient collection, in2545 constant time. The transient collection cannot be used after this2546 call, any such use will throw an exception."2547 {:added "1.1"}2548 [^clojure.lang.ITransientCollection coll]2549 (.persistent coll))2551 (defn conj!2552 "Alpha - subject to change.2553 Adds x to the transient collection, and return coll. The 'addition'2554 may happen at different 'places' depending on the concrete type."2555 {:added "1.1"}2556 [^clojure.lang.ITransientCollection coll x]2557 (.conj coll x))2559 (defn assoc!2560 "Alpha - subject to change.2561 When applied to a transient map, adds mapping of key(s) to2562 val(s). When applied to a transient vector, sets the val at index.2563 Note - index must be <= (count vector). Returns coll."2564 {:added "1.1"}2565 ([^clojure.lang.ITransientAssociative coll key val] (.assoc coll key val))2566 ([^clojure.lang.ITransientAssociative coll key val & kvs]2567 (let [ret (.assoc coll key val)]2568 (if kvs2569 (recur ret (first kvs) (second kvs) (nnext kvs))2570 ret))))2572 (defn dissoc!2573 "Alpha - subject to change.2574 Returns a transient map that doesn't contain a mapping for key(s)."2575 {:added "1.1"}2576 ([^clojure.lang.ITransientMap map key] (.without map key))2577 ([^clojure.lang.ITransientMap map key & ks]2578 (let [ret (.without map key)]2579 (if ks2580 (recur ret (first ks) (next ks))2581 ret))))2583 (defn pop!2584 "Alpha - subject to change.2585 Removes the last item from a transient vector. If2586 the collection is empty, throws an exception. Returns coll"2587 {:added "1.1"}2588 [^clojure.lang.ITransientVector coll]2589 (.pop coll))2591 (defn disj!2592 "Alpha - subject to change.2593 disj[oin]. Returns a transient set of the same (hashed/sorted) type, that2594 does not contain key(s)."2595 {:added "1.1"}2596 ([set] set)2597 ([^clojure.lang.ITransientSet set key]2598 (. set (disjoin key)))2599 ([set key & ks]2600 (let [ret (disj set key)]2601 (if ks2602 (recur ret (first ks) (next ks))2603 ret))))2605 ;redef into with batch support2606 (defn into2607 "Returns a new coll consisting of to-coll with all of the items of2608 from-coll conjoined."2609 {:added "1.0"}2610 [to from]2611 (if (instance? clojure.lang.IEditableCollection to)2612 (persistent! (reduce conj! (transient to) from))2613 (reduce conj to from)))2615 (defmacro import2616 "import-list => (package-symbol class-name-symbols*)2618 For each name in class-name-symbols, adds a mapping from name to the2619 class named by package.name to the current namespace. Use :import in the ns2620 macro in preference to calling this directly."2621 {:added "1.0"}2622 [& import-symbols-or-lists]2623 (let [specs (map #(if (and (seq? %) (= 'quote (first %))) (second %) %)2624 import-symbols-or-lists)]2625 `(do ~@(map #(list 'clojure.core/import* %)2626 (reduce (fn [v spec]2627 (if (symbol? spec)2628 (conj v (name spec))2629 (let [p (first spec) cs (rest spec)]2630 (into v (map #(str p "." %) cs)))))2631 [] specs)))))2633 (defn into-array2634 "Returns an array with components set to the values in aseq. The array's2635 component type is type if provided, or the type of the first value in2636 aseq if present, or Object. All values in aseq must be compatible with2637 the component type. Class objects for the primitive types can be obtained2638 using, e.g., Integer/TYPE."2639 {:added "1.0"}2640 ([aseq]2641 (clojure.lang.RT/seqToTypedArray (seq aseq)))2642 ([type aseq]2643 (clojure.lang.RT/seqToTypedArray type (seq aseq))))2645 (defn ^{:private true}2646 array [& items]2647 (into-array items))2649 (defn ^Class class2650 "Returns the Class of x"2651 {:added "1.0"}2652 [^Object x] (if (nil? x) x (. x (getClass))))2654 (defn type2655 "Returns the :type metadata of x, or its Class if none"2656 {:added "1.0"}2657 [x]2658 (or (:type (meta x)) (class x)))2660 (defn num2661 "Coerce to Number"2662 {:tag Number2663 :inline (fn [x] `(. clojure.lang.Numbers (num ~x)))2664 :added "1.0"}2665 [x] (. clojure.lang.Numbers (num x)))2667 (defn long2668 "Coerce to long"2669 {:tag Long2670 :inline (fn [x] `(. clojure.lang.RT (longCast ~x)))2671 :added "1.0"}2672 [^Number x] (clojure.lang.RT/longCast x))2674 (defn float2675 "Coerce to float"2676 {:tag Float2677 :inline (fn [x] `(. clojure.lang.RT (floatCast ~x)))2678 :added "1.0"}2679 [^Number x] (clojure.lang.RT/floatCast x))2681 (defn double2682 "Coerce to double"2683 {:tag Double2684 :inline (fn [x] `(. clojure.lang.RT (doubleCast ~x)))2685 :added "1.0"}2686 [^Number x] (clojure.lang.RT/doubleCast x))2688 (defn short2689 "Coerce to short"2690 {:tag Short2691 :inline (fn [x] `(. clojure.lang.RT (shortCast ~x)))2692 :added "1.0"}2693 [^Number x] (clojure.lang.RT/shortCast x))2695 (defn byte2696 "Coerce to byte"2697 {:tag Byte2698 :inline (fn [x] `(. clojure.lang.RT (byteCast ~x)))2699 :added "1.0"}2700 [^Number x] (clojure.lang.RT/byteCast x))2702 (defn char2703 "Coerce to char"2704 {:tag Character2705 :inline (fn [x] `(. clojure.lang.RT (charCast ~x)))2706 :added "1.1"}2707 [x] (. clojure.lang.RT (charCast x)))2709 (defn boolean2710 "Coerce to boolean"2711 {2712 :inline (fn [x] `(. clojure.lang.RT (booleanCast ~x)))2713 :added "1.0"}2714 [x] (clojure.lang.RT/booleanCast x))2716 (defn number?2717 "Returns true if x is a Number"2718 {:added "1.0"}2719 [x]2720 (instance? Number x))2722 (defn integer?2723 "Returns true if n is an integer"2724 {:added "1.0"}2725 [n]2726 (or (instance? Integer n)2727 (instance? Long n)2728 (instance? BigInteger n)2729 (instance? Short n)2730 (instance? Byte n)))2732 (defn mod2733 "Modulus of num and div. Truncates toward negative infinity."2734 {:added "1.0"}2735 [num div]2736 (let [m (rem num div)]2737 (if (or (zero? m) (pos? (* num div)))2738 m2739 (+ m div))))2741 (defn ratio?2742 "Returns true if n is a Ratio"2743 {:added "1.0"}2744 [n] (instance? clojure.lang.Ratio n))2746 (defn numerator2747 "Returns the numerator part of a Ratio."2748 {:tag BigInteger2749 :added "1.2"}2750 [r]2751 (.numerator ^clojure.lang.Ratio r))2753 (defn denominator2754 "Returns the denominator part of a Ratio."2755 {:tag BigInteger2756 :added "1.2"}2757 [r]2758 (.denominator ^clojure.lang.Ratio r))2760 (defn decimal?2761 "Returns true if n is a BigDecimal"2762 {:added "1.0"}2763 [n] (instance? BigDecimal n))2765 (defn float?2766 "Returns true if n is a floating point number"2767 {:added "1.0"}2768 [n]2769 (or (instance? Double n)2770 (instance? Float n)))2772 (defn rational? [n]2773 "Returns true if n is a rational number"2774 {:added "1.0"}2775 (or (integer? n) (ratio? n) (decimal? n)))2777 (defn bigint2778 "Coerce to BigInteger"2779 {:tag BigInteger2780 :added "1.0"}2781 [x] (cond2782 (instance? BigInteger x) x2783 (decimal? x) (.toBigInteger ^BigDecimal x)2784 (ratio? x) (.bigIntegerValue ^clojure.lang.Ratio x)2785 (number? x) (BigInteger/valueOf (long x))2786 :else (BigInteger. x)))2788 (defn bigdec2789 "Coerce to BigDecimal"2790 {:tag BigDecimal2791 :added "1.0"}2792 [x] (cond2793 (decimal? x) x2794 (float? x) (. BigDecimal valueOf (double x))2795 (ratio? x) (/ (BigDecimal. (.numerator x)) (.denominator x))2796 (instance? BigInteger x) (BigDecimal. ^BigInteger x)2797 (number? x) (BigDecimal/valueOf (long x))2798 :else (BigDecimal. x)))2800 (def ^{:private true} print-initialized false)2802 (defmulti print-method (fn [x writer] (type x)))2803 (defmulti print-dup (fn [x writer] (class x)))2805 (defn pr-on2806 {:private true}2807 [x w]2808 (if *print-dup*2809 (print-dup x w)2810 (print-method x w))2811 nil)2813 (defn pr2814 "Prints the object(s) to the output stream that is the current value2815 of *out*. Prints the object(s), separated by spaces if there is2816 more than one. By default, pr and prn print in a way that objects2817 can be read by the reader"2818 {:dynamic true2819 :added "1.0"}2820 ([] nil)2821 ([x]2822 (pr-on x *out*))2823 ([x & more]2824 (pr x)2825 (. *out* (append \space))2826 (if-let [nmore (next more)]2827 (recur (first more) nmore)2828 (apply pr more))))2830 (defn newline2831 "Writes a newline to the output stream that is the current value of2832 *out*"2833 {:added "1.0"}2834 []2835 (. *out* (append \newline))2836 nil)2838 (defn flush2839 "Flushes the output stream that is the current value of2840 *out*"2841 {:added "1.0"}2842 []2843 (. *out* (flush))2844 nil)2846 (defn prn2847 "Same as pr followed by (newline). Observes *flush-on-newline*"2848 {:added "1.0"}2849 [& more]2850 (apply pr more)2851 (newline)2852 (when *flush-on-newline*2853 (flush)))2855 (defn print2856 "Prints the object(s) to the output stream that is the current value2857 of *out*. print and println produce output for human consumption."2858 {:added "1.0"}2859 [& more]2860 (binding [*print-readably* nil]2861 (apply pr more)))2863 (defn println2864 "Same as print followed by (newline)"2865 {:added "1.0"}2866 [& more]2867 (binding [*print-readably* nil]2868 (apply prn more)))2870 (defn read2871 "Reads the next object from stream, which must be an instance of2872 java.io.PushbackReader or some derivee. stream defaults to the2873 current value of *in* ."2874 {:added "1.0"}2875 ([]2876 (read *in*))2877 ([stream]2878 (read stream true nil))2879 ([stream eof-error? eof-value]2880 (read stream eof-error? eof-value false))2881 ([stream eof-error? eof-value recursive?]2882 (. clojure.lang.LispReader (read stream (boolean eof-error?) eof-value recursive?))))2884 (defn read-line2885 "Reads the next line from stream that is the current value of *in* ."2886 {:added "1.0"}2887 []2888 (if (instance? clojure.lang.LineNumberingPushbackReader *in*)2889 (.readLine ^clojure.lang.LineNumberingPushbackReader *in*)2890 (.readLine ^java.io.BufferedReader *in*)))2892 (defn read-string2893 "Reads one object from the string s"2894 {:added "1.0"}2895 [s] (clojure.lang.RT/readString s))2897 (defn subvec2898 "Returns a persistent vector of the items in vector from2899 start (inclusive) to end (exclusive). If end is not supplied,2900 defaults to (count vector). This operation is O(1) and very fast, as2901 the resulting vector shares structure with the original and no2902 trimming is done."2903 {:added "1.0"}2904 ([v start]2905 (subvec v start (count v)))2906 ([v start end]2907 (. clojure.lang.RT (subvec v start end))))2909 (defmacro with-open2910 "bindings => [name init ...]2912 Evaluates body in a try expression with names bound to the values2913 of the inits, and a finally clause that calls (.close name) on each2914 name in reverse order."2915 {:added "1.0"}2916 [bindings & body]2917 (assert-args with-open2918 (vector? bindings) "a vector for its binding"2919 (even? (count bindings)) "an even number of forms in binding vector")2920 (cond2921 (= (count bindings) 0) `(do ~@body)2922 (symbol? (bindings 0)) `(let ~(subvec bindings 0 2)2923 (try2924 (with-open ~(subvec bindings 2) ~@body)2925 (finally2926 (. ~(bindings 0) close))))2927 :else (throw (IllegalArgumentException.2928 "with-open only allows Symbols in bindings"))))2930 (defmacro doto2931 "Evaluates x then calls all of the methods and functions with the2932 value of x supplied at the front of the given arguments. The forms2933 are evaluated in order. Returns x.2935 (doto (new java.util.HashMap) (.put \"a\" 1) (.put \"b\" 2))"2936 {:added "1.0"}2937 [x & forms]2938 (let [gx (gensym)]2939 `(let [~gx ~x]2940 ~@(map (fn [f]2941 (if (seq? f)2942 `(~(first f) ~gx ~@(next f))2943 `(~f ~gx)))2944 forms)2945 ~gx)))2947 (defmacro memfn2948 "Expands into code that creates a fn that expects to be passed an2949 object and any args and calls the named instance method on the2950 object passing the args. Use when you want to treat a Java method as2951 a first-class fn."2952 {:added "1.0"}2953 [name & args]2954 `(fn [target# ~@args]2955 (. target# (~name ~@args))))2957 (defmacro time2958 "Evaluates expr and prints the time it took. Returns the value of2959 expr."2960 {:added "1.0"}2961 [expr]2962 `(let [start# (. System (nanoTime))2963 ret# ~expr]2964 (prn (str "Elapsed time: " (/ (double (- (. System (nanoTime)) start#)) 1000000.0) " msecs"))2965 ret#))2969 (import '(java.lang.reflect Array))2971 (defn alength2972 "Returns the length of the Java array. Works on arrays of all2973 types."2974 {:inline (fn [a] `(. clojure.lang.RT (alength ~a)))2975 :added "1.0"}2976 [array] (. clojure.lang.RT (alength array)))2978 (defn aclone2979 "Returns a clone of the Java array. Works on arrays of known2980 types."2981 {:inline (fn [a] `(. clojure.lang.RT (aclone ~a)))2982 :added "1.0"}2983 [array] (. clojure.lang.RT (aclone array)))2985 (defn aget2986 "Returns the value at the index/indices. Works on Java arrays of all2987 types."2988 {:inline (fn [a i] `(. clojure.lang.RT (aget ~a (int ~i))))2989 :inline-arities #{2}2990 :added "1.0"}2991 ([array idx]2992 (clojure.lang.Reflector/prepRet (. Array (get array idx))))2993 ([array idx & idxs]2994 (apply aget (aget array idx) idxs)))2996 (defn aset2997 "Sets the value at the index/indices. Works on Java arrays of2998 reference types. Returns val."2999 {:inline (fn [a i v] `(. clojure.lang.RT (aset ~a (int ~i) ~v)))3000 :inline-arities #{3}3001 :added "1.0"}3002 ([array idx val]3003 (. Array (set array idx val))3004 val)3005 ([array idx idx2 & idxv]3006 (apply aset (aget array idx) idx2 idxv)))3008 (defmacro3009 ^{:private true}3010 def-aset [name method coerce]3011 `(defn ~name3012 {:arglists '([~'array ~'idx ~'val] [~'array ~'idx ~'idx2 & ~'idxv])}3013 ([array# idx# val#]3014 (. Array (~method array# idx# (~coerce val#)))3015 val#)3016 ([array# idx# idx2# & idxv#]3017 (apply ~name (aget array# idx#) idx2# idxv#))))3019 (def-aset3020 ^{:doc "Sets the value at the index/indices. Works on arrays of int. Returns val."3021 :added "1.0"}3022 aset-int setInt int)3024 (def-aset3025 ^{:doc "Sets the value at the index/indices. Works on arrays of long. Returns val."3026 :added "1.0"}3027 aset-long setLong long)3029 (def-aset3030 ^{:doc "Sets the value at the index/indices. Works on arrays of boolean. Returns val."3031 :added "1.0"}3032 aset-boolean setBoolean boolean)3034 (def-aset3035 ^{:doc "Sets the value at the index/indices. Works on arrays of float. Returns val."3036 :added "1.0"}3037 aset-float setFloat float)3039 (def-aset3040 ^{:doc "Sets the value at the index/indices. Works on arrays of double. Returns val."3041 :added "1.0"}3042 aset-double setDouble double)3044 (def-aset3045 ^{:doc "Sets the value at the index/indices. Works on arrays of short. Returns val."3046 :added "1.0"}3047 aset-short setShort short)3049 (def-aset3050 ^{:doc "Sets the value at the index/indices. Works on arrays of byte. Returns val."3051 :added "1.0"}3052 aset-byte setByte byte)3054 (def-aset3055 ^{:doc "Sets the value at the index/indices. Works on arrays of char. Returns val."3056 :added "1.0"}3057 aset-char setChar char)3059 (defn make-array3060 "Creates and returns an array of instances of the specified class of3061 the specified dimension(s). Note that a class object is required.3062 Class objects can be obtained by using their imported or3063 fully-qualified name. Class objects for the primitive types can be3064 obtained using, e.g., Integer/TYPE."3065 {:added "1.0"}3066 ([^Class type len]3067 (. Array (newInstance type (int len))))3068 ([^Class type dim & more-dims]3069 (let [dims (cons dim more-dims)3070 ^"[I" dimarray (make-array (. Integer TYPE) (count dims))]3071 (dotimes [i (alength dimarray)]3072 (aset-int dimarray i (nth dims i)))3073 (. Array (newInstance type dimarray)))))3075 (defn to-array-2d3076 "Returns a (potentially-ragged) 2-dimensional array of Objects3077 containing the contents of coll, which can be any Collection of any3078 Collection."3079 {:tag "[[Ljava.lang.Object;"3080 :added "1.0"}3081 [^java.util.Collection coll]3082 (let [ret (make-array (. Class (forName "[Ljava.lang.Object;")) (. coll (size)))]3083 (loop [i 0 xs (seq coll)]3084 (when xs3085 (aset ret i (to-array (first xs)))3086 (recur (inc i) (next xs))))3087 ret))3089 (defn macroexpand-13090 "If form represents a macro form, returns its expansion,3091 else returns form."3092 {:added "1.0"}3093 [form]3094 (. clojure.lang.Compiler (macroexpand1 form)))3096 (defn macroexpand3097 "Repeatedly calls macroexpand-1 on form until it no longer3098 represents a macro form, then returns it. Note neither3099 macroexpand-1 nor macroexpand expand macros in subforms."3100 {:added "1.0"}3101 [form]3102 (let [ex (macroexpand-1 form)]3103 (if (identical? ex form)3104 form3105 (macroexpand ex))))3107 (defn create-struct3108 "Returns a structure basis object."3109 {:added "1.0"}3110 [& keys]3111 (. clojure.lang.PersistentStructMap (createSlotMap keys)))3113 (defmacro defstruct3114 "Same as (def name (create-struct keys...))"3115 {:added "1.0"}3116 [name & keys]3117 `(def ~name (create-struct ~@keys)))3119 (defn struct-map3120 "Returns a new structmap instance with the keys of the3121 structure-basis. keyvals may contain all, some or none of the basis3122 keys - where values are not supplied they will default to nil.3123 keyvals can also contain keys not in the basis."3124 {:added "1.0"}3125 [s & inits]3126 (. clojure.lang.PersistentStructMap (create s inits)))3128 (defn struct3129 "Returns a new structmap instance with the keys of the3130 structure-basis. vals must be supplied for basis keys in order -3131 where values are not supplied they will default to nil."3132 {:added "1.0"}3133 [s & vals]3134 (. clojure.lang.PersistentStructMap (construct s vals)))3136 (defn accessor3137 "Returns a fn that, given an instance of a structmap with the basis,3138 returns the value at the key. The key must be in the basis. The3139 returned function should be (slightly) more efficient than using3140 get, but such use of accessors should be limited to known3141 performance-critical areas."3142 {:added "1.0"}3143 [s key]3144 (. clojure.lang.PersistentStructMap (getAccessor s key)))3146 (defn load-reader3147 "Sequentially read and evaluate the set of forms contained in the3148 stream/file"3149 {:added "1.0"}3150 [rdr] (. clojure.lang.Compiler (load rdr)))3152 (defn load-string3153 "Sequentially read and evaluate the set of forms contained in the3154 string"3155 {:added "1.0"}3156 [s]3157 (let [rdr (-> (java.io.StringReader. s)3158 (clojure.lang.LineNumberingPushbackReader.))]3159 (load-reader rdr)))3161 (defn set3162 "Returns a set of the distinct elements of coll."3163 {:added "1.0"}3164 [coll] (clojure.lang.PersistentHashSet/create ^clojure.lang.ISeq (seq coll)))3166 (defn ^{:private true}3167 filter-key [keyfn pred amap]3168 (loop [ret {} es (seq amap)]3169 (if es3170 (if (pred (keyfn (first es)))3171 (recur (assoc ret (key (first es)) (val (first es))) (next es))3172 (recur ret (next es)))3173 ret)))3175 (defn find-ns3176 "Returns the namespace named by the symbol or nil if it doesn't exist."3177 {:added "1.0"}3178 [sym] (clojure.lang.Namespace/find sym))3180 (defn create-ns3181 "Create a new namespace named by the symbol if one doesn't already3182 exist, returns it or the already-existing namespace of the same3183 name."3184 {:added "1.0"}3185 [sym] (clojure.lang.Namespace/findOrCreate sym))3187 (defn remove-ns3188 "Removes the namespace named by the symbol. Use with caution.3189 Cannot be used to remove the clojure namespace."3190 {:added "1.0"}3191 [sym] (clojure.lang.Namespace/remove sym))3193 (defn all-ns3194 "Returns a sequence of all namespaces."3195 {:added "1.0"}3196 [] (clojure.lang.Namespace/all))3198 (defn ^clojure.lang.Namespace the-ns3199 "If passed a namespace, returns it. Else, when passed a symbol,3200 returns the namespace named by it, throwing an exception if not3201 found."3202 {:added "1.0"}3203 [x]3204 (if (instance? clojure.lang.Namespace x)3205 x3206 (or (find-ns x) (throw (Exception. (str "No namespace: " x " found"))))))3208 (defn ns-name3209 "Returns the name of the namespace, a symbol."3210 {:added "1.0"}3211 [ns]3212 (.getName (the-ns ns)))3214 (defn ns-map3215 "Returns a map of all the mappings for the namespace."3216 {:added "1.0"}3217 [ns]3218 (.getMappings (the-ns ns)))3220 (defn ns-unmap3221 "Removes the mappings for the symbol from the namespace."3222 {:added "1.0"}3223 [ns sym]3224 (.unmap (the-ns ns) sym))3226 ;(defn export [syms]3227 ; (doseq [sym syms]3228 ; (.. *ns* (intern sym) (setExported true))))3230 (defn ns-publics3231 "Returns a map of the public intern mappings for the namespace."3232 {:added "1.0"}3233 [ns]3234 (let [ns (the-ns ns)]3235 (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v)3236 (= ns (.ns v))3237 (.isPublic v)))3238 (ns-map ns))))3240 (defn ns-imports3241 "Returns a map of the import mappings for the namespace."3242 {:added "1.0"}3243 [ns]3244 (filter-key val (partial instance? Class) (ns-map ns)))3246 (defn ns-interns3247 "Returns a map of the intern mappings for the namespace."3248 {:added "1.0"}3249 [ns]3250 (let [ns (the-ns ns)]3251 (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v)3252 (= ns (.ns v))))3253 (ns-map ns))))3255 (defn refer3256 "refers to all public vars of ns, subject to filters.3257 filters can include at most one each of:3259 :exclude list-of-symbols3260 :only list-of-symbols3261 :rename map-of-fromsymbol-tosymbol3263 For each public interned var in the namespace named by the symbol,3264 adds a mapping from the name of the var to the var to the current3265 namespace. Throws an exception if name is already mapped to3266 something else in the current namespace. Filters can be used to3267 select a subset, via inclusion or exclusion, or to provide a mapping3268 to a symbol different from the var's name, in order to prevent3269 clashes. Use :use in the ns macro in preference to calling this directly."3270 {:added "1.0"}3271 [ns-sym & filters]3272 (let [ns (or (find-ns ns-sym) (throw (new Exception (str "No namespace: " ns-sym))))3273 fs (apply hash-map filters)3274 nspublics (ns-publics ns)3275 rename (or (:rename fs) {})3276 exclude (set (:exclude fs))3277 to-do (or (:only fs) (keys nspublics))]3278 (doseq [sym to-do]3279 (when-not (exclude sym)3280 (let [v (nspublics sym)]3281 (when-not v3282 (throw (new java.lang.IllegalAccessError3283 (if (get (ns-interns ns) sym)3284 (str sym " is not public")3285 (str sym " does not exist")))))3286 (. *ns* (refer (or (rename sym) sym) v)))))))3288 (defn ns-refers3289 "Returns a map of the refer mappings for the namespace."3290 {:added "1.0"}3291 [ns]3292 (let [ns (the-ns ns)]3293 (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v)3294 (not= ns (.ns v))))3295 (ns-map ns))))3297 (defn alias3298 "Add an alias in the current namespace to another3299 namespace. Arguments are two symbols: the alias to be used, and3300 the symbolic name of the target namespace. Use :as in the ns macro in preference3301 to calling this directly."3302 {:added "1.0"}3303 [alias namespace-sym]3304 (.addAlias *ns* alias (find-ns namespace-sym)))3306 (defn ns-aliases3307 "Returns a map of the aliases for the namespace."3308 {:added "1.0"}3309 [ns]3310 (.getAliases (the-ns ns)))3312 (defn ns-unalias3313 "Removes the alias for the symbol from the namespace."3314 {:added "1.0"}3315 [ns sym]3316 (.removeAlias (the-ns ns) sym))3318 (defn take-nth3319 "Returns a lazy seq of every nth item in coll."3320 {:added "1.0"}3321 [n coll]3322 (lazy-seq3323 (when-let [s (seq coll)]3324 (cons (first s) (take-nth n (drop n s))))))3326 (defn interleave3327 "Returns a lazy seq of the first item in each coll, then the second etc."3328 {:added "1.0"}3329 ([c1 c2]3330 (lazy-seq3331 (let [s1 (seq c1) s2 (seq c2)]3332 (when (and s1 s2)3333 (cons (first s1) (cons (first s2)3334 (interleave (rest s1) (rest s2))))))))3335 ([c1 c2 & colls]3336 (lazy-seq3337 (let [ss (map seq (conj colls c2 c1))]3338 (when (every? identity ss)3339 (concat (map first ss) (apply interleave (map rest ss))))))))3341 (defn var-get3342 "Gets the value in the var object"3343 {:added "1.0"}3344 [^clojure.lang.Var x] (. x (get)))3346 (defn var-set3347 "Sets the value in the var object to val. The var must be3348 thread-locally bound."3349 {:added "1.0"}3350 [^clojure.lang.Var x val] (. x (set val)))3352 (defmacro with-local-vars3353 "varbinding=> symbol init-expr3355 Executes the exprs in a context in which the symbols are bound to3356 vars with per-thread bindings to the init-exprs. The symbols refer3357 to the var objects themselves, and must be accessed with var-get and3358 var-set"3359 {:added "1.0"}3360 [name-vals-vec & body]3361 (assert-args with-local-vars3362 (vector? name-vals-vec) "a vector for its binding"3363 (even? (count name-vals-vec)) "an even number of forms in binding vector")3364 `(let [~@(interleave (take-nth 2 name-vals-vec)3365 (repeat '(. clojure.lang.Var (create))))]3366 (. clojure.lang.Var (pushThreadBindings (hash-map ~@name-vals-vec)))3367 (try3368 ~@body3369 (finally (. clojure.lang.Var (popThreadBindings))))))3371 (defn ns-resolve3372 "Returns the var or Class to which a symbol will be resolved in the3373 namespace, else nil. Note that if the symbol is fully qualified,3374 the var/Class to which it resolves need not be present in the3375 namespace."3376 {:added "1.0"}3377 [ns sym]3378 (clojure.lang.Compiler/maybeResolveIn (the-ns ns) sym))3380 (defn resolve3381 "same as (ns-resolve *ns* symbol)"3382 {:added "1.0"}3383 [sym] (ns-resolve *ns* sym))3385 (defn array-map3386 "Constructs an array-map."3387 {:added "1.0"}3388 ([] (. clojure.lang.PersistentArrayMap EMPTY))3389 ([& keyvals] (clojure.lang.PersistentArrayMap/createWithCheck (to-array keyvals))))3391 (defn nthnext3392 "Returns the nth next of coll, (seq coll) when n is 0."3393 {:added "1.0"}3394 [coll n]3395 (loop [n n xs (seq coll)]3396 (if (and xs (pos? n))3397 (recur (dec n) (next xs))3398 xs)))3401 ;redefine let and loop with destructuring3402 (defn destructure [bindings]3403 (let [bents (partition 2 bindings)3404 pb (fn pb [bvec b v]3405 (let [pvec3406 (fn [bvec b val]3407 (let [gvec (gensym "vec__")]3408 (loop [ret (-> bvec (conj gvec) (conj val))3409 n 03410 bs b3411 seen-rest? false]3412 (if (seq bs)3413 (let [firstb (first bs)]3414 (cond3415 (= firstb '&) (recur (pb ret (second bs) (list `nthnext gvec n))3416 n3417 (nnext bs)3418 true)3419 (= firstb :as) (pb ret (second bs) gvec)3420 :else (if seen-rest?3421 (throw (new Exception "Unsupported binding form, only :as can follow & parameter"))3422 (recur (pb ret firstb (list `nth gvec n nil))3423 (inc n)3424 (next bs)3425 seen-rest?))))3426 ret))))3427 pmap3428 (fn [bvec b v]3429 (let [gmap (or (:as b) (gensym "map__"))3430 defaults (:or b)]3431 (loop [ret (-> bvec (conj gmap) (conj v)3432 (conj gmap) (conj `(if (seq? ~gmap) (apply hash-map ~gmap) ~gmap)))3433 bes (reduce3434 (fn [bes entry]3435 (reduce #(assoc %1 %2 ((val entry) %2))3436 (dissoc bes (key entry))3437 ((key entry) bes)))3438 (dissoc b :as :or)3439 {:keys #(keyword (str %)), :strs str, :syms #(list `quote %)})]3440 (if (seq bes)3441 (let [bb (key (first bes))3442 bk (val (first bes))3443 has-default (contains? defaults bb)]3444 (recur (pb ret bb (if has-default3445 (list `get gmap bk (defaults bb))3446 (list `get gmap bk)))3447 (next bes)))3448 ret))))]3449 (cond3450 (symbol? b) (-> bvec (conj b) (conj v))3451 (vector? b) (pvec bvec b v)3452 (map? b) (pmap bvec b v)3453 :else (throw (new Exception (str "Unsupported binding form: " b))))))3454 process-entry (fn [bvec b] (pb bvec (first b) (second b)))]3455 (if (every? symbol? (map first bents))3456 bindings3457 (reduce process-entry [] bents))))3459 (defmacro let3460 "Evaluates the exprs in a lexical context in which the symbols in3461 the binding-forms are bound to their respective init-exprs or parts3462 therein."3463 {:added "1.0"}3464 [bindings & body]3465 (assert-args let3466 (vector? bindings) "a vector for its binding"3467 (even? (count bindings)) "an even number of forms in binding vector")3468 `(let* ~(destructure bindings) ~@body))3470 (defn ^{:private true}3471 maybe-destructured3472 [params body]3473 (if (every? symbol? params)3474 (cons params body)3475 (loop [params params3476 new-params []3477 lets []]3478 (if params3479 (if (symbol? (first params))3480 (recur (next params) (conj new-params (first params)) lets)3481 (let [gparam (gensym "p__")]3482 (recur (next params) (conj new-params gparam)3483 (-> lets (conj (first params)) (conj gparam)))))3484 `(~new-params3485 (let ~lets3486 ~@body))))))3488 ;redefine fn with destructuring and pre/post conditions3489 (defmacro fn3490 "(fn name? [params* ] exprs*)3491 (fn name? ([params* ] exprs*)+)3493 params => positional-params* , or positional-params* & next-param3494 positional-param => binding-form3495 next-param => binding-form3496 name => symbol3498 Defines a function"3499 {:added "1.0"}3500 [& sigs]3501 (let [name (if (symbol? (first sigs)) (first sigs) nil)3502 sigs (if name (next sigs) sigs)3503 sigs (if (vector? (first sigs)) (list sigs) sigs)3504 psig (fn* [sig]3505 (let [[params & body] sig3506 conds (when (and (next body) (map? (first body)))3507 (first body))3508 body (if conds (next body) body)3509 conds (or conds (meta params))3510 pre (:pre conds)3511 post (:post conds)3512 body (if post3513 `((let [~'% ~(if (< 1 (count body))3514 `(do ~@body)3515 (first body))]3516 ~@(map (fn* [c] `(assert ~c)) post)3517 ~'%))3518 body)3519 body (if pre3520 (concat (map (fn* [c] `(assert ~c)) pre)3521 body)3522 body)]3523 (maybe-destructured params body)))3524 new-sigs (map psig sigs)]3525 (with-meta3526 (if name3527 (list* 'fn* name new-sigs)3528 (cons 'fn* new-sigs))3529 (meta &form))))3531 (defmacro loop3532 "Evaluates the exprs in a lexical context in which the symbols in3533 the binding-forms are bound to their respective init-exprs or parts3534 therein. Acts as a recur target."3535 {:added "1.0"}3536 [bindings & body]3537 (assert-args loop3538 (vector? bindings) "a vector for its binding"3539 (even? (count bindings)) "an even number of forms in binding vector")3540 (let [db (destructure bindings)]3541 (if (= db bindings)3542 `(loop* ~bindings ~@body)3543 (let [vs (take-nth 2 (drop 1 bindings))3544 bs (take-nth 2 bindings)3545 gs (map (fn [b] (if (symbol? b) b (gensym))) bs)3546 bfs (reduce (fn [ret [b v g]]3547 (if (symbol? b)3548 (conj ret g v)3549 (conj ret g v b g)))3550 [] (map vector bs vs gs))]3551 `(let ~bfs3552 (loop* ~(vec (interleave gs gs))3553 (let ~(vec (interleave bs gs))3554 ~@body)))))))3556 (defmacro when-first3557 "bindings => x xs3559 Same as (when (seq xs) (let [x (first xs)] body))"3560 {:added "1.0"}3561 [bindings & body]3562 (assert-args when-first3563 (vector? bindings) "a vector for its binding"3564 (= 2 (count bindings)) "exactly 2 forms in binding vector")3565 (let [[x xs] bindings]3566 `(when (seq ~xs)3567 (let [~x (first ~xs)]3568 ~@body))))3570 (defmacro lazy-cat3571 "Expands to code which yields a lazy sequence of the concatenation3572 of the supplied colls. Each coll expr is not evaluated until it is3573 needed.3575 (lazy-cat xs ys zs) === (concat (lazy-seq xs) (lazy-seq ys) (lazy-seq zs))"3576 {:added "1.0"}3577 [& colls]3578 `(concat ~@(map #(list `lazy-seq %) colls)))3580 (defmacro for3581 "List comprehension. Takes a vector of one or more3582 binding-form/collection-expr pairs, each followed by zero or more3583 modifiers, and yields a lazy sequence of evaluations of expr.3584 Collections are iterated in a nested fashion, rightmost fastest,3585 and nested coll-exprs can refer to bindings created in prior3586 binding-forms. Supported modifiers are: :let [binding-form expr ...],3587 :while test, :when test.3589 (take 100 (for [x (range 100000000) y (range 1000000) :while (< y x)] [x y]))"3590 {:added "1.0"}3591 [seq-exprs body-expr]3592 (assert-args for3593 (vector? seq-exprs) "a vector for its binding"3594 (even? (count seq-exprs)) "an even number of forms in binding vector")3595 (let [to-groups (fn [seq-exprs]3596 (reduce (fn [groups [k v]]3597 (if (keyword? k)3598 (conj (pop groups) (conj (peek groups) [k v]))3599 (conj groups [k v])))3600 [] (partition 2 seq-exprs)))3601 err (fn [& msg] (throw (IllegalArgumentException. ^String (apply str msg))))3602 emit-bind (fn emit-bind [[[bind expr & mod-pairs]3603 & [[_ next-expr] :as next-groups]]]3604 (let [giter (gensym "iter__")3605 gxs (gensym "s__")3606 do-mod (fn do-mod [[[k v :as pair] & etc]]3607 (cond3608 (= k :let) `(let ~v ~(do-mod etc))3609 (= k :while) `(when ~v ~(do-mod etc))3610 (= k :when) `(if ~v3611 ~(do-mod etc)3612 (recur (rest ~gxs)))3613 (keyword? k) (err "Invalid 'for' keyword " k)3614 next-groups3615 `(let [iterys# ~(emit-bind next-groups)3616 fs# (seq (iterys# ~next-expr))]3617 (if fs#3618 (concat fs# (~giter (rest ~gxs)))3619 (recur (rest ~gxs))))3620 :else `(cons ~body-expr3621 (~giter (rest ~gxs)))))]3622 (if next-groups3623 #_"not the inner-most loop"3624 `(fn ~giter [~gxs]3625 (lazy-seq3626 (loop [~gxs ~gxs]3627 (when-first [~bind ~gxs]3628 ~(do-mod mod-pairs)))))3629 #_"inner-most loop"3630 (let [gi (gensym "i__")3631 gb (gensym "b__")3632 do-cmod (fn do-cmod [[[k v :as pair] & etc]]3633 (cond3634 (= k :let) `(let ~v ~(do-cmod etc))3635 (= k :while) `(when ~v ~(do-cmod etc))3636 (= k :when) `(if ~v3637 ~(do-cmod etc)3638 (recur3639 (unchecked-inc ~gi)))3640 (keyword? k)3641 (err "Invalid 'for' keyword " k)3642 :else3643 `(do (chunk-append ~gb ~body-expr)3644 (recur (unchecked-inc ~gi)))))]3645 `(fn ~giter [~gxs]3646 (lazy-seq3647 (loop [~gxs ~gxs]3648 (when-let [~gxs (seq ~gxs)]3649 (if (chunked-seq? ~gxs)3650 (let [c# (chunk-first ~gxs)3651 size# (int (count c#))3652 ~gb (chunk-buffer size#)]3653 (if (loop [~gi (int 0)]3654 (if (< ~gi size#)3655 (let [~bind (.nth c# ~gi)]3656 ~(do-cmod mod-pairs))3657 true))3658 (chunk-cons3659 (chunk ~gb)3660 (~giter (chunk-rest ~gxs)))3661 (chunk-cons (chunk ~gb) nil)))3662 (let [~bind (first ~gxs)]3663 ~(do-mod mod-pairs)))))))))))]3664 `(let [iter# ~(emit-bind (to-groups seq-exprs))]3665 (iter# ~(second seq-exprs)))))3667 (defmacro comment3668 "Ignores body, yields nil"3669 {:added "1.0"}3670 [& body])3672 (defmacro with-out-str3673 "Evaluates exprs in a context in which *out* is bound to a fresh3674 StringWriter. Returns the string created by any nested printing3675 calls."3676 {:added "1.0"}3677 [& body]3678 `(let [s# (new java.io.StringWriter)]3679 (binding [*out* s#]3680 ~@body3681 (str s#))))3683 (defmacro with-in-str3684 "Evaluates body in a context in which *in* is bound to a fresh3685 StringReader initialized with the string s."3686 {:added "1.0"}3687 [s & body]3688 `(with-open [s# (-> (java.io.StringReader. ~s) clojure.lang.LineNumberingPushbackReader.)]3689 (binding [*in* s#]3690 ~@body)))3692 (defn pr-str3693 "pr to a string, returning it"3694 {:tag String3695 :added "1.0"}3696 [& xs]3697 (with-out-str3698 (apply pr xs)))3700 (defn prn-str3701 "prn to a string, returning it"3702 {:tag String3703 :added "1.0"}3704 [& xs]3705 (with-out-str3706 (apply prn xs)))3708 (defn print-str3709 "print to a string, returning it"3710 {:tag String3711 :added "1.0"}3712 [& xs]3713 (with-out-str3714 (apply print xs)))3716 (defn println-str3717 "println to a string, returning it"3718 {:tag String3719 :added "1.0"}3720 [& xs]3721 (with-out-str3722 (apply println xs)))3724 (defmacro assert3725 "Evaluates expr and throws an exception if it does not evaluate to3726 logical true."3727 {:added "1.0"}3728 [x]3729 (when *assert*3730 `(when-not ~x3731 (throw (new AssertionError (str "Assert failed: " (pr-str '~x)))))))3733 (defn test3734 "test [v] finds fn at key :test in var metadata and calls it,3735 presuming failure will throw exception"3736 {:added "1.0"}3737 [v]3738 (let [f (:test (meta v))]3739 (if f3740 (do (f) :ok)3741 :no-test)))3743 (defn re-pattern3744 "Returns an instance of java.util.regex.Pattern, for use, e.g. in3745 re-matcher."3746 {:tag java.util.regex.Pattern3747 :added "1.0"}3748 [s] (if (instance? java.util.regex.Pattern s)3749 s3750 (. java.util.regex.Pattern (compile s))))3752 (defn re-matcher3753 "Returns an instance of java.util.regex.Matcher, for use, e.g. in3754 re-find."3755 {:tag java.util.regex.Matcher3756 :added "1.0"}3757 [^java.util.regex.Pattern re s]3758 (. re (matcher s)))3760 (defn re-groups3761 "Returns the groups from the most recent match/find. If there are no3762 nested groups, returns a string of the entire match. If there are3763 nested groups, returns a vector of the groups, the first element3764 being the entire match."3765 {:added "1.0"}3766 [^java.util.regex.Matcher m]3767 (let [gc (. m (groupCount))]3768 (if (zero? gc)3769 (. m (group))3770 (loop [ret [] c 0]3771 (if (<= c gc)3772 (recur (conj ret (. m (group c))) (inc c))3773 ret)))))3775 (defn re-seq3776 "Returns a lazy sequence of successive matches of pattern in string,3777 using java.util.regex.Matcher.find(), each such match processed with3778 re-groups."3779 {:added "1.0"}3780 [^java.util.regex.Pattern re s]3781 (let [m (re-matcher re s)]3782 ((fn step []3783 (when (. m (find))3784 (cons (re-groups m) (lazy-seq (step))))))))3786 (defn re-matches3787 "Returns the match, if any, of string to pattern, using3788 java.util.regex.Matcher.matches(). Uses re-groups to return the3789 groups."3790 {:added "1.0"}3791 [^java.util.regex.Pattern re s]3792 (let [m (re-matcher re s)]3793 (when (. m (matches))3794 (re-groups m))))3797 (defn re-find3798 "Returns the next regex match, if any, of string to pattern, using3799 java.util.regex.Matcher.find(). Uses re-groups to return the3800 groups."3801 {:added "1.0"}3802 ([^java.util.regex.Matcher m]3803 (when (. m (find))3804 (re-groups m)))3805 ([^java.util.regex.Pattern re s]3806 (let [m (re-matcher re s)]3807 (re-find m))))3809 (defn rand3810 "Returns a random floating point number between 0 (inclusive) and3811 n (default 1) (exclusive)."3812 {:added "1.0"}3813 ([] (. Math (random)))3814 ([n] (* n (rand))))3816 (defn rand-int3817 "Returns a random integer between 0 (inclusive) and n (exclusive)."3818 {:added "1.0"}3819 [n] (int (rand n)))3821 (defmacro defn-3822 "same as defn, yielding non-public def"3823 {:added "1.0"}3824 [name & decls]3825 (list* `defn (with-meta name (assoc (meta name) :private true)) decls))3827 (defn print-doc [v]3828 (println "-------------------------")3829 (println (str (ns-name (:ns (meta v))) "/" (:name (meta v))))3830 (prn (:arglists (meta v)))3831 (when (:macro (meta v))3832 (println "Macro"))3833 (println " " (:doc (meta v))))3835 (defn find-doc3836 "Prints documentation for any var whose documentation or name3837 contains a match for re-string-or-pattern"3838 {:added "1.0"}3839 [re-string-or-pattern]3840 (let [re (re-pattern re-string-or-pattern)]3841 (doseq [ns (all-ns)3842 v (sort-by (comp :name meta) (vals (ns-interns ns)))3843 :when (and (:doc (meta v))3844 (or (re-find (re-matcher re (:doc (meta v))))3845 (re-find (re-matcher re (str (:name (meta v)))))))]3846 (print-doc v))))3848 (defn special-form-anchor3849 "Returns the anchor tag on http://clojure.org/special_forms for the3850 special form x, or nil"3851 {:added "1.0"}3852 [x]3853 (#{'. 'def 'do 'fn 'if 'let 'loop 'monitor-enter 'monitor-exit 'new3854 'quote 'recur 'set! 'throw 'try 'var} x))3856 (defn syntax-symbol-anchor3857 "Returns the anchor tag on http://clojure.org/special_forms for the3858 special form that uses syntax symbol x, or nil"3859 {:added "1.0"}3860 [x]3861 ({'& 'fn 'catch 'try 'finally 'try} x))3863 (defn print-special-doc3864 [name type anchor]3865 (println "-------------------------")3866 (println name)3867 (println type)3868 (println (str " Please see http://clojure.org/special_forms#" anchor)))3870 (defn print-namespace-doc3871 "Print the documentation string of a Namespace."3872 {:added "1.0"}3873 [nspace]3874 (println "-------------------------")3875 (println (str (ns-name nspace)))3876 (println " " (:doc (meta nspace))))3878 (defmacro doc3879 "Prints documentation for a var or special form given its name"3880 {:added "1.0"}3881 [name]3882 (cond3883 (special-form-anchor `~name)3884 `(print-special-doc '~name "Special Form" (special-form-anchor '~name))3885 (syntax-symbol-anchor `~name)3886 `(print-special-doc '~name "Syntax Symbol" (syntax-symbol-anchor '~name))3887 :else3888 (let [nspace (find-ns name)]3889 (if nspace3890 `(print-namespace-doc ~nspace)3891 `(print-doc (var ~name))))))3893 (defn tree-seq3894 "Returns a lazy sequence of the nodes in a tree, via a depth-first walk.3895 branch? must be a fn of one arg that returns true if passed a node3896 that can have children (but may not). children must be a fn of one3897 arg that returns a sequence of the children. Will only be called on3898 nodes for which branch? returns true. Root is the root node of the3899 tree."3900 {:added "1.0"}3901 [branch? children root]3902 (let [walk (fn walk [node]3903 (lazy-seq3904 (cons node3905 (when (branch? node)3906 (mapcat walk (children node))))))]3907 (walk root)))3909 (defn file-seq3910 "A tree seq on java.io.Files"3911 {:added "1.0"}3912 [dir]3913 (tree-seq3914 (fn [^java.io.File f] (. f (isDirectory)))3915 (fn [^java.io.File d] (seq (. d (listFiles))))3916 dir))3918 (defn xml-seq3919 "A tree seq on the xml elements as per xml/parse"3920 {:added "1.0"}3921 [root]3922 (tree-seq3923 (complement string?)3924 (comp seq :content)3925 root))3927 (defn special-symbol?3928 "Returns true if s names a special form"3929 {:added "1.0"}3930 [s]3931 (contains? (. clojure.lang.Compiler specials) s))3933 (defn var?3934 "Returns true if v is of type clojure.lang.Var"3935 {:added "1.0"}3936 [v] (instance? clojure.lang.Var v))3938 (defn ^String subs3939 "Returns the substring of s beginning at start inclusive, and ending3940 at end (defaults to length of string), exclusive."3941 {:added "1.0"}3942 ([^String s start] (. s (substring start)))3943 ([^String s start end] (. s (substring start end))))3945 (defn max-key3946 "Returns the x for which (k x), a number, is greatest."3947 {:added "1.0"}3948 ([k x] x)3949 ([k x y] (if (> (k x) (k y)) x y))3950 ([k x y & more]3951 (reduce #(max-key k %1 %2) (max-key k x y) more)))3953 (defn min-key3954 "Returns the x for which (k x), a number, is least."3955 {:added "1.0"}3956 ([k x] x)3957 ([k x y] (if (< (k x) (k y)) x y))3958 ([k x y & more]3959 (reduce #(min-key k %1 %2) (min-key k x y) more)))3961 (defn distinct3962 "Returns a lazy sequence of the elements of coll with duplicates removed"3963 {:added "1.0"}3964 [coll]3965 (let [step (fn step [xs seen]3966 (lazy-seq3967 ((fn [[f :as xs] seen]3968 (when-let [s (seq xs)]3969 (if (contains? seen f)3970 (recur (rest s) seen)3971 (cons f (step (rest s) (conj seen f))))))3972 xs seen)))]3973 (step coll #{})))3977 (defn replace3978 "Given a map of replacement pairs and a vector/collection, returns a3979 vector/seq with any elements = a key in smap replaced with the3980 corresponding val in smap"3981 {:added "1.0"}3982 [smap coll]3983 (if (vector? coll)3984 (reduce (fn [v i]3985 (if-let [e (find smap (nth v i))]3986 (assoc v i (val e))3987 v))3988 coll (range (count coll)))3989 (map #(if-let [e (find smap %)] (val e) %) coll)))3991 (defmacro dosync3992 "Runs the exprs (in an implicit do) in a transaction that encompasses3993 exprs and any nested calls. Starts a transaction if none is already3994 running on this thread. Any uncaught exception will abort the3995 transaction and flow out of dosync. The exprs may be run more than3996 once, but any effects on Refs will be atomic."3997 {:added "1.0"}3998 [& exprs]3999 `(sync nil ~@exprs))4001 (defmacro with-precision4002 "Sets the precision and rounding mode to be used for BigDecimal operations.4004 Usage: (with-precision 10 (/ 1M 3))4005 or: (with-precision 10 :rounding HALF_DOWN (/ 1M 3))4007 The rounding mode is one of CEILING, FLOOR, HALF_UP, HALF_DOWN,4008 HALF_EVEN, UP, DOWN and UNNECESSARY; it defaults to HALF_UP."4009 {:added "1.0"}4010 [precision & exprs]4011 (let [[body rm] (if (= (first exprs) :rounding)4012 [(next (next exprs))4013 `((. java.math.RoundingMode ~(second exprs)))]4014 [exprs nil])]4015 `(binding [*math-context* (java.math.MathContext. ~precision ~@rm)]4016 ~@body)))4018 (defn mk-bound-fn4019 {:private true}4020 [^clojure.lang.Sorted sc test key]4021 (fn [e]4022 (test (.. sc comparator (compare (. sc entryKey e) key)) 0)))4024 (defn subseq4025 "sc must be a sorted collection, test(s) one of <, <=, > or4026 >=. Returns a seq of those entries with keys ek for4027 which (test (.. sc comparator (compare ek key)) 0) is true"4028 {:added "1.0"}4029 ([^clojure.lang.Sorted sc test key]4030 (let [include (mk-bound-fn sc test key)]4031 (if (#{> >=} test)4032 (when-let [[e :as s] (. sc seqFrom key true)]4033 (if (include e) s (next s)))4034 (take-while include (. sc seq true)))))4035 ([^clojure.lang.Sorted sc start-test start-key end-test end-key]4036 (when-let [[e :as s] (. sc seqFrom start-key true)]4037 (take-while (mk-bound-fn sc end-test end-key)4038 (if ((mk-bound-fn sc start-test start-key) e) s (next s))))))4040 (defn rsubseq4041 "sc must be a sorted collection, test(s) one of <, <=, > or4042 >=. Returns a reverse seq of those entries with keys ek for4043 which (test (.. sc comparator (compare ek key)) 0) is true"4044 {:added "1.0"}4045 ([^clojure.lang.Sorted sc test key]4046 (let [include (mk-bound-fn sc test key)]4047 (if (#{< <=} test)4048 (when-let [[e :as s] (. sc seqFrom key false)]4049 (if (include e) s (next s)))4050 (take-while include (. sc seq false)))))4051 ([^clojure.lang.Sorted sc start-test start-key end-test end-key]4052 (when-let [[e :as s] (. sc seqFrom end-key false)]4053 (take-while (mk-bound-fn sc start-test start-key)4054 (if ((mk-bound-fn sc end-test end-key) e) s (next s))))))4056 (defn repeatedly4057 "Takes a function of no args, presumably with side effects, and4058 returns an infinite (or length n if supplied) lazy sequence of calls4059 to it"4060 {:added "1.0"}4061 ([f] (lazy-seq (cons (f) (repeatedly f))))4062 ([n f] (take n (repeatedly f))))4064 (defn add-classpath4065 "DEPRECATED4067 Adds the url (String or URL object) to the classpath per4068 URLClassLoader.addURL"4069 {:added "1.0"4070 :deprecated "1.1"}4071 [url]4072 (println "WARNING: add-classpath is deprecated")4073 (clojure.lang.RT/addURL url))4077 (defn hash4078 "Returns the hash code of its argument"4079 {:added "1.0"}4080 [x] (. clojure.lang.Util (hash x)))4082 (defn interpose4083 "Returns a lazy seq of the elements of coll separated by sep"4084 {:added "1.0"}4085 [sep coll] (drop 1 (interleave (repeat sep) coll)))4087 (defmacro definline4088 "Experimental - like defmacro, except defines a named function whose4089 body is the expansion, calls to which may be expanded inline as if4090 it were a macro. Cannot be used with variadic (&) args."4091 {:added "1.0"}4092 [name & decl]4093 (let [[pre-args [args expr]] (split-with (comp not vector?) decl)]4094 `(do4095 (defn ~name ~@pre-args ~args ~(apply (eval (list `fn args expr)) args))4096 (alter-meta! (var ~name) assoc :inline (fn ~name ~args ~expr))4097 (var ~name))))4099 (defn empty4100 "Returns an empty collection of the same category as coll, or nil"4101 {:added "1.0"}4102 [coll]4103 (when (instance? clojure.lang.IPersistentCollection coll)4104 (.empty ^clojure.lang.IPersistentCollection coll)))4106 (defmacro amap4107 "Maps an expression across an array a, using an index named idx, and4108 return value named ret, initialized to a clone of a, then setting4109 each element of ret to the evaluation of expr, returning the new4110 array ret."4111 {:added "1.0"}4112 [a idx ret expr]4113 `(let [a# ~a4114 ~ret (aclone a#)]4115 (loop [~idx (int 0)]4116 (if (< ~idx (alength a#))4117 (do4118 (aset ~ret ~idx ~expr)4119 (recur (unchecked-inc ~idx)))4120 ~ret))))4122 (defmacro areduce4123 "Reduces an expression across an array a, using an index named idx,4124 and return value named ret, initialized to init, setting ret to the4125 evaluation of expr at each step, returning ret."4126 {:added "1.0"}4127 [a idx ret init expr]4128 `(let [a# ~a]4129 (loop [~idx (int 0) ~ret ~init]4130 (if (< ~idx (alength a#))4131 (recur (unchecked-inc ~idx) ~expr)4132 ~ret))))4134 (defn float-array4135 "Creates an array of floats"4136 {:inline (fn [& args] `(. clojure.lang.Numbers float_array ~@args))4137 :inline-arities #{1 2}4138 :added "1.0"}4139 ([size-or-seq] (. clojure.lang.Numbers float_array size-or-seq))4140 ([size init-val-or-seq] (. clojure.lang.Numbers float_array size init-val-or-seq)))4142 (defn boolean-array4143 "Creates an array of booleans"4144 {:inline (fn [& args] `(. clojure.lang.Numbers boolean_array ~@args))4145 :inline-arities #{1 2}4146 :added "1.1"}4147 ([size-or-seq] (. clojure.lang.Numbers boolean_array size-or-seq))4148 ([size init-val-or-seq] (. clojure.lang.Numbers boolean_array size init-val-or-seq)))4150 (defn byte-array4151 "Creates an array of bytes"4152 {:inline (fn [& args] `(. clojure.lang.Numbers byte_array ~@args))4153 :inline-arities #{1 2}4154 :added "1.1"}4155 ([size-or-seq] (. clojure.lang.Numbers byte_array size-or-seq))4156 ([size init-val-or-seq] (. clojure.lang.Numbers byte_array size init-val-or-seq)))4158 (defn char-array4159 "Creates an array of chars"4160 {:inline (fn [& args] `(. clojure.lang.Numbers char_array ~@args))4161 :inline-arities #{1 2}4162 :added "1.1"}4163 ([size-or-seq] (. clojure.lang.Numbers char_array size-or-seq))4164 ([size init-val-or-seq] (. clojure.lang.Numbers char_array size init-val-or-seq)))4166 (defn short-array4167 "Creates an array of shorts"4168 {:inline (fn [& args] `(. clojure.lang.Numbers short_array ~@args))4169 :inline-arities #{1 2}4170 :added "1.1"}4171 ([size-or-seq] (. clojure.lang.Numbers short_array size-or-seq))4172 ([size init-val-or-seq] (. clojure.lang.Numbers short_array size init-val-or-seq)))4174 (defn double-array4175 "Creates an array of doubles"4176 {:inline (fn [& args] `(. clojure.lang.Numbers double_array ~@args))4177 :inline-arities #{1 2}4178 :added "1.0"}4179 ([size-or-seq] (. clojure.lang.Numbers double_array size-or-seq))4180 ([size init-val-or-seq] (. clojure.lang.Numbers double_array size init-val-or-seq)))4182 (defn object-array4183 "Creates an array of objects"4184 {:inline (fn [arg] `(. clojure.lang.RT object_array ~arg))4185 :inline-arities #{1}4186 :added "1.2"}4187 ([size-or-seq] (. clojure.lang.RT object_array size-or-seq)))4189 (defn int-array4190 "Creates an array of ints"4191 {:inline (fn [& args] `(. clojure.lang.Numbers int_array ~@args))4192 :inline-arities #{1 2}4193 :added "1.0"}4194 ([size-or-seq] (. clojure.lang.Numbers int_array size-or-seq))4195 ([size init-val-or-seq] (. clojure.lang.Numbers int_array size init-val-or-seq)))4197 (defn long-array4198 "Creates an array of longs"4199 {:inline (fn [& args] `(. clojure.lang.Numbers long_array ~@args))4200 :inline-arities #{1 2}4201 :added "1.0"}4202 ([size-or-seq] (. clojure.lang.Numbers long_array size-or-seq))4203 ([size init-val-or-seq] (. clojure.lang.Numbers long_array size init-val-or-seq)))4205 (definline booleans4206 "Casts to boolean[]"4207 {:added "1.1"}4208 [xs] `(. clojure.lang.Numbers booleans ~xs))4210 (definline bytes4211 "Casts to bytes[]"4212 {:added "1.1"}4213 [xs] `(. clojure.lang.Numbers bytes ~xs))4215 (definline chars4216 "Casts to chars[]"4217 {:added "1.1"}4218 [xs] `(. clojure.lang.Numbers chars ~xs))4220 (definline shorts4221 "Casts to shorts[]"4222 {:added "1.1"}4223 [xs] `(. clojure.lang.Numbers shorts ~xs))4225 (definline floats4226 "Casts to float[]"4227 {:added "1.0"}4228 [xs] `(. clojure.lang.Numbers floats ~xs))4230 (definline ints4231 "Casts to int[]"4232 {:added "1.0"}4233 [xs] `(. clojure.lang.Numbers ints ~xs))4235 (definline doubles4236 "Casts to double[]"4237 {:added "1.0"}4238 [xs] `(. clojure.lang.Numbers doubles ~xs))4240 (definline longs4241 "Casts to long[]"4242 {:added "1.0"}4243 [xs] `(. clojure.lang.Numbers longs ~xs))4245 (import '(java.util.concurrent BlockingQueue LinkedBlockingQueue))4247 (defn seque4248 "Creates a queued seq on another (presumably lazy) seq s. The queued4249 seq will produce a concrete seq in the background, and can get up to4250 n items ahead of the consumer. n-or-q can be an integer n buffer4251 size, or an instance of java.util.concurrent BlockingQueue. Note4252 that reading from a seque can block if the reader gets ahead of the4253 producer."4254 {:added "1.0"}4255 ([s] (seque 100 s))4256 ([n-or-q s]4257 (let [^BlockingQueue q (if (instance? BlockingQueue n-or-q)4258 n-or-q4259 (LinkedBlockingQueue. (int n-or-q)))4260 NIL (Object.) ;nil sentinel since LBQ doesn't support nils4261 agt (agent (seq s))4262 fill (fn [s]4263 (try4264 (loop [[x & xs :as s] s]4265 (if s4266 (if (.offer q (if (nil? x) NIL x))4267 (recur xs)4268 s)4269 (.put q q))) ; q itself is eos sentinel4270 (catch Exception e4271 (.put q q)4272 (throw e))))4273 drain (fn drain []4274 (lazy-seq4275 (let [x (.take q)]4276 (if (identical? x q) ;q itself is eos sentinel4277 (do @agt nil) ;touch agent just to propagate errors4278 (do4279 (send-off agt fill)4280 (cons (if (identical? x NIL) nil x) (drain)))))))]4281 (send-off agt fill)4282 (drain))))4284 (defn class?4285 "Returns true if x is an instance of Class"4286 {:added "1.0"}4287 [x] (instance? Class x))4289 (defn- is-annotation? [c]4290 (and (class? c)4291 (.isAssignableFrom java.lang.annotation.Annotation c)))4293 (defn- is-runtime-annotation? [^Class c]4294 (boolean4295 (and (is-annotation? c)4296 (when-let [^java.lang.annotation.Retention r4297 (.getAnnotation c java.lang.annotation.Retention)]4298 (= (.value r) java.lang.annotation.RetentionPolicy/RUNTIME)))))4300 (defn- descriptor [^Class c] (clojure.asm.Type/getDescriptor c))4302 (declare process-annotation)4303 (defn- add-annotation [^clojure.asm.AnnotationVisitor av name v]4304 (cond4305 (vector? v) (let [avec (.visitArray av name)]4306 (doseq [vval v]4307 (add-annotation avec "value" vval))4308 (.visitEnd avec))4309 (symbol? v) (let [ev (eval v)]4310 (cond4311 (instance? java.lang.Enum ev)4312 (.visitEnum av name (descriptor (class ev)) (str ev))4313 (class? ev) (.visit av name (clojure.asm.Type/getType ev))4314 :else (throw (IllegalArgumentException.4315 (str "Unsupported annotation value: " v " of class " (class ev))))))4316 (seq? v) (let [[nested nv] v4317 c (resolve nested)4318 nav (.visitAnnotation av name (descriptor c))]4319 (process-annotation nav nv)4320 (.visitEnd nav))4321 :else (.visit av name v)))4323 (defn- process-annotation [av v]4324 (if (map? v)4325 (doseq [[k v] v]4326 (add-annotation av (name k) v))4327 (add-annotation av "value" v)))4329 (defn- add-annotations4330 ([visitor m] (add-annotations visitor m nil))4331 ([visitor m i]4332 (doseq [[k v] m]4333 (when (symbol? k)4334 (when-let [c (resolve k)]4335 (when (is-annotation? c)4336 ;this is known duck/reflective as no common base of ASM Visitors4337 (let [av (if i4338 (.visitParameterAnnotation visitor i (descriptor c)4339 (is-runtime-annotation? c))4340 (.visitAnnotation visitor (descriptor c)4341 (is-runtime-annotation? c)))]4342 (process-annotation av v)4343 (.visitEnd av))))))))4345 (defn alter-var-root4346 "Atomically alters the root binding of var v by applying f to its4347 current value plus any args"4348 {:added "1.0"}4349 [^clojure.lang.Var v f & args] (.alterRoot v f args))4351 (defn bound?4352 "Returns true if all of the vars provided as arguments have any bound value, root or thread-local.4353 Implies that deref'ing the provided vars will succeed. Returns true if no vars are provided."4354 {:added "1.2"}4355 [& vars]4356 (every? #(.isBound ^clojure.lang.Var %) vars))4358 (defn thread-bound?4359 "Returns true if all of the vars provided as arguments have thread-local bindings.4360 Implies that set!'ing the provided vars will succeed. Returns true if no vars are provided."4361 {:added "1.2"}4362 [& vars]4363 (every? #(.getThreadBinding ^clojure.lang.Var %) vars))4365 (defn make-hierarchy4366 "Creates a hierarchy object for use with derive, isa? etc."4367 {:added "1.0"}4368 [] {:parents {} :descendants {} :ancestors {}})4370 (def ^{:private true}4371 global-hierarchy (make-hierarchy))4373 (defn not-empty4374 "If coll is empty, returns nil, else coll"4375 {:added "1.0"}4376 [coll] (when (seq coll) coll))4378 (defn bases4379 "Returns the immediate superclass and direct interfaces of c, if any"4380 {:added "1.0"}4381 [^Class c]4382 (when c4383 (let [i (.getInterfaces c)4384 s (.getSuperclass c)]4385 (not-empty4386 (if s (cons s i) i)))))4388 (defn supers4389 "Returns the immediate and indirect superclasses and interfaces of c, if any"4390 {:added "1.0"}4391 [^Class class]4392 (loop [ret (set (bases class)) cs ret]4393 (if (seq cs)4394 (let [c (first cs) bs (bases c)]4395 (recur (into ret bs) (into (disj cs c) bs)))4396 (not-empty ret))))4398 (defn isa?4399 "Returns true if (= child parent), or child is directly or indirectly derived from4400 parent, either via a Java type inheritance relationship or a4401 relationship established via derive. h must be a hierarchy obtained4402 from make-hierarchy, if not supplied defaults to the global4403 hierarchy"4404 {:added "1.0"}4405 ([child parent] (isa? global-hierarchy child parent))4406 ([h child parent]4407 (or (= child parent)4408 (and (class? parent) (class? child)4409 (. ^Class parent isAssignableFrom child))4410 (contains? ((:ancestors h) child) parent)4411 (and (class? child) (some #(contains? ((:ancestors h) %) parent) (supers child)))4412 (and (vector? parent) (vector? child)4413 (= (count parent) (count child))4414 (loop [ret true i 0]4415 (if (or (not ret) (= i (count parent)))4416 ret4417 (recur (isa? h (child i) (parent i)) (inc i))))))))4419 (defn parents4420 "Returns the immediate parents of tag, either via a Java type4421 inheritance relationship or a relationship established via derive. h4422 must be a hierarchy obtained from make-hierarchy, if not supplied4423 defaults to the global hierarchy"4424 {:added "1.0"}4425 ([tag] (parents global-hierarchy tag))4426 ([h tag] (not-empty4427 (let [tp (get (:parents h) tag)]4428 (if (class? tag)4429 (into (set (bases tag)) tp)4430 tp)))))4432 (defn ancestors4433 "Returns the immediate and indirect parents of tag, either via a Java type4434 inheritance relationship or a relationship established via derive. h4435 must be a hierarchy obtained from make-hierarchy, if not supplied4436 defaults to the global hierarchy"4437 {:added "1.0"}4438 ([tag] (ancestors global-hierarchy tag))4439 ([h tag] (not-empty4440 (let [ta (get (:ancestors h) tag)]4441 (if (class? tag)4442 (let [superclasses (set (supers tag))]4443 (reduce into superclasses4444 (cons ta4445 (map #(get (:ancestors h) %) superclasses))))4446 ta)))))4448 (defn descendants4449 "Returns the immediate and indirect children of tag, through a4450 relationship established via derive. h must be a hierarchy obtained4451 from make-hierarchy, if not supplied defaults to the global4452 hierarchy. Note: does not work on Java type inheritance4453 relationships."4454 {:added "1.0"}4455 ([tag] (descendants global-hierarchy tag))4456 ([h tag] (if (class? tag)4457 (throw (java.lang.UnsupportedOperationException. "Can't get descendants of classes"))4458 (not-empty (get (:descendants h) tag)))))4460 (defn derive4461 "Establishes a parent/child relationship between parent and4462 tag. Parent must be a namespace-qualified symbol or keyword and4463 child can be either a namespace-qualified symbol or keyword or a4464 class. h must be a hierarchy obtained from make-hierarchy, if not4465 supplied defaults to, and modifies, the global hierarchy."4466 {:added "1.0"}4467 ([tag parent]4468 (assert (namespace parent))4469 (assert (or (class? tag) (and (instance? clojure.lang.Named tag) (namespace tag))))4471 (alter-var-root #'global-hierarchy derive tag parent) nil)4472 ([h tag parent]4473 (assert (not= tag parent))4474 (assert (or (class? tag) (instance? clojure.lang.Named tag)))4475 (assert (instance? clojure.lang.Named parent))4477 (let [tp (:parents h)4478 td (:descendants h)4479 ta (:ancestors h)4480 tf (fn [m source sources target targets]4481 (reduce (fn [ret k]4482 (assoc ret k4483 (reduce conj (get targets k #{}) (cons target (targets target)))))4484 m (cons source (sources source))))]4485 (or4486 (when-not (contains? (tp tag) parent)4487 (when (contains? (ta tag) parent)4488 (throw (Exception. (print-str tag "already has" parent "as ancestor"))))4489 (when (contains? (ta parent) tag)4490 (throw (Exception. (print-str "Cyclic derivation:" parent "has" tag "as ancestor"))))4491 {:parents (assoc (:parents h) tag (conj (get tp tag #{}) parent))4492 :ancestors (tf (:ancestors h) tag td parent ta)4493 :descendants (tf (:descendants h) parent ta tag td)})4494 h))))4496 (declare flatten)4498 (defn underive4499 "Removes a parent/child relationship between parent and4500 tag. h must be a hierarchy obtained from make-hierarchy, if not4501 supplied defaults to, and modifies, the global hierarchy."4502 {:added "1.0"}4503 ([tag parent] (alter-var-root #'global-hierarchy underive tag parent) nil)4504 ([h tag parent]4505 (let [parentMap (:parents h)4506 childsParents (if (parentMap tag)4507 (disj (parentMap tag) parent) #{})4508 newParents (if (not-empty childsParents)4509 (assoc parentMap tag childsParents)4510 (dissoc parentMap tag))4511 deriv-seq (flatten (map #(cons (key %) (interpose (key %) (val %)))4512 (seq newParents)))]4513 (if (contains? (parentMap tag) parent)4514 (reduce #(apply derive %1 %2) (make-hierarchy)4515 (partition 2 deriv-seq))4516 h))))4519 (defn distinct?4520 "Returns true if no two of the arguments are ="4521 {:tag Boolean4522 :added "1.0"}4523 ([x] true)4524 ([x y] (not (= x y)))4525 ([x y & more]4526 (if (not= x y)4527 (loop [s #{x y} [x & etc :as xs] more]4528 (if xs4529 (if (contains? s x)4530 false4531 (recur (conj s x) etc))4532 true))4533 false)))4535 (defn resultset-seq4536 "Creates and returns a lazy sequence of structmaps corresponding to4537 the rows in the java.sql.ResultSet rs"4538 {:added "1.0"}4539 [^java.sql.ResultSet rs]4540 (let [rsmeta (. rs (getMetaData))4541 idxs (range 1 (inc (. rsmeta (getColumnCount))))4542 keys (map (comp keyword #(.toLowerCase ^String %))4543 (map (fn [i] (. rsmeta (getColumnLabel i))) idxs))4544 check-keys4545 (or (apply distinct? keys)4546 (throw (Exception. "ResultSet must have unique column labels")))4547 row-struct (apply create-struct keys)4548 row-values (fn [] (map (fn [^Integer i] (. rs (getObject i))) idxs))4549 rows (fn thisfn []4550 (when (. rs (next))4551 (cons (apply struct row-struct (row-values)) (lazy-seq (thisfn)))))]4552 (rows)))4554 (defn iterator-seq4555 "Returns a seq on a java.util.Iterator. Note that most collections4556 providing iterators implement Iterable and thus support seq directly."4557 {:added "1.0"}4558 [iter]4559 (clojure.lang.IteratorSeq/create iter))4561 (defn enumeration-seq4562 "Returns a seq on a java.util.Enumeration"4563 {:added "1.0"}4564 [e]4565 (clojure.lang.EnumerationSeq/create e))4567 (defn format4568 "Formats a string using java.lang.String.format, see java.util.Formatter for format4569 string syntax"4570 {:tag String4571 :added "1.0"}4572 [fmt & args]4573 (String/format fmt (to-array args)))4575 (defn printf4576 "Prints formatted output, as per format"4577 {:added "1.0"}4578 [fmt & args]4579 (print (apply format fmt args)))4581 (declare gen-class)4583 (defmacro with-loading-context [& body]4584 `((fn loading# []4585 (. clojure.lang.Var (pushThreadBindings {clojure.lang.Compiler/LOADER4586 (.getClassLoader (.getClass ^Object loading#))}))4587 (try4588 ~@body4589 (finally4590 (. clojure.lang.Var (popThreadBindings)))))))4592 (defmacro ns4593 "Sets *ns* to the namespace named by name (unevaluated), creating it4594 if needed. references can be zero or more of: (:refer-clojure ...)4595 (:require ...) (:use ...) (:import ...) (:load ...) (:gen-class)4596 with the syntax of refer-clojure/require/use/import/load/gen-class4597 respectively, except the arguments are unevaluated and need not be4598 quoted. (:gen-class ...), when supplied, defaults to :name4599 corresponding to the ns name, :main true, :impl-ns same as ns, and4600 :init-impl-ns true. All options of gen-class are4601 supported. The :gen-class directive is ignored when not4602 compiling. If :gen-class is not supplied, when compiled only an4603 nsname__init.class will be generated. If :refer-clojure is not used, a4604 default (refer 'clojure) is used. Use of ns is preferred to4605 individual calls to in-ns/require/use/import:4607 (ns foo.bar4608 (:refer-clojure :exclude [ancestors printf])4609 (:require (clojure.contrib sql sql.tests))4610 (:use (my.lib this that))4611 (:import (java.util Date Timer Random)4612 (java.sql Connection Statement)))"4613 {:arglists '([name docstring? attr-map? references*])4614 :added "1.0"}4615 [name & references]4616 (let [process-reference4617 (fn [[kname & args]]4618 `(~(symbol "clojure.core" (clojure.core/name kname))4619 ~@(map #(list 'quote %) args)))4620 docstring (when (string? (first references)) (first references))4621 references (if docstring (next references) references)4622 name (if docstring4623 (vary-meta name assoc :doc docstring)4624 name)4625 metadata (when (map? (first references)) (first references))4626 references (if metadata (next references) references)4627 name (if metadata4628 (vary-meta name merge metadata)4629 name)4630 gen-class-clause (first (filter #(= :gen-class (first %)) references))4631 gen-class-call4632 (when gen-class-clause4633 (list* `gen-class :name (.replace (str name) \- \_) :impl-ns name :main true (next gen-class-clause)))4634 references (remove #(= :gen-class (first %)) references)4635 ;ns-effect (clojure.core/in-ns name)4636 ]4637 `(do4638 (clojure.core/in-ns '~name)4639 (with-loading-context4640 ~@(when gen-class-call (list gen-class-call))4641 ~@(when (and (not= name 'clojure.core) (not-any? #(= :refer-clojure (first %)) references))4642 `((clojure.core/refer '~'clojure.core)))4643 ~@(map process-reference references)))))4645 (defmacro refer-clojure4646 "Same as (refer 'clojure.core <filters>)"4647 {:added "1.0"}4648 [& filters]4649 `(clojure.core/refer '~'clojure.core ~@filters))4651 (defmacro defonce4652 "defs name to have the root value of the expr iff the named var has no root value,4653 else expr is unevaluated"4654 {:added "1.0"}4655 [name expr]4656 `(let [v# (def ~name)]4657 (when-not (.hasRoot v#)4658 (def ~name ~expr))))4660 ;;;;;;;;;;; require/use/load, contributed by Stephen C. Gilardi ;;;;;;;;;;;;;;;;;;4662 (defonce4663 ^{:private true4664 :doc "A ref to a sorted set of symbols representing loaded libs"}4665 *loaded-libs* (ref (sorted-set)))4667 (defonce4668 ^{:private true4669 :doc "the set of paths currently being loaded by this thread"}4670 *pending-paths* #{})4672 (defonce4673 ^{:private true :doc4674 "True while a verbose load is pending"}4675 *loading-verbosely* false)4677 (defn- throw-if4678 "Throws an exception with a message if pred is true"4679 [pred fmt & args]4680 (when pred4681 (let [^String message (apply format fmt args)4682 exception (Exception. message)4683 raw-trace (.getStackTrace exception)4684 boring? #(not= (.getMethodName ^StackTraceElement %) "doInvoke")4685 trace (into-array (drop 2 (drop-while boring? raw-trace)))]4686 (.setStackTrace exception trace)4687 (throw exception))))4689 (defn- libspec?4690 "Returns true if x is a libspec"4691 [x]4692 (or (symbol? x)4693 (and (vector? x)4694 (or4695 (nil? (second x))4696 (keyword? (second x))))))4698 (defn- prependss4699 "Prepends a symbol or a seq to coll"4700 [x coll]4701 (if (symbol? x)4702 (cons x coll)4703 (concat x coll)))4705 (defn- root-resource4706 "Returns the root directory path for a lib"4707 {:tag String}4708 [lib]4709 (str \/4710 (.. (name lib)4711 (replace \- \_)4712 (replace \. \/))))4714 (defn- root-directory4715 "Returns the root resource path for a lib"4716 [lib]4717 (let [d (root-resource lib)]4718 (subs d 0 (.lastIndexOf d "/"))))4720 (declare load)4722 (defn- load-one4723 "Loads a lib given its name. If need-ns, ensures that the associated4724 namespace exists after loading. If require, records the load so any4725 duplicate loads can be skipped."4726 [lib need-ns require]4727 (load (root-resource lib))4728 (throw-if (and need-ns (not (find-ns lib)))4729 "namespace '%s' not found after loading '%s'"4730 lib (root-resource lib))4731 (when require4732 (dosync4733 (commute *loaded-libs* conj lib))))4735 (defn- load-all4736 "Loads a lib given its name and forces a load of any libs it directly or4737 indirectly loads. If need-ns, ensures that the associated namespace4738 exists after loading. If require, records the load so any duplicate loads4739 can be skipped."4740 [lib need-ns require]4741 (dosync4742 (commute *loaded-libs* #(reduce conj %1 %2)4743 (binding [*loaded-libs* (ref (sorted-set))]4744 (load-one lib need-ns require)4745 @*loaded-libs*))))4747 (defn- load-lib4748 "Loads a lib with options"4749 [prefix lib & options]4750 (throw-if (and prefix (pos? (.indexOf (name lib) (int \.))))4751 "lib names inside prefix lists must not contain periods")4752 (let [lib (if prefix (symbol (str prefix \. lib)) lib)4753 opts (apply hash-map options)4754 {:keys [as reload reload-all require use verbose]} opts4755 loaded (contains? @*loaded-libs* lib)4756 load (cond reload-all4757 load-all4758 (or reload (not require) (not loaded))4759 load-one)4760 need-ns (or as use)4761 filter-opts (select-keys opts '(:exclude :only :rename))]4762 (binding [*loading-verbosely* (or *loading-verbosely* verbose)]4763 (if load4764 (load lib need-ns require)4765 (throw-if (and need-ns (not (find-ns lib)))4766 "namespace '%s' not found" lib))4767 (when (and need-ns *loading-verbosely*)4768 (printf "(clojure.core/in-ns '%s)\n" (ns-name *ns*)))4769 (when as4770 (when *loading-verbosely*4771 (printf "(clojure.core/alias '%s '%s)\n" as lib))4772 (alias as lib))4773 (when use4774 (when *loading-verbosely*4775 (printf "(clojure.core/refer '%s" lib)4776 (doseq [opt filter-opts]4777 (printf " %s '%s" (key opt) (print-str (val opt))))4778 (printf ")\n"))4779 (apply refer lib (mapcat seq filter-opts))))))4781 (defn- load-libs4782 "Loads libs, interpreting libspecs, prefix lists, and flags for4783 forwarding to load-lib"4784 [& args]4785 (let [flags (filter keyword? args)4786 opts (interleave flags (repeat true))4787 args (filter (complement keyword?) args)]4788 ; check for unsupported options4789 (let [supported #{:as :reload :reload-all :require :use :verbose}4790 unsupported (seq (remove supported flags))]4791 (throw-if unsupported4792 (apply str "Unsupported option(s) supplied: "4793 (interpose \, unsupported))))4794 ; check a load target was specified4795 (throw-if (not (seq args)) "Nothing specified to load")4796 (doseq [arg args]4797 (if (libspec? arg)4798 (apply load-lib nil (prependss arg opts))4799 (let [[prefix & args] arg]4800 (throw-if (nil? prefix) "prefix cannot be nil")4801 (doseq [arg args]4802 (apply load-lib prefix (prependss arg opts))))))))4804 ;; Public4807 (defn require4808 "Loads libs, skipping any that are already loaded. Each argument is4809 either a libspec that identifies a lib, a prefix list that identifies4810 multiple libs whose names share a common prefix, or a flag that modifies4811 how all the identified libs are loaded. Use :require in the ns macro4812 in preference to calling this directly.4814 Libs4816 A 'lib' is a named set of resources in classpath whose contents define a4817 library of Clojure code. Lib names are symbols and each lib is associated4818 with a Clojure namespace and a Java package that share its name. A lib's4819 name also locates its root directory within classpath using Java's4820 package name to classpath-relative path mapping. All resources in a lib4821 should be contained in the directory structure under its root directory.4822 All definitions a lib makes should be in its associated namespace.4824 'require loads a lib by loading its root resource. The root resource path4825 is derived from the lib name in the following manner:4826 Consider a lib named by the symbol 'x.y.z; it has the root directory4827 <classpath>/x/y/, and its root resource is <classpath>/x/y/z.clj. The root4828 resource should contain code to create the lib's namespace (usually by using4829 the ns macro) and load any additional lib resources.4831 Libspecs4833 A libspec is a lib name or a vector containing a lib name followed by4834 options expressed as sequential keywords and arguments.4836 Recognized options: :as4837 :as takes a symbol as its argument and makes that symbol an alias to the4838 lib's namespace in the current namespace.4840 Prefix Lists4842 It's common for Clojure code to depend on several libs whose names have4843 the same prefix. When specifying libs, prefix lists can be used to reduce4844 repetition. A prefix list contains the shared prefix followed by libspecs4845 with the shared prefix removed from the lib names. After removing the4846 prefix, the names that remain must not contain any periods.4848 Flags4850 A flag is a keyword.4851 Recognized flags: :reload, :reload-all, :verbose4852 :reload forces loading of all the identified libs even if they are4853 already loaded4854 :reload-all implies :reload and also forces loading of all libs that the4855 identified libs directly or indirectly load via require or use4856 :verbose triggers printing information about each load, alias, and refer4858 Example:4860 The following would load the libraries clojure.zip and clojure.set4861 abbreviated as 's'.4863 (require '(clojure zip [set :as s]))"4864 {:added "1.0"}4866 [& args]4867 (apply load-libs :require args))4869 (defn use4870 "Like 'require, but also refers to each lib's namespace using4871 clojure.core/refer. Use :use in the ns macro in preference to calling4872 this directly.4874 'use accepts additional options in libspecs: :exclude, :only, :rename.4875 The arguments and semantics for :exclude, :only, and :rename are the same4876 as those documented for clojure.core/refer."4877 {:added "1.0"}4878 [& args] (apply load-libs :require :use args))4880 (defn loaded-libs4881 "Returns a sorted set of symbols naming the currently loaded libs"4882 {:added "1.0"}4883 [] @*loaded-libs*)4885 (defn load4886 "Loads Clojure code from resources in classpath. A path is interpreted as4887 classpath-relative if it begins with a slash or relative to the root4888 directory for the current namespace otherwise."4889 {:added "1.0"}4890 [& paths]4891 (doseq [^String path paths]4892 (let [^String path (if (.startsWith path "/")4893 path4894 (str (root-directory (ns-name *ns*)) \/ path))]4895 (when *loading-verbosely*4896 (printf "(clojure.core/load \"%s\")\n" path)4897 (flush))4898 ; (throw-if (*pending-paths* path)4899 ; "cannot load '%s' again while it is loading"4900 ; path)4901 (when-not (*pending-paths* path)4902 (binding [*pending-paths* (conj *pending-paths* path)]4903 (clojure.lang.RT/load (.substring path 1)))))))4905 (defn compile4906 "Compiles the namespace named by the symbol lib into a set of4907 classfiles. The source for the lib must be in a proper4908 classpath-relative directory. The output files will go into the4909 directory specified by *compile-path*, and that directory too must4910 be in the classpath."4911 {:added "1.0"}4912 [lib]4913 (binding [*compile-files* true]4914 (load-one lib true true))4915 lib)4917 ;;;;;;;;;;;;; nested associative ops ;;;;;;;;;;;4919 (defn get-in4920 "Returns the value in a nested associative structure,4921 where ks is a sequence of ke(ys. Returns nil if the key is not present,4922 or the not-found value if supplied."4923 {:added "1.2"}4924 ([m ks]4925 (reduce get m ks))4926 ([m ks not-found]4927 (loop [sentinel (Object.)4928 m m4929 ks (seq ks)]4930 (if ks4931 (let [m (get m (first ks) sentinel)]4932 (if (identical? sentinel m)4933 not-found4934 (recur sentinel m (next ks))))4935 m))))4937 (defn assoc-in4938 "Associates a value in a nested associative structure, where ks is a4939 sequence of keys and v is the new value and returns a new nested structure.4940 If any levels do not exist, hash-maps will be created."4941 {:added "1.0"}4942 [m [k & ks] v]4943 (if ks4944 (assoc m k (assoc-in (get m k) ks v))4945 (assoc m k v)))4947 (defn update-in4948 "'Updates' a value in a nested associative structure, where ks is a4949 sequence of keys and f is a function that will take the old value4950 and any supplied args and return the new value, and returns a new4951 nested structure. If any levels do not exist, hash-maps will be4952 created."4953 {:added "1.0"}4954 ([m [k & ks] f & args]4955 (if ks4956 (assoc m k (apply update-in (get m k) ks f args))4957 (assoc m k (apply f (get m k) args)))))4960 (defn empty?4961 "Returns true if coll has no items - same as (not (seq coll)).4962 Please use the idiom (seq x) rather than (not (empty? x))"4963 {:added "1.0"}4964 [coll] (not (seq coll)))4966 (defn coll?4967 "Returns true if x implements IPersistentCollection"4968 {:added "1.0"}4969 [x] (instance? clojure.lang.IPersistentCollection x))4971 (defn list?4972 "Returns true if x implements IPersistentList"4973 {:added "1.0"}4974 [x] (instance? clojure.lang.IPersistentList x))4976 (defn set?4977 "Returns true if x implements IPersistentSet"4978 {:added "1.0"}4979 [x] (instance? clojure.lang.IPersistentSet x))4981 (defn ifn?4982 "Returns true if x implements IFn. Note that many data structures4983 (e.g. sets and maps) implement IFn"4984 {:added "1.0"}4985 [x] (instance? clojure.lang.IFn x))4987 (defn fn?4988 "Returns true if x implements Fn, i.e. is an object created via fn."4989 {:added "1.0"}4990 [x] (instance? clojure.lang.Fn x))4993 (defn associative?4994 "Returns true if coll implements Associative"4995 {:added "1.0"}4996 [coll] (instance? clojure.lang.Associative coll))4998 (defn sequential?4999 "Returns true if coll implements Sequential"5000 {:added "1.0"}5001 [coll] (instance? clojure.lang.Sequential coll))5003 (defn sorted?5004 "Returns true if coll implements Sorted"5005 {:added "1.0"}5006 [coll] (instance? clojure.lang.Sorted coll))5008 (defn counted?5009 "Returns true if coll implements count in constant time"5010 {:added "1.0"}5011 [coll] (instance? clojure.lang.Counted coll))5013 (defn reversible?5014 "Returns true if coll implements Reversible"5015 {:added "1.0"}5016 [coll] (instance? clojure.lang.Reversible coll))5018 (def5019 ^{:doc "bound in a repl thread to the most recent value printed"5020 :added "1.0"}5021 *1)5023 (def5024 ^{:doc "bound in a repl thread to the second most recent value printed"5025 :added "1.0"}5026 *2)5028 (def5029 ^{:doc "bound in a repl thread to the third most recent value printed"5030 :added "1.0"}5031 *3)5033 (def5034 ^{:doc "bound in a repl thread to the most recent exception caught by the repl"5035 :added "1.0"}5036 *e)5038 (defn trampoline5039 "trampoline can be used to convert algorithms requiring mutual5040 recursion without stack consumption. Calls f with supplied args, if5041 any. If f returns a fn, calls that fn with no arguments, and5042 continues to repeat, until the return value is not a fn, then5043 returns that non-fn value. Note that if you want to return a fn as a5044 final value, you must wrap it in some data structure and unpack it5045 after trampoline returns."5046 {:added "1.0"}5047 ([f]5048 (let [ret (f)]5049 (if (fn? ret)5050 (recur ret)5051 ret)))5052 ([f & args]5053 (trampoline #(apply f args))))5055 (defn intern5056 "Finds or creates a var named by the symbol name in the namespace5057 ns (which can be a symbol or a namespace), setting its root binding5058 to val if supplied. The namespace must exist. The var will adopt any5059 metadata from the name symbol. Returns the var."5060 {:added "1.0"}5061 ([ns ^clojure.lang.Symbol name]5062 (let [v (clojure.lang.Var/intern (the-ns ns) name)]5063 (when (meta name) (.setMeta v (meta name)))5064 v))5065 ([ns name val]5066 (let [v (clojure.lang.Var/intern (the-ns ns) name val)]5067 (when (meta name) (.setMeta v (meta name)))5068 v)))5070 (defmacro while5071 "Repeatedly executes body while test expression is true. Presumes5072 some side-effect will cause test to become false/nil. Returns nil"5073 {:added "1.0"}5074 [test & body]5075 `(loop []5076 (when ~test5077 ~@body5078 (recur))))5080 (defn memoize5081 "Returns a memoized version of a referentially transparent function. The5082 memoized version of the function keeps a cache of the mapping from arguments5083 to results and, when calls with the same arguments are repeated often, has5084 higher performance at the expense of higher memory use."5085 {:added "1.0"}5086 [f]5087 (let [mem (atom {})]5088 (fn [& args]5089 (if-let [e (find @mem args)]5090 (val e)5091 (let [ret (apply f args)]5092 (swap! mem assoc args ret)5093 ret)))))5095 (defmacro condp5096 "Takes a binary predicate, an expression, and a set of clauses.5097 Each clause can take the form of either:5099 test-expr result-expr5101 test-expr :>> result-fn5103 Note :>> is an ordinary keyword.5105 For each clause, (pred test-expr expr) is evaluated. If it returns5106 logical true, the clause is a match. If a binary clause matches, the5107 result-expr is returned, if a ternary clause matches, its result-fn,5108 which must be a unary function, is called with the result of the5109 predicate as its argument, the result of that call being the return5110 value of condp. A single default expression can follow the clauses,5111 and its value will be returned if no clause matches. If no default5112 expression is provided and no clause matches, an5113 IllegalArgumentException is thrown."5114 {:added "1.0"}5116 [pred expr & clauses]5117 (let [gpred (gensym "pred__")5118 gexpr (gensym "expr__")5119 emit (fn emit [pred expr args]5120 (let [[[a b c :as clause] more]5121 (split-at (if (= :>> (second args)) 3 2) args)5122 n (count clause)]5123 (cond5124 (= 0 n) `(throw (IllegalArgumentException. (str "No matching clause: " ~expr)))5125 (= 1 n) a5126 (= 2 n) `(if (~pred ~a ~expr)5127 ~b5128 ~(emit pred expr more))5129 :else `(if-let [p# (~pred ~a ~expr)]5130 (~c p#)5131 ~(emit pred expr more)))))5132 gres (gensym "res__")]5133 `(let [~gpred ~pred5134 ~gexpr ~expr]5135 ~(emit gpred gexpr clauses))))5137 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; var documentation ;;;;;;;;;;;;;;;;;;;;;;;;;;5139 (alter-meta! #'*agent* assoc :added "1.0")5140 (alter-meta! #'in-ns assoc :added "1.0")5141 (alter-meta! #'load-file assoc :added "1.0")5143 (defmacro add-doc-and-meta {:private true} [name docstring meta]5144 `(alter-meta! (var ~name) merge (assoc ~meta :doc ~docstring)))5146 (add-doc-and-meta *file*5147 "The path of the file being evaluated, as a String.5149 Evaluates to nil when there is no file, eg. in the REPL."5150 {:added "1.0"})5152 (add-doc-and-meta *command-line-args*5153 "A sequence of the supplied command line arguments, or nil if5154 none were supplied"5155 {:added "1.0"})5157 (add-doc-and-meta *warn-on-reflection*5158 "When set to true, the compiler will emit warnings when reflection is5159 needed to resolve Java method calls or field accesses.5161 Defaults to false."5162 {:added "1.0"})5164 (add-doc-and-meta *compile-path*5165 "Specifies the directory where 'compile' will write out .class5166 files. This directory must be in the classpath for 'compile' to5167 work.5169 Defaults to \"classes\""5170 {:added "1.0"})5172 (add-doc-and-meta *compile-files*5173 "Set to true when compiling files, false otherwise."5174 {:added "1.0"})5176 (add-doc-and-meta *ns*5177 "A clojure.lang.Namespace object representing the current namespace."5178 {:added "1.0"})5180 (add-doc-and-meta *in*5181 "A java.io.Reader object representing standard input for read operations.5183 Defaults to System/in, wrapped in a LineNumberingPushbackReader"5184 {:added "1.0"})5186 (add-doc-and-meta *out*5187 "A java.io.Writer object representing standard output for print operations.5189 Defaults to System/out"5190 {:added "1.0"})5192 (add-doc-and-meta *err*5193 "A java.io.Writer object representing standard error for print operations.5195 Defaults to System/err, wrapped in a PrintWriter"5196 {:added "1.0"})5198 (add-doc-and-meta *flush-on-newline*5199 "When set to true, output will be flushed whenever a newline is printed.5201 Defaults to true."5202 {:added "1.0"})5204 (add-doc-and-meta *print-meta*5205 "If set to logical true, when printing an object, its metadata will also5206 be printed in a form that can be read back by the reader.5208 Defaults to false."5209 {:added "1.0"})5211 (add-doc-and-meta *print-dup*5212 "When set to logical true, objects will be printed in a way that preserves5213 their type when read in later.5215 Defaults to false."5216 {:added "1.0"})5218 (add-doc-and-meta *print-readably*5219 "When set to logical false, strings and characters will be printed with5220 non-alphanumeric characters converted to the appropriate escape sequences.5222 Defaults to true"5223 {:added "1.0"})5225 (add-doc-and-meta *read-eval*5226 "When set to logical false, the EvalReader (#=(...)) is disabled in the5227 read/load in the thread-local binding.5228 Example: (binding [*read-eval* false] (read-string \"#=(eval (def x 3))\"))5230 Defaults to true"5231 {:added "1.0"})5233 (defn future?5234 "Returns true if x is a future"5235 {:added "1.1"}5236 [x] (instance? java.util.concurrent.Future x))5238 (defn future-done?5239 "Returns true if future f is done"5240 {:added "1.1"}5241 [^java.util.concurrent.Future f] (.isDone f))5244 (defmacro letfn5245 "Takes a vector of function specs and a body, and generates a set of5246 bindings of functions to their names. All of the names are available5247 in all of the definitions of the functions, as well as the body.5249 fnspec ==> (fname [params*] exprs) or (fname ([params*] exprs)+)"5250 {:added "1.0"}5251 [fnspecs & body]5252 `(letfn* ~(vec (interleave (map first fnspecs)5253 (map #(cons `fn %) fnspecs)))5254 ~@body))5257 ;;;;;;; case ;;;;;;;;;;;;;5258 (defn- shift-mask [shift mask x]5259 (-> x (bit-shift-right shift) (bit-and mask)))5261 (defn- min-hash5262 "takes a collection of keys and returns [shift mask]"5263 [keys]5264 (let [hashes (map hash keys)5265 cnt (count keys)]5266 (when-not (apply distinct? hashes)5267 (throw (IllegalArgumentException. "Hashes must be distinct")))5268 (or (first5269 (filter (fn [[s m]]5270 (apply distinct? (map #(shift-mask s m %) hashes)))5271 (for [mask (map #(dec (bit-shift-left 1 %)) (range 1 14))5272 shift (range 0 31)]5273 [shift mask])))5274 (throw (IllegalArgumentException. "No distinct mapping found")))))5276 (defmacro case5277 "Takes an expression, and a set of clauses.5279 Each clause can take the form of either:5281 test-constant result-expr5283 (test-constant1 ... test-constantN) result-expr5285 The test-constants are not evaluated. They must be compile-time5286 literals, and need not be quoted. If the expression is equal to a5287 test-constant, the corresponding result-expr is returned. A single5288 default expression can follow the clauses, and its value will be5289 returned if no clause matches. If no default expression is provided5290 and no clause matches, an IllegalArgumentException is thrown.5292 Unlike cond and condp, case does a constant-time dispatch, the5293 clauses are not considered sequentially. All manner of constant5294 expressions are acceptable in case, including numbers, strings,5295 symbols, keywords, and (Clojure) composites thereof. Note that since5296 lists are used to group multiple constants that map to the same5297 expression, a vector can be used to match a list if needed. The5298 test-constants need not be all of the same type."5299 {:added "1.2"}5301 [e & clauses]5302 (let [ge (with-meta (gensym) {:tag Object})5303 default (if (odd? (count clauses))5304 (last clauses)5305 `(throw (IllegalArgumentException. (str "No matching clause: " ~ge))))5306 cases (partition 2 clauses)5307 case-map (reduce (fn [m [test expr]]5308 (if (seq? test)5309 (into m (zipmap test (repeat expr)))5310 (assoc m test expr)))5311 {} cases)5312 [shift mask] (if (seq case-map) (min-hash (keys case-map)) [0 0])5314 hmap (reduce (fn [m [test expr :as te]]5315 (assoc m (shift-mask shift mask (hash test)) te))5316 (sorted-map) case-map)]5317 `(let [~ge ~e]5318 ~(condp = (count clauses)5319 0 default5320 1 default5321 `(case* ~ge ~shift ~mask ~(key (first hmap)) ~(key (last hmap)) ~default ~hmap5322 ~(every? keyword? (keys case-map)))))))5324 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; helper files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;5325 (alter-meta! (find-ns 'clojure.core) assoc :doc "Fundamental library of the Clojure language")5326 (load "core_proxy")5327 (load "core_print")5328 (load "genclass")5329 (load "core_deftype")5330 (load "core/protocols")5331 (load "gvec")5333 ;; redefine reduce with internal-reduce5334 #_(defn reduce5335 "f should be a function of 2 arguments. If val is not supplied,5336 returns the result of applying f to the first 2 items in coll, then5337 applying f to that result and the 3rd item, etc. If coll contains no5338 items, f must accept no arguments as well, and reduce returns the5339 result of calling f with no arguments. If coll has only 1 item, it5340 is returned and f is not called. If val is supplied, returns the5341 result of applying f to val and the first item in coll, then5342 applying f to that result and the 2nd item, etc. If coll contains no5343 items, returns val and f is not called."5344 {:added "1.0"}5345 ([f coll]5346 (if-let [s (seq coll)]5347 (reduce f (first s) (next s))5348 (f)))5349 ([f val coll]5350 (let [s (seq coll)]5351 (clojure.core.protocols/internal-reduce s f val))))5353 (require '[clojure.java.io :as jio])5355 (defn- normalize-slurp-opts5356 [opts]5357 (if (string? (first opts))5358 (do5359 (println "WARNING: (slurp f enc) is deprecated, use (slurp f :encoding enc).")5360 [:encoding (first opts)])5361 opts))5363 (defn slurp5364 "Reads the file named by f using the encoding enc into a string5365 and returns it."5366 {:added "1.0"}5367 ([f & opts]5368 (let [opts (normalize-slurp-opts opts)5369 sb (StringBuilder.)]5370 (with-open [#^java.io.Reader r (apply jio/reader f opts)]5371 (loop [c (.read r)]5372 (if (neg? c)5373 (str sb)5374 (do5375 (.append sb (char c))5376 (recur (.read r)))))))))5378 (defn spit5379 "Opposite of slurp. Opens f with writer, writes content, then5380 closes f. Options passed to clojure.java.io/writer."5381 {:added "1.2"}5382 [f content & options]5383 (with-open [#^java.io.Writer w (apply jio/writer f options)]5384 (.write w (str content))))5386 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; futures (needs proxy);;;;;;;;;;;;;;;;;;5387 (defn future-call5388 "Takes a function of no args and yields a future object that will5389 invoke the function in another thread, and will cache the result and5390 return it on all subsequent calls to deref/@. If the computation has5391 not yet finished, calls to deref/@ will block."5392 {:added "1.1"}5393 [^Callable f]5394 (let [fut (.submit clojure.lang.Agent/soloExecutor f)]5395 (reify5396 clojure.lang.IDeref5397 (deref [_] (.get fut))5398 java.util.concurrent.Future5399 (get [_] (.get fut))5400 (get [_ timeout unit] (.get fut timeout unit))5401 (isCancelled [_] (.isCancelled fut))5402 (isDone [_] (.isDone fut))5403 (cancel [_ interrupt?] (.cancel fut interrupt?)))))5405 (defmacro future5406 "Takes a body of expressions and yields a future object that will5407 invoke the body in another thread, and will cache the result and5408 return it on all subsequent calls to deref/@. If the computation has5409 not yet finished, calls to deref/@ will block."5410 {:added "1.1"}5411 [& body] `(future-call (^{:once true} fn* [] ~@body)))5414 (defn future-cancel5415 "Cancels the future, if possible."5416 {:added "1.1"}5417 [^java.util.concurrent.Future f] (.cancel f true))5419 (defn future-cancelled?5420 "Returns true if future f is cancelled"5421 {:added "1.1"}5422 [^java.util.concurrent.Future f] (.isCancelled f))5424 (defn pmap5425 "Like map, except f is applied in parallel. Semi-lazy in that the5426 parallel computation stays ahead of the consumption, but doesn't5427 realize the entire result unless required. Only useful for5428 computationally intensive functions where the time of f dominates5429 the coordination overhead."5430 {:added "1.0"}5431 ([f coll]5432 (let [n (+ 2 (.. Runtime getRuntime availableProcessors))5433 rets (map #(future (f %)) coll)5434 step (fn step [[x & xs :as vs] fs]5435 (lazy-seq5436 (if-let [s (seq fs)]5437 (cons (deref x) (step xs (rest s)))5438 (map deref vs))))]5439 (step rets (drop n rets))))5440 ([f coll & colls]5441 (let [step (fn step [cs]5442 (lazy-seq5443 (let [ss (map seq cs)]5444 (when (every? identity ss)5445 (cons (map first ss) (step (map rest ss)))))))]5446 (pmap #(apply f %) (step (cons coll colls))))))5448 (defn pcalls5449 "Executes the no-arg fns in parallel, returning a lazy sequence of5450 their values"5451 {:added "1.0"}5452 [& fns] (pmap #(%) fns))5454 (defmacro pvalues5455 "Returns a lazy sequence of the values of the exprs, which are5456 evaluated in parallel"5457 {:added "1.0"}5458 [& exprs]5459 `(pcalls ~@(map #(list `fn [] %) exprs)))5462 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; clojure version number ;;;;;;;;;;;;;;;;;;;;;;5464 (let [version-stream (.getResourceAsStream (clojure.lang.RT/baseLoader)5465 "clojure/version.properties")5466 properties (doto (new java.util.Properties) (.load version-stream))5467 prop (fn [k] (.getProperty properties (str "clojure.version." k)))5468 clojure-version {:major (Integer/valueOf ^String (prop "major"))5469 :minor (Integer/valueOf ^String (prop "minor"))5470 :incremental (Integer/valueOf ^String (prop "incremental"))5471 :qualifier (prop "qualifier")}]5472 (def *clojure-version*5473 (if (not (= (prop "interim") "false"))5474 (clojure.lang.RT/assoc clojure-version :interim true)5475 clojure-version)))5477 (add-doc-and-meta *clojure-version*5478 "The version info for Clojure core, as a map containing :major :minor5479 :incremental and :qualifier keys. Feature releases may increment5480 :minor and/or :major, bugfix releases will increment :incremental.5481 Possible values of :qualifier include \"GA\", \"SNAPSHOT\", \"RC-x\" \"BETA-x\""5482 {:added "1.0"})5484 (defn5485 clojure-version5486 "Returns clojure version as a printable string."5487 {:added "1.0"}5488 []5489 (str (:major *clojure-version*)5490 "."5491 (:minor *clojure-version*)5492 (when-let [i (:incremental *clojure-version*)]5493 (str "." i))5494 (when-let [q (:qualifier *clojure-version*)]5495 (when (pos? (count q)) (str "-" q)))5496 (when (:interim *clojure-version*)5497 "-SNAPSHOT")))5499 (defn promise5500 "Alpha - subject to change.5501 Returns a promise object that can be read with deref/@, and set,5502 once only, with deliver. Calls to deref/@ prior to delivery will5503 block. All subsequent derefs will return the same delivered value5504 without blocking."5505 {:added "1.1"}5506 []5507 (let [d (java.util.concurrent.CountDownLatch. 1)5508 v (atom nil)]5509 (reify5510 clojure.lang.IDeref5511 (deref [_] (.await d) @v)5512 clojure.lang.IFn5513 (invoke [this x]5514 (locking d5515 (if (pos? (.getCount d))5516 (do (reset! v x)5517 (.countDown d)5518 this)5519 (throw (IllegalStateException. "Multiple deliver calls to a promise"))))))))5521 (defn deliver5522 "Alpha - subject to change.5523 Delivers the supplied value to the promise, releasing any pending5524 derefs. A subsequent call to deliver on a promise will throw an exception."5525 {:added "1.1"}5526 [promise val] (promise val))5530 (defn flatten5531 "Takes any nested combination of sequential things (lists, vectors,5532 etc.) and returns their contents as a single, flat sequence.5533 (flatten nil) returns nil."5534 {:added "1.2"}5535 [x]5536 (filter (complement sequential?)5537 (rest (tree-seq sequential? seq x))))5539 (defn group-by5540 "Returns a map of the elements of coll keyed by the result of5541 f on each element. The value at each key will be a vector of the5542 corresponding elements, in the order they appeared in coll."5543 {:added "1.2"}5544 [f coll]5545 (persistent!5546 (reduce5547 (fn [ret x]5548 (let [k (f x)]5549 (assoc! ret k (conj (get ret k []) x))))5550 (transient {}) coll)))5552 (defn partition-by5553 "Applies f to each value in coll, splitting it each time f returns5554 a new value. Returns a lazy seq of partitions."5555 {:added "1.2"}5556 [f coll]5557 (lazy-seq5558 (when-let [s (seq coll)]5559 (let [fst (first s)5560 fv (f fst)5561 run (cons fst (take-while #(= fv (f %)) (rest s)))]5562 (cons run (partition-by f (drop (count run) s)))))))5564 (defn frequencies5565 "Returns a map from distinct items in coll to the number of times5566 they appear."5567 {:added "1.2"}5568 [coll]5569 (persistent!5570 (reduce (fn [counts x]5571 (assoc! counts x (inc (get counts x 0))))5572 (transient {}) coll)))5574 (defn reductions5575 "Returns a lazy seq of the intermediate values of the reduction (as5576 per reduce) of coll by f, starting with init."5577 {:added "1.2"}5578 ([f coll]5579 (lazy-seq5580 (if-let [s (seq coll)]5581 (reductions f (first s) (rest s))5582 (list (f)))))5583 ([f init coll]5584 (cons init5585 (lazy-seq5586 (when-let [s (seq coll)]5587 (reductions f (f init (first s)) (rest s)))))))5589 (defn rand-nth5590 "Return a random element of the (sequential) collection. Will have5591 the same performance characteristics as nth for the given5592 collection."5593 {:added "1.2"}5594 [coll]5595 (nth coll (rand-int (count coll))))5597 (defn partition-all5598 "Returns a lazy sequence of lists like partition, but may include5599 partitions with fewer than n items at the end."5600 {:added "1.2"}5601 ([n coll]5602 (partition-all n n coll))5603 ([n step coll]5604 (lazy-seq5605 (when-let [s (seq coll)]5606 (cons (take n s) (partition-all n step (drop step s)))))))5608 (defn shuffle5609 "Return a random permutation of coll"5610 {:added "1.2"}5611 [coll]5612 (let [al (java.util.ArrayList. coll)]5613 (java.util.Collections/shuffle al)5614 (clojure.lang.RT/vector (.toArray al))))5616 (defn map-indexed5617 "Returns a lazy sequence consisting of the result of applying f to 05618 and the first item of coll, followed by applying f to 1 and the second5619 item in coll, etc, until coll is exhausted. Thus function f should5620 accept 2 arguments, index and item."5621 {:added "1.2"}5622 [f coll]5623 (letfn [(mapi [idx coll]5624 (lazy-seq5625 (when-let [s (seq coll)]5626 (if (chunked-seq? s)5627 (let [c (chunk-first s)5628 size (int (count c))5629 b (chunk-buffer size)]5630 (dotimes [i size]5631 (chunk-append b (f (+ idx i) (.nth c i))))5632 (chunk-cons (chunk b) (mapi (+ idx size) (chunk-rest s))))5633 (cons (f idx (first s)) (mapi (inc idx) (rest s)))))))]5634 (mapi 0 coll)))5636 (defn keep5637 "Returns a lazy sequence of the non-nil results of (f item). Note,5638 this means false return values will be included. f must be free of5639 side-effects."5640 {:added "1.2"}5641 ([f coll]5642 (lazy-seq5643 (when-let [s (seq coll)]5644 (if (chunked-seq? s)5645 (let [c (chunk-first s)5646 size (count c)5647 b (chunk-buffer size)]5648 (dotimes [i size]5649 (let [x (f (.nth c i))]5650 (when-not (nil? x)5651 (chunk-append b x))))5652 (chunk-cons (chunk b) (keep f (chunk-rest s))))5653 (let [x (f (first s))]5654 (if (nil? x)5655 (keep f (rest s))5656 (cons x (keep f (rest s))))))))))5658 (defn keep-indexed5659 "Returns a lazy sequence of the non-nil results of (f index item). Note,5660 this means false return values will be included. f must be free of5661 side-effects."5662 {:added "1.2"}5663 ([f coll]5664 (letfn [(keepi [idx coll]5665 (lazy-seq5666 (when-let [s (seq coll)]5667 (if (chunked-seq? s)5668 (let [c (chunk-first s)5669 size (count c)5670 b (chunk-buffer size)]5671 (dotimes [i size]5672 (let [x (f (+ idx i) (.nth c i))]5673 (when-not (nil? x)5674 (chunk-append b x))))5675 (chunk-cons (chunk b) (keepi (+ idx size) (chunk-rest s))))5676 (let [x (f idx (first s))]5677 (if (nil? x)5678 (keepi (inc idx) (rest s))5679 (cons x (keepi (inc idx) (rest s)))))))))]5680 (keepi 0 coll))))5682 (defn fnil5683 "Takes a function f, and returns a function that calls f, replacing5684 a nil first argument to f with the supplied value x. Higher arity5685 versions can replace arguments in the second and third5686 positions (y, z). Note that the function f can take any number of5687 arguments, not just the one(s) being nil-patched."5688 {:added "1.2"}5689 ([f x]5690 (fn5691 ([a] (f (if (nil? a) x a)))5692 ([a b] (f (if (nil? a) x a) b))5693 ([a b c] (f (if (nil? a) x a) b c))5694 ([a b c & ds] (apply f (if (nil? a) x a) b c ds))))5695 ([f x y]5696 (fn5697 ([a b] (f (if (nil? a) x a) (if (nil? b) y b)))5698 ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) c))5699 ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) c ds))))5700 ([f x y z]5701 (fn5702 ([a b] (f (if (nil? a) x a) (if (nil? b) y b)))5703 ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c)))5704 ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c) ds)))))5706 (defn- ^{:dynamic true} assert-valid-fdecl5707 "A good fdecl looks like (([a] ...) ([a b] ...)) near the end of defn."5708 [fdecl]5709 (if-let [bad-args (seq (remove #(vector? %) (map first fdecl)))]5710 (throw (IllegalArgumentException. (str "Parameter declaration " (first bad-args) " should be a vector")))))