diff options
| -rw-r--r-- | src/boot.clj | 1727 |
1 files changed, 837 insertions, 890 deletions
diff --git a/src/boot.clj b/src/boot.clj index a45b8274..fb3d30d0 100644 --- a/src/boot.clj +++ b/src/boot.clj @@ -1051,98 +1051,89 @@ not-every? (comp not every?)) (recur (seq coll))))] (rep (seq coll))))) -(defn - #^{:doc "Returns a vector of [(take n coll) (drop n coll)]"} -split-at [n coll] - [(take n coll) (drop n coll)]) +(defn split-at + "Returns a vector of [(take n coll) (drop n coll)]" + [n coll] + [(take n coll) (drop n coll)]) -(defn - #^{:doc "Returns a vector of [(take-while pred coll) (drop-while pred coll)]"} -split-with [pred coll] - [(take-while pred coll) (drop-while pred coll)]) +(defn split-with + "Returns a vector of [(take-while pred coll) (drop-while pred coll)]" + [pred coll] + [(take-while pred coll) (drop-while pred coll)]) -(defn - #^{:doc "Returns a lazy (infinite!) seq of xs."} -repeat [x] - (lazy-cons x (repeat x))) +(defn repeat + "Returns a lazy (infinite!) seq of xs." + [x] (lazy-cons x (repeat x))) -(defn - #^{:doc "Returns a lazy seq of n xs."} -replicate [n x] - (take n (repeat x))) +(defn replicate + "Returns a lazy seq of n xs." + [n x] (take n (repeat x))) -(defn - #^{:doc "Returns a lazy seq of x, (f x), (f (f x)) etc."} -iterate [f x] - (lazy-cons x (iterate f (f x)))) - -(defn - #^{:doc "Returns a lazy seq of nums from start (inclusive) to end - (exclusive), by step, where start defaults to 0 and step - to 1."} -range - ([end] (take end (iterate inc 0))) - ([start end] (take (- end start) (iterate inc start))) - ([start end step] +(defn iterate + "Returns a lazy seq of x, (f x), (f (f x)) etc." + [f x] (lazy-cons x (iterate f (f x)))) + +(defn range + "Returns a lazy seq of nums from start (inclusive) to end + (exclusive), by step, where start defaults to 0 and step to 1." + ([end] (take end (iterate inc 0))) + ([start end] (take (- end start) (iterate inc start))) + ([start end step] (take-while (partial (if (pos? step) > <) end) (iterate (partial + step) start)))) -(defn - #^{:doc "Returns a map that consists of the rest of the maps - conj-ed onto the first. If a key occurs in more than one - map, the mapping from the latter (left-to-right) will be - the mapping in the result."} -merge [& maps] - (reduce conj maps)) - -(defn - #^{:doc "Returns a map that consists of the rest of the maps - conj-ed onto the first. If a key occurs in more than one - map, the mapping(s) from the latter (left-to-right) will - be combined with the mapping in the result by calling (f - val-in-result val-in-latter)."} -merge-with [f & maps] - (let [merge-entry (fn [m e] +(defn merge + "Returns a map that consists of the rest of the maps conj-ed onto + the first. If a key occurs in more than one map, the mapping from + the latter (left-to-right) will be the mapping in the result." + [& maps] (reduce conj maps)) + +(defn merge-with + "Returns a map that consists of the rest of the maps conj-ed onto + the first. If a key occurs in more than one map, the mapping(s) + from the latter (left-to-right) will be combined with the mapping in + the result by calling (f val-in-result val-in-latter)." + [f & maps] + (let [merge-entry (fn [m e] (let [k (key e) v (val e)] (if (contains? m k) (assoc m k (f (m k) v)) (assoc m k v)))) - merge2 (fn [m1 m2] + merge2 (fn [m1 m2] (reduce merge-entry m1 (seq m2)))] - (reduce merge2 maps))) + (reduce merge2 maps))) -(defn - #^{:doc "Returns a map with the keys mapped to the corresponding vals."} -zipmap [keys vals] - (loop [map {} - ks (seq keys) - vs (seq vals)] - (if (and ks vs) +(defn zipmap + "Returns a map with the keys mapped to the corresponding vals." + [keys vals] + (loop [map {} + ks (seq keys) + vs (seq vals)] + (if (and ks vs) (recur (assoc map (first ks) (first vs)) (rest ks) (rest vs)) - map))) - -(defn - #^{:doc "Returns the lines of text from rdr as a lazy sequence of - strings. rdr must implement java.io.BufferedReader."} -line-seq [#^java.io.BufferedReader rdr] - (let [line (. rdr (readLine))] - (when line - (lazy-cons line (line-seq rdr))))) - -(defn - #^{:doc "Returns an implementation of java.util.Comparator based - upon pred."} -comparator [pred] - (fn [x y] (cond (pred x y) -1 (pred y x) 1 :else 0))) + map))) + +(defn line-seq + "Returns the lines of text from rdr as a lazy sequence of strings. + rdr must implement java.io.BufferedReader." + [#^java.io.BufferedReader rdr] + (let [line (. rdr (readLine))] + (when line + (lazy-cons line (line-seq rdr))))) + +(defn comparator + "Returns an implementation of java.util.Comparator based upon pred." + [pred] + (fn [x y] + (cond (pred x y) -1 (pred y x) 1 :else 0))) -(defn - #^{:doc "Returns a sorted sequence of the items in coll. If no - comparator is supplied, the items must implement - Comparable. comparator must implement java.util.Comparator."} -sort +(defn sort + "Returns a sorted sequence of the items in coll. If no comparator is + supplied, the items must implement Comparable. comparator must + implement java.util.Comparator." ([#^java.util.Collection coll] (when (and coll (not (. coll (isEmpty)))) (let [a (. coll (toArray))] @@ -1154,33 +1145,30 @@ sort (. java.util.Arrays (sort a comp)) (seq a))))) -(defn - #^{:doc "Returns a sorted sequence of the items in coll, where the - sort order is determined by comparing (keyfn item). If no - comparator is supplied, the keys must implement - Comparable. comparator must implement java.util.Comparator."} -sort-by +(defn sort-by + "Returns a sorted sequence of the items in coll, where the sort + order is determined by comparing (keyfn item). If no comparator is + supplied, the keys must implement Comparable. comparator must + implement java.util.Comparator." ([keyfn coll] - (sort (fn [x y] (. #^Comparable (keyfn x) (compareTo (keyfn y)))) coll)) + (sort (fn [x y] (. #^Comparable (keyfn x) (compareTo (keyfn y)))) coll)) ([keyfn #^java.util.Comparator comp coll] - (sort (fn [x y] (. comp (compare (keyfn x) (keyfn y)))) coll))) + (sort (fn [x y] (. comp (compare (keyfn x) (keyfn y)))) coll))) ;; evaluation -(defn - #^{:doc "Evaluates the form data structure (not text!) and - returns the result."} -eval [form] - (. clojure.lang.Compiler (eval form))) +(defn eval + "Evaluates the form data structure (not text!) and returns the result." + [form] (. clojure.lang.Compiler (eval form))) ;(defn defimports [& imports-maps] ; (def *imports* (apply merge imports-maps))) -(defmacro - #^{:doc "Repeatedly executes body (presumably for side-effects) - with binding-form bound to successive items from coll. - Does not retain the head of the sequence. Returns nil."} -doseq [item list & body] +(defmacro doseq + "Repeatedly executes body (presumably for side-effects) with + binding-form bound to successive items from coll. Does not retain + the head of the sequence. Returns nil." + [item list & body] `(loop [list# (seq ~list)] (when list# (let [~item (first list#)] @@ -1190,30 +1178,26 @@ doseq [item list & body] (defn scan [& args] (throw (new Exception "scan is now called dorun"))) (defn touch [& args] (throw (new Exception "touch is now called doall"))) -(defn - #^{:doc "When lazy sequences are produced via functions that have - side effects, any effects other than those needed to - produce the first element in the seq do not occur until - the seq is consumed. dorun can be used to force any - effects. Walks through the successive rests of the seq, - does not retain the head and returns nil."} -dorun +(defn dorun + "When lazy sequences are produced via functions that have side + effects, any effects other than those needed to produce the first + element in the seq do not occur until the seq is consumed. dorun can + be used to force any effects. Walks through the successive rests of + the seq, does not retain the head and returns nil." ([coll] - (when (seq coll) - (recur (rest coll)))) + (when (seq coll) + (recur (rest coll)))) ([n coll] - (when (and (seq coll) (pos? n)) - (recur (dec n) (rest coll))))) - -(defn - #^{:doc "When lazy sequences are produced via functions that have - side effects, any effects other than those needed to - produce the first element in the seq do not occur until - the seq is consumed. doall can be used to force any - effects. Walks through the successive rests of the seq, - retains the head and returns it, thus causing the entire - seq to reside in memory at one time."} -doall + (when (and (seq coll) (pos? n)) + (recur (dec n) (rest coll))))) + +(defn doall + "When lazy sequences are produced via functions that have side + effects, any effects other than those needed to produce the first + element in the seq do not occur until the seq is consumed. doall can + be used to force any effects. Walks through the successive rests of + the seq, retains the head and returns it, thus causing the entire + seq to reside in memory at one time." ([coll] (dorun coll) coll) @@ -1221,72 +1205,71 @@ doall (dorun n coll) coll)) -(defn - #^{:doc "Blocks the current thread (indefinitely!) until all - actions dispatched thus far, from this thread or agent, to - the agent(s) have occurred."} -await [& agents] - (let [latch (new java.util.concurrent.CountDownLatch (count agents)) - count-down (fn [agent] (. latch (countDown)) agent)] - (doseq agent agents - (! agent count-down)) - (. latch (await)))) - -(defn - #^{:doc "Blocks the current thread until all actions dispatched - thus far (from this thread or agent) to the agents have - occurred, or the timeout (in milliseconds) has - elapsed. Returns nil if returning due to timeout, non-nil - otherwise."} -await-for [timeout-ms & agents] - (let [latch (new java.util.concurrent.CountDownLatch (count agents)) - count-down (fn [agent] (. latch (countDown)) agent)] - (doseq agent agents - (! agent count-down)) - (. latch (await timeout-ms (. java.util.concurrent.TimeUnit MILLISECONDS))))) +(defn await + "Blocks the current thread (indefinitely!) until all actions + dispatched thus far, from this thread or agent, to the agent(s) have + occurred." + [& agents] + (let [latch (new java.util.concurrent.CountDownLatch (count agents)) + count-down (fn [agent] (. latch (countDown)) agent)] + (doseq agent agents + (! agent count-down)) + (. latch (await)))) + +(defn await-for + "Blocks the current thread until all actions dispatched thus + far (from this thread or agent) to the agents have occurred, or the + timeout (in milliseconds) has elapsed. Returns nil if returning due + to timeout, non-nil otherwise." + [timeout-ms & agents] + (let [latch (new java.util.concurrent.CountDownLatch (count agents)) + count-down (fn [agent] (. latch (countDown)) agent)] + (doseq agent agents + (! agent count-down)) + (. latch (await timeout-ms (. java.util.concurrent.TimeUnit MILLISECONDS))))) -(defmacro - #^{:doc "Repeatedly executes body (presumably for side-effects) with - name bound to integers from 0 through n-1."} -dotimes [i n & body] +(defmacro dotimes + "Repeatedly executes body (presumably for side-effects) with name + bound to integers from 0 through n-1." + [i n & body] `(loop [~i 0 n# ~n] (when (< ~i n#) ~@body (recur (inc ~i) n#)))) -(defn - #^{:doc "import-list => (package-symbol class-name-symbols*) - For each name in class-name-symbols, adds a mapping from - name to the class named by package.name to the current - namespace."} -import [& import-lists] - (when import-lists - (let [#^clojure.lang.Namespace ns *ns* - pkg (ffirst import-lists) - classes (rfirst import-lists)] - (doseq c classes - (. ns (importClass c (. Class (forName (str pkg "." c)))))) ) - (apply import (rest import-lists)))) - -(defn - #^{:doc "Returns an array of the type of the first element in - coll, containing the contents of coll, which must be of a - compatible type."} -into-array [aseq] - (. clojure.lang.RT (seqToTypedArray (seq aseq)))) - -(defn - #^{:doc "Returns a new coll consisting of to-coll with all - of the items of from-coll conjoined."} -into [to from] - (let [ret to items (seq from)] - (if items - (recur (conj ret (first items)) (rest items)) - ret))) +(defn import + "import-list => (package-symbol class-name-symbols*) + + For each name in class-name-symbols, adds a mapping from name to the + class named by package.name to the current namespace." + [& import-lists] + (when import-lists + (let [#^clojure.lang.Namespace ns *ns* + pkg (ffirst import-lists) + classes (rfirst import-lists)] + (doseq c classes + (. ns (importClass c (. Class (forName (str pkg "." c)))))) ) + (apply import (rest import-lists)))) + +(defn into-array + "Returns an array of the type of the first element in coll, + containing the contents of coll, which must be of a compatible + type." + [aseq] + (. clojure.lang.RT (seqToTypedArray (seq aseq)))) + +(defn into + "Returns a new coll consisting of to-coll with all of the items of + from-coll conjoined." + [to from] + (let [ret to items (seq from)] + (if items + (recur (conj ret (first items)) (rest items)) + ret))) (defn #^{:private true} -array [& items] - (into-array items)) + array [& items] + (into-array items)) (defn make-proxy [classes method-map] @@ -1295,32 +1278,32 @@ make-proxy [classes method-map] (into-array classes) (new clojure.lang.ProxyHandler method-map)))) -(defmacro - #^{:doc "f => (name [args+] body) - Expands to code which creates a instance of a class that - implements the named interface(s) by calling the supplied - fns. The interface names must be valid class names of - interface types. If a method is not provided for a - non-void-returning interface method, an - UnsupportedOperationException will be thrown should it be - called. Method fns are closures and can capture the - environment in which implement is called. "} -implement [interfaces & fs] +(defmacro implement + "f => (name [args+] body) + + Deprecated - use proxy. + Expands to code which creates a instance of a class that implements + the named interface(s) by calling the supplied fns. The interface + names must be valid class names of interface types. If a method is + not provided for a non-void-returning interface method, an + UnsupportedOperationException will be thrown should it be called. + Method fns are closures and can capture the environment in which + implement is called." + [interfaces & fs] `(make-proxy - ~interfaces - ~(loop [fmap {} fs fs] - (if fs - (recur (assoc fmap (name (ffirst fs)) - (cons `fn (rfirst fs))) - (rest fs)) - fmap)))) - -(defn - #^{:doc "Prints the object(s) to the output stream that is the - current value of *out*. Prints the object(s), separated - by spaces if there is more than one. By default, pr and - prn print in a way that objects can be read by the reader"} -pr + ~interfaces + ~(loop [fmap {} fs fs] + (if fs + (recur (assoc fmap (name (ffirst fs)) + (cons `fn (rfirst fs))) + (rest fs)) + fmap)))) + +(defn pr + "Prints the object(s) to the output stream that is the current value + of *out*. Prints the object(s), separated by spaces if there is + more than one. By default, pr and prn print in a way that objects + can be read by the reader" ([] nil) ([x] (. clojure.lang.RT (print x *out*)) @@ -1330,145 +1313,145 @@ pr (. *out* (append \space)) (apply pr more))) -(defn - #^{:doc "Writes a newline to the output stream that is - the current value of *out*"} -newline [] - (. *out* (append \newline)) - nil) - -(defn - #^{:doc "Same as pr followed by (newline)"} -prn [& more] - (apply pr more) - (newline)) - -(defn - #^{:doc "Prints the object(s) to the output stream that is the - current value of *out*. print and println produce output - for human consumption."} -print [& more] - (binding [*print-readably* nil] - (apply pr more))) - -(defn - #^{:doc "Same as print followed by (newline)"} -println [& more] - (binding [*print-readably* nil] - (apply prn more))) - - -(defn - #^{:doc "Reads the next object from stream, which must be an - instance of java.io.PushbackReader or some derivee. - stream defaults to the current value of *in* ."} -read +(defn newline + "Writes a newline to the output stream that is the current value of + *out*" + [] + (. *out* (append \newline)) + nil) + +(defn prn + "Same as pr followed by (newline)" + [& more] + (apply pr more) + (newline)) + +(defn print + "Prints the object(s) to the output stream that is the current value + of *out*. print and println produce output for human consumption." + [& more] + (binding [*print-readably* nil] + (apply pr more))) + +(defn println + "Same as print followed by (newline)" + [& more] + (binding [*print-readably* nil] + (apply prn more))) + + +(defn read + "Reads the next object from stream, which must be an instance of + java.io.PushbackReader or some derivee. stream defaults to the + current value of *in* ." ([] - (read *in*)) + (read *in*)) ([stream] - (read stream true nil)) + (read stream true nil)) ([stream eof-error? eof-value] - (read stream eof-error? eof-value false)) + (read stream eof-error? eof-value false)) ([stream eof-error? eof-value recursive?] - (. clojure.lang.LispReader (read stream eof-error? eof-value recursive?)))) + (. clojure.lang.LispReader (read stream eof-error? eof-value recursive?)))) -(defmacro - #^{:doc "Evaluates body in a try expression with name bound to the - value of init, and a finally clause that calls (. name - (close))."} -with-open [name init & body] +(defmacro with-open + "Evaluates body in a try expression with name bound to the value of + init, and a finally clause that calls (. name (close))." + [name init & body] `(let [~name ~init] (try ~@body (finally - (. ~name (close)))))) - -(defmacro - #^{:doc "Evaluates x then calls all of the methods with the - supplied arguments in succession on the resulting object, - returning it. - - (doto (new java.util.HashMap) (put \"a\" 1) (put \"b\" 2))"} -doto [x & members] - (let [gx (gensym)] - `(let [~gx ~x] - (do - ~@(map (fn [m] (list '. gx m)) - members)) - ~gx))) - -(defmacro - #^{:doc "Expands into code that creates a fn that expects to be - passed an object and any args and calls the named instance - method on the object passing the args. Use when you want - to treat a Java method as a first-class fn."} -memfn [name & args] + (. ~name (close)))))) + +(defmacro doto + "Evaluates x then calls all of the methods with the supplied + arguments in succession on the resulting object, returning it. + + (doto (new java.util.HashMap) (put \"a\" 1) (put \"b\" 2))" + [x & members] + (let [gx (gensym)] + `(let [~gx ~x] + (do + ~@(map (fn [m] (list '. gx m)) + members)) + ~gx))) + +(defmacro memfn + "Expands into code that creates a fn that expects to be passed an + object and any args and calls the named instance method on the + object passing the args. Use when you want to treat a Java method as + a first-class fn." + [name & args] `(fn [target# ~@args] - (. target# (~name ~@args)))) - -(defmacro - #^{:doc "Evaluates expr and prints the time it took. - Returns the value of expr."} -time [expr] - `(let [start# (. System (nanoTime)) - ret# ~expr] - (prn (str "Elapsed time: " (/ (- (. System (nanoTime)) start#) 1000000.0) " msecs")) - ret#)) - - -(defn #^{:tag Integer :doc "Coerce to int"} -int [x] - (. clojure.lang.RT (intCast x))) - -(defn #^{:tag Long :doc "Coerce to long"} -long [#^Number x] - (. x (longValue))) - -(defn #^{:tag Float :doc "Coerce to float"} -float [#^Number x] - (. x (floatValue))) - -(defn #^{:tag Double :doc "Coerce to double"} -double [#^Number x] - (. x (doubleValue))) - -(defn #^{:tag Short :doc "Coerce to short"} -short [#^Number x] - (. x (shortValue))) - -(defn #^{:tag Byte :doc "Coerce to byte"} -byte [#^Number x] - (. x (byteValue))) - -(defn #^{:tag Character :doc "Coerce to char"} -char [x] - (. clojure.lang.RT (charCast x))) - -(defn #^{:tag Boolean :doc "Coerce to boolean"} -boolean [x] - (if x true false)) + (. target# (~name ~@args)))) + +(defmacro time + "Evaluates expr and prints the time it took. Returns the value of + expr." + [expr] + `(let [start# (. System (nanoTime)) + ret# ~expr] + (prn (str "Elapsed time: " (/ (- (. System (nanoTime)) start#) 1000000.0) " msecs")) + ret#)) + +(defn int + "Coerce to int" + {:tag Integer} + [x] (. clojure.lang.RT (intCast x))) + +(defn long + "Coerce to long" + {:tag Long} + [#^Number x] (. x (longValue))) + +(defn float + "Coerce to float" + {:tag Float} + [#^Number x] (. x (floatValue))) + +(defn double + "Coerce to double" + {:tag Double} + [#^Number x] (. x (doubleValue))) + +(defn short + "Coerce to short" + {:tag Short} + [#^Number x] (. x (shortValue))) + +(defn byte + "Coerce to byte" + {:tag Byte} + [#^Number x] (. x (byteValue))) + +(defn char + "Coerce to char" + {:tag Character} + [x] (. clojure.lang.RT (charCast x))) + +(defn boolean + "Coerce to boolean" + {:tag Boolean} + [x] (if x true false)) (import '(java.lang.reflect Array)) -(defn - #^{:doc "Returns the length of the Java array. Works on arrays - of all types."} -alength [array] - (. Array (getLength array))) +(defn alength + "Returns the length of the Java array. Works on arrays of all + types." + [array] (. Array (getLength array))) -(defn - #^{:doc "Returns the value at the index/indices. Works on Java arrays - of all types."} -aget +(defn aget + "Returns the value at the index/indices. Works on Java arrays of all + types." ([array idx] (. Array (get array idx))) ([array idx & idxs] (apply aget (aget array idx) idxs))) -(defn - #^{:doc "Sets the value at the index/indices. Works on Java arrays - of reference types. Returns val."} -aset +(defn aset + "Sets the value at the index/indices. Works on Java arrays of + reference types. Returns val." ([array idx val] (. Array (set array idx val)) val) @@ -1476,85 +1459,81 @@ aset (apply aset (aget array idx) idx2 idxv))) (defmacro -#^{:private true} -def-aset [name method coerce] - `(defn ~name - ([array# idx# val#] - (. Array (~method array# idx# (~coerce val#))) - val#) - ([array# idx# idx2# & idxv#] - (apply ~name (aget array# idx#) idx2# idxv#)))) + #^{:private true} + def-aset [name method coerce] + `(defn ~name + ([array# idx# val#] + (. Array (~method array# idx# (~coerce val#))) + val#) + ([array# idx# idx2# & idxv#] + (apply ~name (aget array# idx#) idx2# idxv#)))) (def-aset - #^{:doc "Sets the value at the index/indices. Works on arrays of int. - Returns val."} -aset-int setInt int) -(def-aset - #^{:doc "Sets the value at the index/indices. Works on arrays of long. - Returns val."} -aset-long setLong long) + #^{:doc "Sets the value at the index/indices. Works on arrays of int. Returns val."} + aset-int setInt int) + (def-aset - #^{:doc "Sets the value at the index/indices. Works on arrays of boolean. - Returns val."} -aset-boolean setBoolean boolean) + #^{:doc "Sets the value at the index/indices. Works on arrays of long. Returns val."} + aset-long setLong long) + (def-aset - #^{:doc "Sets the value at the index/indices. Works on arrays of float. - Returns val."} -aset-float setFloat float) + #^{:doc "Sets the value at the index/indices. Works on arrays of boolean. Returns val."} + aset-boolean setBoolean boolean) + (def-aset - #^{:doc "Sets the value at the index/indices. Works on arrays of double. - Returns val."} -aset-double setDouble double) + #^{:doc "Sets the value at the index/indices. Works on arrays of float. Returns val."} + aset-float setFloat float) + (def-aset - #^{:doc "Sets the value at the index/indices. Works on arrays of short. - Returns val."} -aset-short setShort short) + #^{:doc "Sets the value at the index/indices. Works on arrays of double. Returns val."} + aset-double setDouble double) + (def-aset - #^{:doc "Sets the value at the index/indices. Works on arrays of byte. - Returns val."} -aset-byte setByte byte) + #^{:doc "Sets the value at the index/indices. Works on arrays of short. Returns val."} + aset-short setShort short) + (def-aset - #^{:doc "Sets the value at the index/indices. Works on arrays of char. - Returns val."} -aset-char setChar char) + #^{:doc "Sets the value at the index/indices. Works on arrays of byte. Returns val."} + aset-byte setByte byte) -(defn - #^{:doc "Creates and returns an array of instances of the - specified class of the specified dimension(s). Note that - a class object is required. - Class objects can be obtained by using their imported or - fully-qualified name. Class objects for the primitive - types can be obtained using, e.g., (. Integer TYPE)."} -make-array +(def-aset + #^{:doc "Sets the value at the index/indices. Works on arrays of char. Returns val."} + aset-char setChar char) + +(defn make-array + "Creates and returns an array of instances of the specified class of + the specified dimension(s). Note that a class object is required. + Class objects can be obtained by using their imported or + fully-qualified name. Class objects for the primitive types can be + obtained using, e.g., (. Integer TYPE)." ([#^Class type len] - (. Array (newInstance type (int len)))) + (. Array (newInstance type (int len)))) ([#^Class type dim & more-dims] - (let [dims (cons dim more-dims) - #^"[I" dimarray (make-array (. Integer TYPE) (count dims))] - (dotimes i (alength dimarray) - (aset-int dimarray i (nth dims i))) - (. Array (newInstance type dimarray))))) - -(defn - #^{:doc "Returns an array of Objects containing the contents of - coll, which can be any Collection. Maps to - java.util.Collection.toArray()."} -to-array [#^java.util.Collection coll] - (if (zero? (count coll)) - (. clojure.lang.RT EMPTY_ARRAY) - (. coll (toArray)))) - -(defn - #^{:doc "Returns a (potentially-ragged) 2-dimensional array of - Objects containing the contents of coll, which can be any - Collection of any Collection."} -to-array-2d [#^java.util.Collection coll] - (let [ret (make-array (. Class (forName "[Ljava.lang.Object;")) (. coll (size)))] - (loop [i 0 xs (seq coll)] - (when xs - (aset ret i (to-array (first xs))) - (recur (inc i) (rest xs)))) - ret)) + (let [dims (cons dim more-dims) + #^"[I" dimarray (make-array (. Integer TYPE) (count dims))] + (dotimes i (alength dimarray) + (aset-int dimarray i (nth dims i))) + (. Array (newInstance type dimarray))))) + +(defn to-array + "Returns an array of Objects containing the contents of coll, which + can be any Collection. Maps to java.util.Collection.toArray()." + [#^java.util.Collection coll] + (if (zero? (count coll)) + (. clojure.lang.RT EMPTY_ARRAY) + (. coll (toArray)))) + +(defn to-array-2d + "Returns a (potentially-ragged) 2-dimensional array of Objects + containing the contents of coll, which can be any Collection of any + Collection." + [#^java.util.Collection coll] + (let [ret (make-array (. Class (forName "[Ljava.lang.Object;")) (. coll (size)))] + (loop [i 0 xs (seq coll)] + (when xs + (aset ret i (to-array (first xs))) + (recur (inc i) (rest xs)))) + ret)) (import '(java.util.concurrent Executors LinkedBlockingQueue)) @@ -1595,245 +1574,231 @@ to-array-2d [#^java.util.Collection coll] (thisfn (map rest collseq)))))] (encl-fn (cons coll colls)))))) -(defn - #^{:doc "If form represents a macro form, returns its expansion, - else returns form."} -macroexpand-1 [form] - (let [v (. clojure.lang.Compiler (isMacro (first form)))] - (if v - (apply @v (rest form)) - form))) - -(defn - #^{:doc "Repeatedly calls macroexpand-1 on form until it no longer - represents a macro form, then returns it. Note neither - macroexpand-1 nor macroexpand expand macros in subforms."} -macroexpand [form] - (let [ex (macroexpand-1 form) - v (. clojure.lang.Compiler (isMacro (first ex)))] - (if v - (macroexpand ex) - ex))) - -(defn - #^{:doc "Returns a structure basis object."} -create-struct [& keys] - (. clojure.lang.PersistentStructMap (createSlotMap keys))) - -(defmacro - #^{:doc "Same as (def name (create-struct keys...))"} -defstruct [name & keys] +(defn macroexpand-1 + "If form represents a macro form, returns its expansion, + else returns form." + [form] + (let [v (. clojure.lang.Compiler (isMacro (first form)))] + (if v + (apply @v (rest form)) + form))) + +(defn macroexpand + "Repeatedly calls macroexpand-1 on form until it no longer + represents a macro form, then returns it. Note neither + macroexpand-1 nor macroexpand expand macros in subforms." + [form] + (let [ex (macroexpand-1 form) + v (. clojure.lang.Compiler (isMacro (first ex)))] + (if v + (macroexpand ex) + ex))) + +(defn create-struct + "Returns a structure basis object." + [& keys] + (. clojure.lang.PersistentStructMap (createSlotMap keys))) + +(defmacro defstruct + "Same as (def name (create-struct keys...))" + [name & keys] `(def ~name (create-struct ~@keys))) -(defn - #^{:doc "Returns a new structmap instance with the keys of the - structure-basis. keyvals may contain all, some or none of - the basis keys - where values are not supplied they will - default to nil. keyvals can also contain keys not in the - basis."} -struct-map [s & inits] - (. clojure.lang.PersistentStructMap (create s inits))) - -(defn - #^{:doc "Returns a new structmap instance with the keys of the - structure-basis. vals must be supplied for basis keys in - order - where values are not supplied they will default to - nil."} -struct [s & vals] - (. clojure.lang.PersistentStructMap (construct s vals))) - -(defn - #^{:doc "Returns a fn that, given an instance of a structmap with - the basis, returns the value at the key. The key must be - in the basis. The returned function should be (slightly) - more efficient than using get, but such use of accessors - should be limited to known performance-critical areas."} -accessor [s key] - (. clojure.lang.PersistentStructMap (getAccessor s key))) - -(defn - #^{:doc "Returns a persistent vector of the items in vector from - start (inclusive) to end (exclusive). If end is not - supplied, defaults to (count vector). This operation is - O(1) and very fast, as the resulting vector shares - structure with the original and no trimming is done."} -subvec +(defn struct-map + "Returns a new structmap instance with the keys of the + structure-basis. keyvals may contain all, some or none of the basis + keys - where values are not supplied they will default to nil. + keyvals can also contain keys not in the basis." + [s & inits] + (. clojure.lang.PersistentStructMap (create s inits))) + +(defn struct + "Returns a new structmap instance with the keys of the + structure-basis. vals must be supplied for basis keys in order - + where values are not supplied they will default to nil." + [s & vals] + (. clojure.lang.PersistentStructMap (construct s vals))) + +(defn accessor + "Returns a fn that, given an instance of a structmap with the basis, + returns the value at the key. The key must be in the basis. The + returned function should be (slightly) more efficient than using + get, but such use of accessors should be limited to known + performance-critical areas." + [s key] + (. clojure.lang.PersistentStructMap (getAccessor s key))) + +(defn subvec + "Returns a persistent vector of the items in vector from + start (inclusive) to end (exclusive). If end is not supplied, + defaults to (count vector). This operation is O(1) and very fast, as + the resulting vector shares structure with the original and no + trimming is done." ([v start] - (subvec v start (count v))) + (subvec v start (count v))) ([v start end] - (. clojure.lang.RT (subvec v start end)))) - -(defn - #^{:doc "sequentially read and evaluate the set of forms contained - in the stream/file"} -load [rdr] - (. clojure.lang.Compiler (load rdr))) - -(defn - #^{:doc "Creates and returns a lazy sequence of structmaps corresponding - to the rows in the java.sql.ResultSet rs"} -resultset-seq [#^java.sql.ResultSet rs] - (let [rsmeta (. rs (getMetaData)) - idxs (range 1 (inc (. rsmeta (getColumnCount)))) - keys (map (comp keyword (memfn toLowerCase)) - (map (fn [i] (. rsmeta (getColumnName i))) idxs)) - row-struct (apply create-struct keys) - row-values (fn [] (map (fn [#^Integer i] (. rs (getObject i))) idxs)) - rows (fn thisfn [] - (when (. rs (next)) + (. clojure.lang.RT (subvec v start end)))) + +(defn load + "Sequentially read and evaluate the set of forms contained in the + stream/file" + [rdr] (. clojure.lang.Compiler (load rdr))) + +(defn resultset-seq + "Creates and returns a lazy sequence of structmaps corresponding to + the rows in the java.sql.ResultSet rs" + [#^java.sql.ResultSet rs] + (let [rsmeta (. rs (getMetaData)) + idxs (range 1 (inc (. rsmeta (getColumnCount)))) + keys (map (comp keyword (memfn toLowerCase)) + (map (fn [i] (. rsmeta (getColumnName i))) idxs)) + row-struct (apply create-struct keys) + row-values (fn [] (map (fn [#^Integer i] (. rs (getObject i))) idxs)) + rows (fn thisfn [] + (when (. rs (next)) (fnseq (apply struct row-struct (row-values)) thisfn)))] - (rows))) + (rows))) -(defn - #^{:doc "Returns a map of the distinct elements of coll to true."} -set [coll] - (apply hash-set coll)) +(defn set + "Returns a set of the distinct elements of coll." + [coll] (apply hash-set coll)) -(defn - #^{:doc "Returns a sequence of the elements of coll with - duplicates removed"} -distinct [coll] - (seq (set coll))) +(defn distinct + "Returns a sequence of the elements of coll with duplicates removed" + [coll] (seq (set coll))) (defn #^{:private true} -filter-key [keyfn pred amap] - (loop [ret {} es (seq amap)] - (if es - (if (pred (keyfn (first es))) - (recur (assoc ret (key (first es)) (val (first es))) (rest es)) - (recur ret (rest es))) - ret))) + filter-key [keyfn pred amap] + (loop [ret {} es (seq amap)] + (if es + (if (pred (keyfn (first es))) + (recur (assoc ret (key (first es)) (val (first es))) (rest es)) + (recur ret (rest es))) + ret))) -(defn - #^{:doc "Returns the namespace named by the symbol or nil if - it doesn't exist."} -find-ns [sym] - (. clojure.lang.Namespace (find sym))) +(defn find-ns + "Returns the namespace named by the symbol or nil if it doesn't exist." + [sym] (. clojure.lang.Namespace (find sym))) -(defn - #^{:doc "Create a new namespace named by the symbol if one doesn't - already exist, returns it or the already-existing - namespace of the same name."} -create-ns [sym] - (. clojure.lang.Namespace (findOrCreate sym))) +(defn create-ns + "Create a new namespace named by the symbol if one doesn't already + exist, returns it or the already-existing namespace of the same + name." + [sym] (. clojure.lang.Namespace (findOrCreate sym))) -(defn - #^{:doc "Removes the namespace named by the symbol. Use with - caution. Cannot be used to remove the clojure namespace."} -remove-ns [sym] - (. clojure.lang.Namespace (remove sym))) +(defn remove-ns + "Removes the namespace named by the symbol. Use with caution. + Cannot be used to remove the clojure namespace." + [sym] (. clojure.lang.Namespace (remove sym))) -(defn - #^{:doc "Returns a sequence of all namespaces."} -all-ns [] - (. clojure.lang.Namespace (all))) +(defn all-ns + "Returns a sequence of all namespaces." + [] (. clojure.lang.Namespace (all))) -(defn - #^{:doc "Returns the name of the namespace, a symbol."} -ns-name [#^clojure.lang.Namespace ns] - (. ns (getName))) +(defn ns-name + "Returns the name of the namespace, a symbol." + [#^clojure.lang.Namespace ns] + (. ns (getName))) -(defn - #^{:doc "Returns a map of all the mappings for the namespace."} -ns-map [#^clojure.lang.Namespace ns] - (. ns (getMappings))) +(defn ns-map + "Returns a map of all the mappings for the namespace." + [#^clojure.lang.Namespace ns] + (. ns (getMappings))) -(defn - #^{:doc "Removes the mappings for the symbol from the namespace."} -ns-unmap [#^clojure.lang.Namespace ns sym] - (. ns (unmap sym))) +(defn ns-unmap + "Removes the mappings for the symbol from the namespace." + [#^clojure.lang.Namespace ns sym] + (. ns (unmap sym))) ;(defn export [syms] ; (doseq sym syms ; (.. *ns* (intern sym) (setExported true)))) -(defn - #^{:doc "Returns a map of the public intern mappings for the namespace."} -ns-publics [#^clojure.lang.Namespace ns] - (filter-key val (fn [v] (and (instance? clojure.lang.Var v) - (= ns (. v ns)) - (. v (isPublic)))) - (ns-map ns))) - -(defn - #^{:doc "Returns a map of the import mappings for the namespace."} -ns-imports [#^clojure.lang.Namespace ns] - (filter-key val (partial instance? Class) (ns-map ns))) - -(defn - #^{:doc "refers to all public vars of ns, subject to filters. - filters can include at most one each of: - - :exclude list-of-symbols - :only list-of-symbols - :rename map-of-fromsymbol-tosymbol - - For each public interned var in the namespace named by the - symbol, adds a mapping from the name of the var to the var - to the current namespace. Throws an exception if name is - already mapped to something else in the current - namespace. Filters can be used to select a subset, via - inclusion or exclusion, or to provide a mapping to a - symbol different from the var's name, in order to prevent - clashes."} -refer [ns-sym & filters] - (let [ns (or (find-ns ns-sym) (throw (new Exception (str "No namespace: " ns-sym)))) - fs (apply hash-map filters) - nspublics (ns-publics ns) - rename (or (:rename fs) {}) - exclude (set (:exclude fs)) - to-do (or (:only fs) (keys nspublics))] - (doseq sym to-do - (when-not (exclude sym) - (let [v (nspublics sym)] - (when-not v - (throw (new java.lang.IllegalAccessError (str sym " is not public")))) - (. *ns* (refer (or (rename sym) sym) v))))))) - -(defn - #^{:doc "Returns a map of the refer mappings for the namespace."} -ns-refers [#^clojure.lang.Namespace ns] - (filter-key val (fn [v] (and (instance? clojure.lang.Var v) - (not= ns (. v ns)))) - (ns-map ns))) - -(defn - #^{:doc "Returns a map of the intern mappings for the namespace."} -ns-interns [#^clojure.lang.Namespace ns] - (filter-key val (fn [v] (and (instance? clojure.lang.Var v) - (= ns (. v ns)))) - (ns-map ns))) - -(defn - #^{:doc "Returns a lazy seq of every nth item in coll."} -take-nth [n coll] - (when (seq coll) - (lazy-cons (first coll) (take-nth n (drop n coll))))) - -(defn - #^{:doc "Returns a lazy seq of the first item in each coll, - then the second etc."} -interleave [& colls] - (apply concat (apply map list colls))) - -(defn - #^{:doc "Gets the value in the var object"} -var-get [#^clojure.lang.Var x] - (. x (get))) - -(defn - #^{:doc "Sets the value in the var object to val. The var - must be thread-locally bound."} -var-set [#^clojure.lang.Var x val] - (. x (set val))) - -(defmacro - #^{:doc "varbinding=> symbol init-expr - Executes the exprs in a context in which the symbols are - bound to vars with per-thread bindings to the init-exprs. - The symbols refer to the var objects themselves, and must - be accessed with var-get and var-set"} -with-local-vars [name-vals-vec & body] +(defn ns-publics + "Returns a map of the public intern mappings for the namespace." + [#^clojure.lang.Namespace ns] + (filter-key val (fn [v] (and (instance? clojure.lang.Var v) + (= ns (. v ns)) + (. v (isPublic)))) + (ns-map ns))) + +(defn ns-imports + "Returns a map of the import mappings for the namespace." + [#^clojure.lang.Namespace ns] + (filter-key val (partial instance? Class) (ns-map ns))) + +(defn refer + "refers to all public vars of ns, subject to filters. + filters can include at most one each of: + + :exclude list-of-symbols + :only list-of-symbols + :rename map-of-fromsymbol-tosymbol + + For each public interned var in the namespace named by the symbol, + adds a mapping from the name of the var to the var to the current + namespace. Throws an exception if name is already mapped to + something else in the current namespace. Filters can be used to + select a subset, via inclusion or exclusion, or to provide a mapping + to a symbol different from the var's name, in order to prevent + clashes." + [ns-sym & filters] + (let [ns (or (find-ns ns-sym) (throw (new Exception (str "No namespace: " ns-sym)))) + fs (apply hash-map filters) + nspublics (ns-publics ns) + rename (or (:rename fs) {}) + exclude (set (:exclude fs)) + to-do (or (:only fs) (keys nspublics))] + (doseq sym to-do + (when-not (exclude sym) + (let [v (nspublics sym)] + (when-not v + (throw (new java.lang.IllegalAccessError (str sym " is not public")))) + (. *ns* (refer (or (rename sym) sym) v))))))) + +(defn ns-refers + "Returns a map of the refer mappings for the namespace." + [#^clojure.lang.Namespace ns] + (filter-key val (fn [v] (and (instance? clojure.lang.Var v) + (not= ns (. v ns)))) + (ns-map ns))) + +(defn ns-interns + "Returns a map of the intern mappings for the namespace." + [#^clojure.lang.Namespace ns] + (filter-key val (fn [v] (and (instance? clojure.lang.Var v) + (= ns (. v ns)))) + (ns-map ns))) + +(defn take-nth + "Returns a lazy seq of every nth item in coll." + [n coll] + (when (seq coll) + (lazy-cons (first coll) (take-nth n (drop n coll))))) + +(defn interleave + "Returns a lazy seq of the first item in each coll, then the second + etc." + [& colls] + (apply concat (apply map list colls))) + +(defn var-get + "Gets the value in the var object" + [#^clojure.lang.Var x] (. x (get))) + +(defn var-set + "Sets the value in the var object to val. The var must be + thread-locally bound." + [#^clojure.lang.Var x val] (. x (set val))) + +(defmacro with-local-vars + "varbinding=> symbol init-expr + + Executes the exprs in a context in which the symbols are bound to + vars with per-thread bindings to the init-exprs. The symbols refer + to the var objects themselves, and must be accessed with var-get and + var-set" + [name-vals-vec & body] `(let [~@(interleave (take-nth 2 name-vals-vec) (repeat '(. clojure.lang.Var (create))))] (try @@ -1841,44 +1806,38 @@ with-local-vars [name-vals-vec & body] ~@body (finally (. clojure.lang.Var (popThreadBindings)))))) -(defn - #^{:doc "Returns the var or Class to which a symbol will be - resolved in the namespace, else nil. Note that if the - symbol is fully qualified, the var/Class to which it - resolves need not be present in the namespace."} -ns-resolve [ns sym] - (. clojure.lang.Compiler (maybeResolveIn ns sym))) - -(defn - #^{:doc "same as (ns-resolve *ns* symbol)"} -resolve [sym] - (ns-resolve *ns* sym)) - -(defn - #^{:doc "Constructs an array-map."} -array-map - ([] (. clojure.lang.PersistentArrayMap EMPTY)) - ([& keyvals] (new clojure.lang.PersistentArrayMap (to-array keyvals)))) - -(defn - #^{:doc "Returns the nth rest of coll, (seq coll) when n is 0."} -nthrest [coll n] - (loop [n n xs (seq coll)] - (if (and xs (pos? n)) - (recur (dec n) (rest xs)) - xs))) - - - -(defn - #^{:doc "Return true if x is a Symbol"} -symbol? [x] - (instance? clojure.lang.Symbol x)) - -(defn - #^{:doc "Return true if x is a Keyword"} -keyword? [x] - (instance? clojure.lang.Keyword x)) +(defn ns-resolve + "Returns the var or Class to which a symbol will be resolved in the + namespace, else nil. Note that if the symbol is fully qualified, + the var/Class to which it resolves need not be present in the + namespace." + [ns sym] + (. clojure.lang.Compiler (maybeResolveIn ns sym))) + +(defn resolve + "same as (ns-resolve *ns* symbol)" + [sym] (ns-resolve *ns* sym)) + +(defn array-map + "Constructs an array-map." + ([] (. clojure.lang.PersistentArrayMap EMPTY)) + ([& keyvals] (new clojure.lang.PersistentArrayMap (to-array keyvals)))) + +(defn nthrest + "Returns the nth rest of coll, (seq coll) when n is 0." + [coll n] + (loop [n n xs (seq coll)] + (if (and xs (pos? n)) + (recur (dec n) (rest xs)) + xs))) + +(defn symbol? + "Return true if x is a Symbol" + [x] (instance? clojure.lang.Symbol x)) + +(defn keyword? + "Return true if x is a Keyword" + [x] (instance? clojure.lang.Keyword x)) ;redefine let and loop with destructuring (defn destructure [bindings] @@ -1931,40 +1890,39 @@ keyword? [x] bindings (reduce process-entry [] bmap)))) -(defmacro - #^{:doc "Evaluates the exprs in a lexical context in which the - symbols in the binding-forms are bound to their respective - init-exprs or parts therein."} -let [bindings & body] +(defmacro let + "Evaluates the exprs in a lexical context in which the symbols in + the binding-forms are bound to their respective init-exprs or parts + therein." + [bindings & body] `(let* ~(destructure bindings) ~@body)) -(defmacro - #^{:doc "Evaluates the exprs in a lexical context in which the - symbols in the binding-forms are bound to their respective - init-exprs or parts therein. Acts as a recur target."} -loop [bindings & body] - (let [db (destructure bindings)] - (if (= db bindings) - `(loop* ~bindings ~@body) - (let [vs (take-nth 2 (drop 1 bindings)) - gs (map (fn [x] (gensym)) vs) - ds (take-nth 2 bindings)] - `(loop* ~(apply vector (interleave gs vs)) - (let ~(apply vector (interleave ds gs)) - ~@body)))))) +(defmacro loop + "Evaluates the exprs in a lexical context in which the symbols in + the binding-forms are bound to their respective init-exprs or parts + therein. Acts as a recur target." + [bindings & body] + (let [db (destructure bindings)] + (if (= db bindings) + `(loop* ~bindings ~@body) + (let [vs (take-nth 2 (drop 1 bindings)) + gs (map (fn [x] (gensym)) vs) + ds (take-nth 2 bindings)] + `(loop* ~(apply vector (interleave gs vs)) + (let ~(apply vector (interleave ds gs)) + ~@body)))))) -(defmacro - #^{:doc "Same as (when (seq xs) (let [x (first xs)] body))"} -when-first [x xs & body] +(defmacro when-first + "Same as (when (seq xs) (let [x (first xs)] body))" + [x xs & body] `(when ~xs (let [~x (first ~xs)] ~@body))) -(defmacro - #^{:doc "Expands to code which yields a lazy sequence of the - concatenation of the supplied colls. Each coll expr is - not evaluated until it is needed."} -lazy-cat +(defmacro lazy-cat + "Expands to code which yields a lazy sequence of the concatenation + of the supplied colls. Each coll expr is not evaluated until it is + needed." ([coll] `(seq ~coll)) ([coll & colls] `(let [iter# (fn iter# [coll#] @@ -1973,14 +1931,13 @@ lazy-cat (lazy-cat ~@colls)))] (iter# ~coll)))) -(defmacro - #^{:doc "List comprehension. Takes one or more - binding-form/collection-expr pairs, an optional filtering - (where) expression, and yields a lazy sequence of - evaluations of expr. Collections are iterated in a nested - fashion, rightmost fastest, and nested coll-exprs can - refer to bindings created in prior binding-forms."} -for +(defmacro for + "List comprehension. Takes one or more + binding-form/collection-expr pairs, an optional filtering + (where) expression, and yields a lazy sequence of evaluations of + expr. Collections are iterated in a nested fashion, rightmost + fastest, and nested coll-exprs can refer to bindings created in + prior binding-forms." ([seq-expr expr] (list `for seq-expr `true expr)) ([seq-exprs filter-expr expr] (let [emit (fn emit [ses] @@ -1999,107 +1956,107 @@ for (iter# ~(second seq-exprs)))))) ;redefine fn with destructuring -(defmacro - #^{:doc "(fn name? [params* ] exprs*) - (fn name? ([params* ] exprs*)+) - params => positional-params* , or positional-params* & rest-param - positional-param => binding-form - rest-param => binding-form - name => symbol - - Defines a function"} -fn [& sigs] - (let [name (if (symbol? (first sigs)) (first sigs) nil) - sigs (if name (rest sigs) sigs) - sigs (if (vector? (first sigs)) (list sigs) sigs) - psig (fn [sig] - (let [[params & body] sig] - (if (every? symbol? params) - sig - (loop [params params - new-params [] - lets []] - (if params - (if (symbol? (first params)) - (recur (rest params) (conj new-params (first params)) lets) - (let [gparam (gensym "p__")] - (recur (rest params) (conj new-params gparam) (-> lets (conj (first params)) (conj gparam))))) - `(~new-params - (let ~lets - ~@body))))))) - new-sigs (map psig sigs)] - (if name - (list* 'fn* name new-sigs) - (cons 'fn* new-sigs)))) - - -(defmacro - #^{:doc "ignores body, yields nil"} -comment [& body]) - -(defmacro - #^{:doc "Evaluates exprs in a context in which *out* is bound to a - fresh StringWriter. Returns the string created by any - nested printing calls."} -with-out-str [& body] +(defmacro fn + "(fn name? [params* ] exprs*) + (fn name? ([params* ] exprs*)+) + + params => positional-params* , or positional-params* & rest-param + positional-param => binding-form + rest-param => binding-form + name => symbol + + Defines a function" + [& sigs] + (let [name (if (symbol? (first sigs)) (first sigs) nil) + sigs (if name (rest sigs) sigs) + sigs (if (vector? (first sigs)) (list sigs) sigs) + psig (fn [sig] + (let [[params & body] sig] + (if (every? symbol? params) + sig + (loop [params params + new-params [] + lets []] + (if params + (if (symbol? (first params)) + (recur (rest params) (conj new-params (first params)) lets) + (let [gparam (gensym "p__")] + (recur (rest params) (conj new-params gparam) + (-> lets (conj (first params)) (conj gparam))))) + `(~new-params + (let ~lets + ~@body))))))) + new-sigs (map psig sigs)] + (if name + (list* 'fn* name new-sigs) + (cons 'fn* new-sigs)))) + +(defmacro comment + "Ignores body, yields nil" + [& body]) + +(defmacro with-out-str + "Evaluates exprs in a context in which *out* is bound to a fresh + StringWriter. Returns the string created by any nested printing + calls." + [& body] `(let [s# (new java.io.StringWriter)] - (binding [*out* s#] - ~@body - (str s#)))) - -(defn - #^{:doc "pr to a string, returning it"} -pr-str [& xs] - (with-out-str - (apply pr xs))) - -(defn - #^{:doc "prn to a string, returning it"} -prn-str [& xs] - (with-out-str - (apply prn xs))) + (binding [*out* s#] + ~@body + (str s#)))) -(defn - #^{:doc "print to a string, returning it"} -print-str [& xs] - (with-out-str - (apply print xs))) +(defn pr-str + "pr to a string, returning it" + [& xs] + (with-out-str + (apply pr xs))) -(defn - #^{:doc "println to a string, returning it"} -println-str [& xs] +(defn prn-str + "prn to a string, returning it" + [& xs] (with-out-str - (apply println xs))) - -(defmacro - #^{:doc "Evaluates expr and throws an exception if it does not - evaluate to logical true."} -assert [x] + (apply prn xs))) + +(defn print-str + "print to a string, returning it" + [& xs] + (with-out-str + (apply print xs))) + +(defn println-str + "println to a string, returning it" + [& xs] + (with-out-str + (apply println xs))) + +(defmacro assert + "Evaluates expr and throws an exception if it does not evaluate to + logical true." + [x] `(when-not ~x (throw (new Exception (str "Assert failed: " (pr-str '~x)))))) -(defn - #^{:doc "test [v] finds fn at key :test in var metadata and calls it, - presuming failure will throw exception"} -test [v] - (let [f (:test ^v)] - (if f - (do (f) :ok) - :no-test))) - -(defn - #^{:tag java.util.regex.Pattern - :doc "Returns an instance of java.util.regex.Pattern, - for use, e.g. in re-matcher."} -re-pattern [s] - (. java.util.regex.Pattern (compile s))) +(defn test + "test [v] finds fn at key :test in var metadata and calls it, + presuming failure will throw exception" + [v] + (let [f (:test ^v)] + (if f + (do (f) :ok) + :no-test))) + +(defn re-pattern + "Returns an instance of java.util.regex.Pattern, for use, e.g. in + re-matcher." + {:tag java.util.regex.Pattern} + [s] (. java.util.regex.Pattern (compile s))) -(defn - #^{:tag java.util.regex.Matcher - :doc "Returns an instance of java.util.regex.Matcher, - for use, e.g. in re-find."} -re-matcher [#^java.util.regex.Pattern re s] - (. re (matcher s))) +(defn re-matcher + "Returns an instance of java.util.regex.Matcher, for use, e.g. in + re-find." + {:tag java.util.regex.Matcher} + [#^java.util.regex.Pattern re s] + (. re (matcher s))) (defn #^{:doc "Returns the groups from the most recent match/find. If @@ -2115,31 +2072,30 @@ re-groups [#^java.util.regex.Matcher m] (recur (conj ret (. m (group c))) (inc c)) ret))))) -(defn - #^{:doc "Returns a lazy sequence of successive matches of pattern - in string, using java.util.regex.Matcher.find(), each such - match processed with re-groups."} -re-seq [#^java.util.regex.Pattern re s] - (let [m (re-matcher re s)] - ((fn step [] - (when (. m (find)) - (lazy-cons (re-groups m) (step))))))) - -(defn - #^{:doc "Returns the match, if any, of string to pattern, using - java.util.regex.Matcher.matches(). Uses re-groups to - return the groups."} -re-matches [#^java.util.regex.Pattern re s] - (let [m (re-matcher re s)] - (when (. m (matches)) - (re-groups m)))) - - -(defn - #^{:doc "Returns the next regex match, if any, of string to - pattern, using java.util.regex.Matcher.find(). Uses - re-groups to return the groups."} -re-find +(defn re-seq + "Returns a lazy sequence of successive matches of pattern in string, + using java.util.regex.Matcher.find(), each such match processed with + re-groups." + [#^java.util.regex.Pattern re s] + (let [m (re-matcher re s)] + ((fn step [] + (when (. m (find)) + (lazy-cons (re-groups m) (step))))))) + +(defn re-matches + "Returns the match, if any, of string to pattern, using + java.util.regex.Matcher.matches(). Uses re-groups to return the + groups." + [#^java.util.regex.Pattern re s] + (let [m (re-matcher re s)] + (when (. m (matches)) + (re-groups m)))) + + +(defn re-find + "Returns the next regex match, if any, of string to pattern, using + java.util.regex.Matcher.find(). Uses re-groups to return the + groups." ([#^java.util.regex.Matcher m] (when (. m (find)) (re-groups m))) @@ -2147,24 +2103,22 @@ re-find (let [m (re-matcher re s)] (re-find m)))) -(defn - #^{:doc "Returns a random floating point number between 0 (inclusive) and 1 (exclusive)."} -rand +(defn rand + "Returns a random floating point number between 0 (inclusive) and + 1 (exclusive)." ([] (. Math (random))) ([n] (* n (rand)))) -(defn - #^{:doc "Returns a random integer between 0 (inclusive) and n (exclusive)."} -rand-int [n] - (int (rand n))) +(defn rand-int + "Returns a random integer between 0 (inclusive) and n (exclusive)." + [n] (int (rand n))) -(defmacro - #^{:doc "same as defn, yielding non-public def"} -defn- [name & decls] - (list* `defn (with-meta name (assoc (meta name) :private true)) decls)) +(defmacro defn- + "same as defn, yielding non-public def" + [name & decls] + (list* `defn (with-meta name (assoc (meta name) :private true)) decls)) -(defn -print-doc [v] +(defn print-doc [v] (println "-------------------------") (println (str (ns-name (:ns ^v)) "/" (:name ^v))) (prn (:arglists ^v)) @@ -2172,103 +2126,96 @@ print-doc [v] (println "Macro")) (println " " (:doc ^v))) -(defn - #^{:doc "Prints documentation for any var whose documentation or - name contains a match for re-string"} -find-doc [re-string] - (let [re (re-pattern re-string)] - (dorun (for [ns (all-ns) v (sort-by (comp :name meta) (vals (ns-interns ns)))] +(defn find-doc + "Prints documentation for any var whose documentation or name + contains a match for re-string" + [re-string] + (let [re (re-pattern re-string)] + (dorun (for [ns (all-ns) v (sort-by (comp :name meta) (vals (ns-interns ns)))] (and (:doc ^v) (or (re-find (re-matcher re (:doc ^v))) (re-find (re-matcher re (str (:name ^v)))))) - (print-doc v))))) + (print-doc v))))) -(defmacro - #^{:doc "Prints documentation for the var named by varname"} -doc [varname] +(defmacro doc + "Prints documentation for the var named by varname" + [varname] `(print-doc (var ~varname))) -(defn - #^{:doc "returns a lazy sequence of the nodes in a tree, via a depth-first walk. - - branch? must be a fn of one arg that returns true if - passed a node that can have children (but may not). - children must be a fn of one arg that returns a sequence - of the children. Will only be called on nodes for which - branch? returns true. Root is the root node of the tree, - must be a branch."} -tree-seq [branch? children root] - (let [walk (fn walk [nodes] - (when-first node nodes - (lazy-cons - node - (if (branch? node) - (lazy-cat (walk (children node)) - (walk (rest nodes))) - (walk (rest nodes))))))] - (lazy-cons root (walk (children root))))) - -(defn - #^{:doc "A tree seq on java.io.Files"} -file-seq [dir] - (tree-seq - (fn [#^java.io.File f] (. f (isDirectory))) - (fn [#^java.io.File d] (seq (. d (listFiles)))) - dir)) - -(defn - #^{:doc "A tree seq on the xml elements as per xml/parse"} -xml-seq [root] - (tree-seq - (complement string?) - (comp seq :content) - root)) - -(defn - #^{:doc "Returns true if s names a special form"} -special-symbol? [s] - (contains? (. clojure.lang.Compiler specials) s)) - -(defn - #^{:doc "Returns true if v is of type clojure.lang.Var"} -var? [v] - (instance? clojure.lang.Var v)) - -(defn - #^{:doc "Returns the Class of x"} -class [#^Object x] - (. x (getClass))) - -(defn - #^{:doc "Reads the file named by f into a string and returns it."} -slurp [f] - (let [r (new java.io.BufferedReader (new java.io.FileReader f)) - sb (new StringBuilder)] - (loop [c (. r (read))] - (if (neg? c) - (str sb) - (do - (. sb (append (char c))) - (recur (. r (read)))))))) - -(defn - #^{:doc "Returns the substring of s beginning at start inclusive, - and ending at end (defaults to length of string), exclusive."} -subs +(defn tree-seq + "returns a lazy sequence of the nodes in a tree, via a depth-first walk. + branch? must be a fn of one arg that returns true if passed a node + that can have children (but may not). children must be a fn of one + arg that returns a sequence of the children. Will only be called on + nodes for which branch? returns true. Root is the root node of the + tree, must be a branch." + [branch? children root] + (let [walk (fn walk [nodes] + (when-first node nodes + (lazy-cons + node + (if (branch? node) + (lazy-cat (walk (children node)) + (walk (rest nodes))) + (walk (rest nodes))))))] + (lazy-cons root (walk (children root))))) + +(defn file-seq + "A tree seq on java.io.Files" + [dir] + (tree-seq + (fn [#^java.io.File f] (. f (isDirectory))) + (fn [#^java.io.File d] (seq (. d (listFiles)))) + dir)) + +(defn xml-seq + "A tree seq on the xml elements as per xml/parse" + [root] + (tree-seq + (complement string?) + (comp seq :content) + root)) + +(defn special-symbol? + "Returns true if s names a special form" + [s] + (contains? (. clojure.lang.Compiler specials) s)) + +(defn var? + "Returns true if v is of type clojure.lang.Var" + [v] (instance? clojure.lang.Var v)) + +(defn class + "Returns the Class of x" + [#^Object x] (. x (getClass))) + +(defn slurp + "Reads the file named by f into a string and returns it." + [f] + (let [r (new java.io.BufferedReader (new java.io.FileReader f)) + sb (new StringBuilder)] + (loop [c (. r (read))] + (if (neg? c) + (str sb) + (do + (. sb (append (char c))) + (recur (. r (read)))))))) + +(defn subs + "Returns the substring of s beginning at start inclusive, and ending + at end (defaults to length of string), exclusive." ([#^String s start] (. s (substring start))) ([#^String s start end] (. s (substring start end)))) -(defn - #^{:doc "Returns the x for which (k x), a number, is greatest."} -max-key +(defn max-key + "Returns the x for which (k x), a number, is greatest." ([k x] x) ([k x y] (if (> (k x) (k y)) x y)) ([k x y & more] (reduce #(max-key k %1 %2) (max-key k x y) more))) -(defn - #^{:doc "Returns the x for which (k x), a number, is least."} -min-key +(defn min-key + "Returns the x for which (k x), a number, is least." ([k x] x) ([k x y] (if (< (k x) (k y)) x y)) ([k x y & more] |