/clojure/untranslated.clj
Clojure | 1655 lines | 1463 code | 175 blank | 17 comment | 153 complexity | c6bf193ba56f66b798d0320d85ed24a0 MD5 | raw file
Large files files are truncated, but you can click here to view the full file
- (defn load-reader
- "Sequentially read and evaluate the set of forms contained in the
- stream/file"
- {:added "1.0"
- :static true}
- [rdr] (. clojure.lang.Compiler (load rdr)))
- (defn load-string
- "Sequentially read and evaluate the set of forms contained in the
- string"
- {:added "1.0"
- :static true}
- [s]
- (let [rdr (-> (java.io.StringReader. s)
- (clojure.lang.LineNumberingPushbackReader.))]
- (load-reader rdr)))
- (defn var-get
- "Gets the value in the var object"
- {:added "1.0"
- :static true}
- [^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."
- {:added "1.0"
- :static true}
- [^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"
- {:added "1.0"}
- [name-vals-vec & body]
- (assert-args
- (vector? name-vals-vec) "a vector for its binding"
- (even? (count name-vals-vec)) "an even number of forms in binding vector")
- `(let [~@(interleave (take-nth 2 name-vals-vec)
- (repeat '(.. clojure.lang.Var create setDynamic)))]
- (. clojure.lang.Var (pushThreadBindings (hash-map ~@name-vals-vec)))
- (try
- ~@body
- (finally (. clojure.lang.Var (popThreadBindings))))))
- (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.
- (lazy-cat xs ys zs) === (concat (lazy-seq xs) (lazy-seq ys) (lazy-seq zs))"
- {:added "1.0"}
- [& colls]
- `(concat ~@(map #(list `lazy-seq %) colls)))
- (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."
- {:added "1.0"}
- [& body]
- `(let [s# (new java.io.StringWriter)]
- (binding [*out* s#]
- ~@body
- (str s#))))
- (defmacro with-in-str
- "Evaluates body in a context in which *in* is bound to a fresh
- StringReader initialized with the string s."
- {:added "1.0"}
- [s & body]
- `(with-open [s# (-> (java.io.StringReader. ~s) clojure.lang.LineNumberingPushbackReader.)]
- (binding [*in* s#]
- ~@body)))
- (defn pr-str
- "pr to a string, returning it"
- {:tag String
- :added "1.0"
- :static true}
- [& xs]
- (with-out-str
- (apply pr xs)))
- (defn prn-str
- "prn to a string, returning it"
- {:tag String
- :added "1.0"
- :static true}
- [& xs]
- (with-out-str
- (apply prn xs)))
- (defn print-str
- "print to a string, returning it"
- {:tag String
- :added "1.0"
- :static true}
- [& xs]
- (with-out-str
- (apply print xs)))
- (defn println-str
- "println to a string, returning it"
- {:tag String
- :added "1.0"
- :static true}
- [& xs]
- (with-out-str
- (apply println xs)))
- (import clojure.lang.ExceptionInfo)
- (defn ex-info
- "Alpha - subject to change.
- Create an instance of ExceptionInfo, a RuntimeException subclass
- that carries a map of additional data."
- {:added "1.4"}
- ([msg map]
- (ExceptionInfo. msg map))
- ([msg map cause]
- (ExceptionInfo. msg map cause)))
- (defn ex-data
- "Alpha - subject to change.
- Returns exception data (a map) if ex is an ExceptionInfo.
- Otherwise returns nil."
- {:added "1.4"}
- [ex]
- (when (instance? ExceptionInfo ex)
- (.getData ^ExceptionInfo ex)))
- (defmacro assert
- "Evaluates expr and throws an exception if it does not evaluate to
- logical true."
- {:added "1.0"}
- ([x]
- (when *assert*
- `(when-not ~x
- (throw (new AssertionError (str "Assert failed: " (pr-str '~x)))))))
- ([x message]
- (when *assert*
- `(when-not ~x
- (throw (new AssertionError (str "Assert failed: " ~message "\n" (pr-str '~x))))))))
- (defn test
- "test [v] finds fn at key :test in var metadata and calls it,
- presuming failure will throw exception"
- {:added "1.0"}
- [v]
- (let [f (:test (meta v))]
- (if f
- (do (f) :ok)
- :no-test)))
- (defmacro defn-
- "same as defn, yielding non-public def"
- {:added "1.0"}
- [name & decls]
- (list* `defn (with-meta name (assoc (meta name) :private true)) decls))
- (defn xml-seq
- "A tree seq on the xml elements as per xml/parse"
- {:added "1.0"
- :static true}
- [root]
- (tree-seq
- (complement string?)
- (comp seq :content)
- root))
- (defn special-symbol?
- "Returns true if s names a special form"
- {:added "1.0"
- :static true}
- [s]
- (contains? (. clojure.lang.Compiler specials) s))
- (defn distinct
- "Returns a lazy sequence of the elements of coll with duplicates removed"
- {:added "1.0"
- :static true}
- [coll]
- (let [step (fn step [xs seen]
- (lazy-seq
- ((fn [[f :as xs] seen]
- (when-let [s (seq xs)]
- (if (contains? seen f)
- (recur (rest s) seen)
- (cons f (step (rest s) (conj seen f))))))
- xs seen)))]
- (step coll #{})))
- (defmacro with-precision
- "Sets the precision and rounding mode to be used for BigDecimal operations.
- Usage: (with-precision 10 (/ 1M 3))
- or: (with-precision 10 :rounding HALF_DOWN (/ 1M 3))
- The rounding mode is one of CEILING, FLOOR, HALF_UP, HALF_DOWN,
- HALF_EVEN, UP, DOWN and UNNECESSARY; it defaults to HALF_UP."
- {:added "1.0"}
- [precision & exprs]
- (let [[body rm] (if (= (first exprs) :rounding)
- [(next (next exprs))
- `((. java.math.RoundingMode ~(second exprs)))]
- [exprs nil])]
- `(binding [*math-context* (java.math.MathContext. ~precision ~@rm)]
- ~@body)))
- (defn mk-bound-fn
- {:private true}
- [^clojure.lang.Sorted sc test key]
- (fn [e]
- (test (.. sc comparator (compare (. sc entryKey e) key)) 0)))
- (defn subseq
- "sc must be a sorted collection, test(s) one of <, <=, > or
- >=. Returns a seq of those entries with keys ek for
- which (test (.. sc comparator (compare ek key)) 0) is true"
- {:added "1.0"
- :static true}
- ([^clojure.lang.Sorted sc test key]
- (let [include (mk-bound-fn sc test key)]
- (if (#{> >=} test)
- (when-let [[e :as s] (. sc seqFrom key true)]
- (if (include e) s (next s)))
- (take-while include (. sc seq true)))))
- ([^clojure.lang.Sorted sc start-test start-key end-test end-key]
- (when-let [[e :as s] (. sc seqFrom start-key true)]
- (take-while (mk-bound-fn sc end-test end-key)
- (if ((mk-bound-fn sc start-test start-key) e) s (next s))))))
- (defn rsubseq
- "sc must be a sorted collection, test(s) one of <, <=, > or
- >=. Returns a reverse seq of those entries with keys ek for
- which (test (.. sc comparator (compare ek key)) 0) is true"
- {:added "1.0"
- :static true}
- ([^clojure.lang.Sorted sc test key]
- (let [include (mk-bound-fn sc test key)]
- (if (#{< <=} test)
- (when-let [[e :as s] (. sc seqFrom key false)]
- (if (include e) s (next s)))
- (take-while include (. sc seq false)))))
- ([^clojure.lang.Sorted sc start-test start-key end-test end-key]
- (when-let [[e :as s] (. sc seqFrom end-key false)]
- (take-while (mk-bound-fn sc start-test start-key)
- (if ((mk-bound-fn sc end-test end-key) e) s (next s))))))
- (defn repeatedly
- "Takes a function of no args, presumably with side effects, and
- returns an infinite (or length n if supplied) lazy sequence of calls
- to it"
- {:added "1.0"
- :static true}
- ([f] (lazy-seq (cons (f) (repeatedly f))))
- ([n f] (take n (repeatedly f))))
- (defn add-classpath
- "DEPRECATED
- Adds the url (String or URL object) to the classpath per
- URLClassLoader.addURL"
- {:added "1.0"
- :deprecated "1.1"}
- [url]
- (println "WARNING: add-classpath is deprecated")
- (clojure.lang.rt/addURL url))
- (defn hash
- "Returns the hash code of its argument. Note this is the hash code
- consistent with =, and thus is different than .hashCode for Integer,
- Short, Byte and Clojure collections."
- {:added "1.0"
- :static true}
- [x] (. clojure.lang.Util (hasheq x)))
- (defmacro definline
- "Experimental - like defmacro, except defines a named function whose
- body is the expansion, calls to which may be expanded inline as if
- it were a macro. Cannot be used with variadic (&) args."
- {:added "1.0"}
- [name & decl]
- (let [[pre-args [args expr]] (split-with (comp not vector?) decl)]
- `(do
- (defn ~name ~@pre-args ~args ~(apply (eval (list `fn args expr)) args))
- (alter-meta! (var ~name) assoc :inline (fn ~name ~args ~expr))
- (var ~name))))
- (defn empty
- "Returns an empty collection of the same category as coll, or nil"
- {:added "1.0"
- :static true}
- [coll]
- (when (instance? clojure.lang.IPersistentCollection coll)
- (.empty ^clojure.lang.IPersistentCollection coll)))
- (defmacro amap
- "Maps an expression across an array a, using an index named idx, and
- return value named ret, initialized to a clone of a, then setting
- each element of ret to the evaluation of expr, returning the new
- array ret."
- {:added "1.0"}
- [a idx ret expr]
- `(let [a# ~a
- ~ret (aclone a#)]
- (loop [~idx 0]
- (if (< ~idx (alength a#))
- (do
- (aset ~ret ~idx ~expr)
- (recur (unchecked-inc ~idx)))
- ~ret))))
- (defmacro areduce
- "Reduces an expression across an array a, using an index named idx,
- and return value named ret, initialized to init, setting ret to the
- evaluation of expr at each step, returning ret."
- {:added "1.0"}
- [a idx ret init expr]
- `(let [a# ~a]
- (loop [~idx 0 ~ret ~init]
- (if (< ~idx (alength a#))
- (recur (unchecked-inc ~idx) ~expr)
- ~ret))))
- (defn boolean-array
- "Creates an array of booleans"
- {:inline (fn [& args] `(. clojure.lang.Numbers boolean_array ~@args))
- :inline-arities #{1 2}
- :added "1.1"}
- ([size-or-seq] (. clojure.lang.Numbers boolean_array size-or-seq))
- ([size init-val-or-seq] (. clojure.lang.Numbers boolean_array size init-val-or-seq)))
- (defn object-array
- "Creates an array of objects"
- {:inline (fn [arg] `(. clojure.lang.rt object_array ~arg))
- :inline-arities #{1}
- :added "1.2"}
- ([size-or-seq] (. clojure.lang.rt object_array size-or-seq)))
- (definline booleans
- "Casts to boolean[]"
- {:added "1.1"}
- [xs] `(. clojure.lang.Numbers booleans ~xs))
- (definline bytes
- "Casts to bytes[]"
- {:added "1.1"}
- [xs] `(. clojure.lang.Numbers bytes ~xs))
- (definline chars
- "Casts to chars[]"
- {:added "1.1"}
- [xs] `(. clojure.lang.Numbers chars ~xs))
- (definline shorts
- "Casts to shorts[]"
- {:added "1.1"}
- [xs] `(. clojure.lang.Numbers shorts ~xs))
- (definline floats
- "Casts to float[]"
- {:added "1.0"}
- [xs] `(. clojure.lang.Numbers floats ~xs))
- (definline ints
- "Casts to int[]"
- {:added "1.0"}
- [xs] `(. clojure.lang.Numbers ints ~xs))
- (definline doubles
- "Casts to double[]"
- {:added "1.0"}
- [xs] `(. clojure.lang.Numbers doubles ~xs))
- (definline longs
- "Casts to long[]"
- {:added "1.0"}
- [xs] `(. clojure.lang.Numbers longs ~xs))
- (import '(java.util.concurrent BlockingQueue LinkedBlockingQueue))
- (defn seque
- "Creates a queued seq on another (presumably lazy) seq s. The queued
- seq will produce a concrete seq in the background, and can get up to
- n items ahead of the consumer. n-or-q can be an integer n buffer
- size, or an instance of java.util.concurrent BlockingQueue. Note
- that reading from a seque can block if the reader gets ahead of the
- producer."
- {:added "1.0"
- :static true}
- ([s] (seque 100 s))
- ([n-or-q s]
- (let [^BlockingQueue q (if (instance? BlockingQueue n-or-q)
- n-or-q
- (LinkedBlockingQueue. (int n-or-q)))
- NIL (Object.) ;nil sentinel since LBQ doesn't support nils
- agt (agent (seq s))
- fill (fn [s]
- (try
- (loop [[x & xs :as s] s]
- (if s
- (if (.offer q (if (nil? x) NIL x))
- (recur xs)
- s)
- (.put q q))) ; q itself is eos sentinel
- (catch Exception e
- (.put q q)
- (throw e))))
- drain (fn drain []
- (lazy-seq
- (let [x (.take q)]
- (if (identical? x q) ;q itself is eos sentinel
- (do @agt nil) ;touch agent just to propagate errors
- (do
- (send-off agt fill)
- (cons (if (identical? x NIL) nil x) (drain)))))))]
- (send-off agt fill)
- (drain))))
- (defn- is-annotation? [c]
- (and (class? c)
- (.isAssignableFrom java.lang.annotation.Annotation c)))
- (defn- is-runtime-annotation? [^Class c]
- (boolean
- (and (is-annotation? c)
- (when-let [^java.lang.annotation.Retention r
- (.getAnnotation c java.lang.annotation.Retention)]
- (= (.value r) java.lang.annotation.RetentionPolicy/RUNTIME)))))
- (defn- descriptor [^Class c] (clojure.asm.Type/getDescriptor c))
- (declare process-annotation)
- (defn- add-annotation [^clojure.asm.AnnotationVisitor av name v]
- (cond
- (vector? v) (let [avec (.visitArray av name)]
- (doseq [vval v]
- (add-annotation avec "value" vval))
- (.visitEnd avec))
- (symbol? v) (let [ev (eval v)]
- (cond
- (instance? java.lang.Enum ev)
- (.visitEnum av name (descriptor (class ev)) (str ev))
- (class? ev) (.visit av name (clojure.asm.Type/getType ev))
- :else (throw (IllegalArgumentException.
- (str "Unsupported annotation value: " v " of class " (class ev))))))
- (seq? v) (let [[nested nv] v
- c (resolve nested)
- nav (.visitAnnotation av name (descriptor c))]
- (process-annotation nav nv)
- (.visitEnd nav))
- :else (.visit av name v)))
- (defn- process-annotation [av v]
- (if (map? v)
- (doseq [[k v] v]
- (add-annotation av (name k) v))
- (add-annotation av "value" v)))
- (defn- add-annotations
- ([visitor m] (add-annotations visitor m nil))
- ([visitor m i]
- (doseq [[k v] m]
- (when (symbol? k)
- (when-let [c (resolve k)]
- (when (is-annotation? c)
- ;this is known duck/reflective as no common base of ASM Visitors
- (let [av (if i
- (.visitParameterAnnotation visitor i (descriptor c)
- (is-runtime-annotation? c))
- (.visitAnnotation visitor (descriptor c)
- (is-runtime-annotation? c)))]
- (process-annotation av v)
- (.visitEnd av))))))))
- (defn underive
- "Removes a parent/child relationship between parent and
- tag. h must be a hierarchy obtained from make-hierarchy, if not
- supplied defaults to, and modifies, the global hierarchy."
- {:added "1.0"}
- ([tag parent] (alter-var-root #'global-hierarchy underive tag parent) nil)
- ([h tag parent]
- (let [parentMap (:parents h)
- childsParents (if (parentMap tag)
- (disj (parentMap tag) parent) #{})
- newParents (if (not-empty childsParents)
- (assoc parentMap tag childsParents)
- (dissoc parentMap tag))
- deriv-seq (flatten (map #(cons (key %) (interpose (key %) (val %)))
- (seq newParents)))]
- (if (contains? (parentMap tag) parent)
- (reduce1 #(apply derive %1 %2) (make-hierarchy)
- (partition 2 deriv-seq))
- h))))
- (defn distinct?
- "Returns true if no two of the arguments are ="
- {:tag Boolean
- :added "1.0"
- :static true}
- ([x] true)
- ([x y] (not (= x y)))
- ([x y & more]
- (if (not= x y)
- (loop [s #{x y} [x & etc :as xs] more]
- (if xs
- (if (contains? s x)
- false
- (recur (conj s x) etc))
- true))
- false)))
- (defn resultset-seq
- "Creates and returns a lazy sequence of structmaps corresponding to
- the rows in the java.sql.ResultSet rs"
- {:added "1.0"}
- [^java.sql.ResultSet rs]
- (let [rsmeta (. rs (getMetaData))
- idxs (range 1 (inc (. rsmeta (getColumnCount))))
- keys (map (comp keyword #(.toLowerCase ^String %))
- (map (fn [i] (. rsmeta (getColumnLabel i))) idxs))
- check-keys
- (or (apply distinct? keys)
- (throw (Exception. "ResultSet must have unique column labels")))
- row-struct (apply create-struct keys)
- row-values (fn [] (map (fn [^Integer i] (. rs (getObject i))) idxs))
- rows (fn thisfn []
- (when (. rs (next))
- (cons (apply struct row-struct (row-values)) (lazy-seq (thisfn)))))]
- (rows)))
- (defn iterator-seq
- "Returns a seq on a java.util.Iterator. Note that most collections
- providing iterators implement Iterable and thus support seq directly."
- {:added "1.0"
- :static true}
- [iter]
- (clojure.lang.IteratorSeq/create iter))
- (defn enumeration-seq
- "Returns a seq on a java.util.Enumeration"
- {:added "1.0"
- :static true}
- [e]
- (clojure.lang.EnumerationSeq/create e))
- (defn printf
- "Prints formatted output, as per format"
- {:added "1.0"
- :static true}
- [fmt & args]
- (print (apply format fmt args)))
- (defmacro with-loading-context [& body]
- `((fn loading# []
- (. clojure.lang.Var (pushThreadBindings {clojure.lang.Compiler/LOADER
- (.getClassLoader (.getClass ^Object loading#))}))
- (try
- ~@body
- (finally
- (. clojure.lang.Var (popThreadBindings)))))))
- (defmacro defonce
- "defs name to have the root value of the expr iff the named var has no root value,
- else expr is unevaluated"
- {:added "1.0"}
- [name expr]
- `(let [v# (def ~name)]
- (when-not (.hasRoot v#)
- (def ~name ~expr))))
- ;;;;;;;;;;; require/use/load, contributed by Stephen C. Gilardi ;;;;;;;;;;;;;;;;;;
- (defonce ^:dynamic
- ^{:private true
- :doc "A ref to a sorted set of symbols representing loaded libs"}
- *loaded-libs* (ref (sorted-set)))
- (defonce ^:dynamic
- ^{:private true
- :doc "A stack of paths currently being loaded by this thread"}
- *pending-paths* ())
- (defn- throw-if
- "Throws an exception with a message if pred is true"
- [pred fmt & args]
- (when pred
- (let [^String message (apply format fmt args)
- exception (Exception. message)
- raw-trace (.getStackTrace exception)
- boring? #(not= (.getMethodName ^StackTraceElement %) "doInvoke")
- trace (into-array (drop 2 (drop-while boring? raw-trace)))]
- (.setStackTrace exception trace)
- (throw exception))))
- (defn- root-resource
- "Returns the root directory path for a lib"
- {:tag String}
- [lib]
- (str \/
- (.. (name lib)
- (replace \- \_)
- (replace \. \/))))
- (defn- root-directory
- "Returns the root resource path for a lib"
- [lib]
- (let [d (root-resource lib)]
- (subs d 0 (.lastIndexOf d "/"))))
- (defn- check-cyclic-dependency
- "Detects and rejects non-trivial cyclic load dependencies. The
- exception message shows the dependency chain with the cycle
- highlighted. Ignores the trivial case of a file attempting to load
- itself because that can occur when a gen-class'd class loads its
- implementation."
- [path]
- (when (some #{path} (rest *pending-paths*))
- (let [pending (map #(if (= % path) (str "[ " % " ]") %)
- (cons path *pending-paths*))
- chain (apply str (interpose "->" pending))]
- (throw (Exception. (str "Cyclic load dependency: " chain))))))
- ;; Public
- (defn loaded-libs
- "Returns a sorted set of symbols naming the currently loaded libs"
- {:added "1.0"}
- [] @*loaded-libs*)
- (defn load
- "Loads Clojure code from resources in classpath. A path is interpreted as
- classpath-relative if it begins with a slash or relative to the root
- directory for the current namespace otherwise."
- {:added "1.0"}
- [& paths]
- (doseq [^String path paths]
- (let [^String path (if (.startsWith path "/")
- path
- (str (root-directory (ns-name *ns*)) \/ path))]
- (when *loading-verbosely*
- (printf "(clojure.core/load \"%s\")\n" path)
- (flush))
- (check-cyclic-dependency path)
- (when-not (= path (first *pending-paths*))
- (binding [*pending-paths* (conj *pending-paths* path)]
- (clojure.lang.rt/load (.substring path 1)))))))
- (defn compile
- "Compiles the namespace named by the symbol lib into a set of
- classfiles. The source for the lib must be in a proper
- classpath-relative directory. The output files will go into the
- directory specified by *compile-path*, and that directory too must
- be in the classpath."
- {:added "1.0"}
- [lib]
- (binding [*compile-files* true]
- (load-one lib true true))
- lib)
- ;;;;;;;;;;;;; nested associative ops ;;;;;;;;;;;
- (defn get-in
- "Returns the value in a nested associative structure,
- where ks is a sequence of keys. Returns nil if the key
- is not present, or the not-found value if supplied."
- {:added "1.2"
- :static true}
- ([m ks]
- (reduce1 get m ks))
- ([m ks not-found]
- (loop [sentinel (Object.)
- m m
- ks (seq ks)]
- (if ks
- (let [m (get m (first ks) sentinel)]
- (if (identical? sentinel m)
- not-found
- (recur sentinel m (next ks))))
- m))))
- (defn assoc-in
- "Associates a value in a nested associative structure, where ks is a
- sequence of keys and v is the new value and returns a new nested structure.
- If any levels do not exist, hash-maps will be created."
- {:added "1.0"
- :static true}
- [m [k & ks] v]
- (if ks
- (assoc m k (assoc-in (get m k) ks v))
- (assoc m k v)))
- (defn update-in
- "'Updates' a value in a nested associative structure, where ks is a
- sequence of keys and f is a function that will take the old value
- and any supplied args and return the new value, and returns a new
- nested structure. If any levels do not exist, hash-maps will be
- created."
- {:added "1.0"
- :static true}
- ([m [k & ks] f & args]
- (if ks
- (assoc m k (apply update-in (get m k) ks f args))
- (assoc m k (apply f (get m k) args)))))
- (defn ifn?
- "Returns true if x implements IFn. Note that many data structures
- (e.g. sets and maps) implement IFn"
- {:added "1.0"
- :static true}
- [x] (instance? clojure.lang.IFn x))
- (defn associative?
- "Returns true if coll implements Associative"
- {:added "1.0"
- :static true}
- [coll] (instance? clojure.lang.Associative coll))
- (defn sequential?
- "Returns true if coll implements Sequential"
- {:added "1.0"
- :static true}
- [coll] (instance? clojure.lang.Sequential coll))
- (defn sorted?
- "Returns true if coll implements Sorted"
- {:added "1.0"
- :static true}
- [coll] (instance? clojure.lang.Sorted coll))
- (defn counted?
- "Returns true if coll implements count in constant time"
- {:added "1.0"
- :static true}
- [coll] (instance? clojure.lang.Counted coll))
- (defn reversible?
- "Returns true if coll implements Reversible"
- {:added "1.0"
- :static true}
- [coll] (instance? clojure.lang.Reversible coll))
- (def ^:dynamic
- ^{:doc "bound in a repl thread to the most recent exception caught by the repl"
- :added "1.0"}
- *e)
- (defn trampoline
- "trampoline can be used to convert algorithms requiring mutual
- recursion without stack consumption. Calls f with supplied args, if
- any. If f returns a fn, calls that fn with no arguments, and
- continues to repeat, until the return value is not a fn, then
- returns that non-fn value. Note that if you want to return a fn as a
- final value, you must wrap it in some data structure and unpack it
- after trampoline returns."
- {:added "1.0"
- :static true}
- ([f]
- (let [ret (f)]
- (if (fn? ret)
- (recur ret)
- ret)))
- ([f & args]
- (trampoline #(apply f args))))
- (defn memoize
- "Returns a memoized version of a referentially transparent function. The
- memoized version of the function keeps a cache of the mapping from arguments
- to results and, when calls with the same arguments are repeated often, has
- higher performance at the expense of higher memory use."
- {:added "1.0"
- :static true}
- [f]
- (let [mem (atom {})]
- (fn [& args]
- (if-let [e (find @mem args)]
- (val e)
- (let [ret (apply f args)]
- (swap! mem assoc args ret)
- ret)))))
- (defmacro condp
- "Takes a binary predicate, an expression, and a set of clauses.
- Each clause can take the form of either:
- test-expr result-expr
- test-expr :>> result-fn
- Note :>> is an ordinary keyword.
- For each clause, (pred test-expr expr) is evaluated. If it returns
- logical true, the clause is a match. If a binary clause matches, the
- result-expr is returned, if a ternary clause matches, its result-fn,
- which must be a unary function, is called with the result of the
- predicate as its argument, the result of that call being the return
- value of condp. A single default expression can follow the clauses,
- and its value will be returned if no clause matches. If no default
- expression is provided and no clause matches, an
- IllegalArgumentException is thrown."
- {:added "1.0"}
- [pred expr & clauses]
- (let [gpred (gensym "pred__")
- gexpr (gensym "expr__")
- emit (fn emit [pred expr args]
- (let [[[a b c :as clause] more]
- (split-at (if (= :>> (second args)) 3 2) args)
- n (count clause)]
- (cond
- (= 0 n) `(throw (IllegalArgumentException. (str "No matching clause: " ~expr)))
- (= 1 n) a
- (= 2 n) `(if (~pred ~a ~expr)
- ~b
- ~(emit pred expr more))
- :else `(if-let [p# (~pred ~a ~expr)]
- (~c p#)
- ~(emit pred expr more)))))
- gres (gensym "res__")]
- `(let [~gpred ~pred
- ~gexpr ~expr]
- ~(emit gpred gexpr clauses))))
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; var documentation ;;;;;;;;;;;;;;;;;;;;;;;;;;
- (alter-meta! #'*agent* assoc :added "1.0")
- (alter-meta! #'in-ns assoc :added "1.0")
- (alter-meta! #'load-file assoc :added "1.0")
- (defmacro add-doc-and-meta {:private true} [name docstring meta]
- `(alter-meta! (var ~name) merge (assoc ~meta :doc ~docstring)))
- (add-doc-and-meta *file*
- "The path of the file being evaluated, as a String.
- Evaluates to nil when there is no file, eg. in the REPL."
- {:added "1.0"})
- (add-doc-and-meta *command-line-args*
- "A sequence of the supplied command line arguments, or nil if
- none were supplied"
- {:added "1.0"})
- (add-doc-and-meta *warn-on-reflection*
- "When set to true, the compiler will emit warnings when reflection is
- needed to resolve Java method calls or field accesses.
- Defaults to false."
- {:added "1.0"})
- (add-doc-and-meta *compile-path*
- "Specifies the directory where 'compile' will write out .class
- files. This directory must be in the classpath for 'compile' to
- work.
- Defaults to \"classes\""
- {:added "1.0"})
- (add-doc-and-meta *compile-files*
- "Set to true when compiling files, false otherwise."
- {:added "1.0"})
- (add-doc-and-meta *unchecked-math*
- "While bound to true, compilations of +, -, *, inc, dec and the
- coercions will be done without overflow checks. Default: false."
- {:added "1.3"})
- (add-doc-and-meta *in*
- "A java.io.Reader object representing standard input for read operations.
- Defaults to System/in, wrapped in a LineNumberingPushbackReader"
- {:added "1.0"})
- (add-doc-and-meta *out*
- "A java.io.Writer object representing standard output for print operations.
- Defaults to System/out, wrapped in an OutputStreamWriter"
- {:added "1.0"})
- (add-doc-and-meta *err*
- "A java.io.Writer object representing standard error for print operations.
- Defaults to System/err, wrapped in a PrintWriter"
- {:added "1.0"})
- (add-doc-and-meta *flush-on-newline*
- "When set to true, output will be flushed whenever a newline is printed.
- Defaults to true."
- {:added "1.0"})
- (add-doc-and-meta *print-meta*
- "If set to logical true, when printing an object, its metadata will also
- be printed in a form that can be read back by the reader.
- Defaults to false."
- {:added "1.0"})
- (add-doc-and-meta *print-dup*
- "When set to logical true, objects will be printed in a way that preserves
- their type when read in later.
- Defaults to false."
- {:added "1.0"})
- (add-doc-and-meta *print-readably*
- "When set to logical false, strings and characters will be printed with
- non-alphanumeric characters converted to the appropriate escape sequences.
- Defaults to true"
- {:added "1.0"})
- (add-doc-and-meta *read-eval*
- "When set to logical false, the EvalReader (#=(...)) is disabled in the
- read/load in the thread-local binding.
- Example: (binding [*read-eval* false] (read-string \"#=(eval (def x 3))\"))
- Defaults to true"
- {:added "1.0"})
- (defn future?
- "Returns true if x is a future"
- {:added "1.1"
- :static true}
- [x] (instance? java.util.concurrent.Future x))
- (defn future-done?
- "Returns true if future f is done"
- {:added "1.1"
- :static true}
- [^java.util.concurrent.Future f] (.isDone f))
- (defmacro letfn
- "fnspec ==> (fname [params*] exprs) or (fname ([params*] exprs)+)
- Takes a vector of function specs and a body, and generates a set of
- bindings of functions to their names. All of the names are available
- in all of the definitions of the functions, as well as the body."
- {:added "1.0", :forms '[(letfn [fnspecs*] exprs*)],
- :special-form true, :url nil}
- [fnspecs & body]
- `(letfn* ~(vec (interleave (map first fnspecs)
- (map #(cons `fn %) fnspecs)))
- ~@body))
- (defn fnil
- "Takes a function f, and returns a function that calls f, replacing
- a nil first argument to f with the supplied value x. Higher arity
- versions can replace arguments in the second and third
- positions (y, z). Note that the function f can take any number of
- arguments, not just the one(s) being nil-patched."
- {:added "1.2"
- :static true}
- ([f x]
- (fn
- ([a] (f (if (nil? a) x a)))
- ([a b] (f (if (nil? a) x a) b))
- ([a b c] (f (if (nil? a) x a) b c))
- ([a b c & ds] (apply f (if (nil? a) x a) b c ds))))
- ([f x y]
- (fn
- ([a b] (f (if (nil? a) x a) (if (nil? b) y b)))
- ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) c))
- ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) c ds))))
- ([f x y z]
- (fn
- ([a b] (f (if (nil? a) x a) (if (nil? b) y b)))
- ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c)))
- ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c) ds)))))
- ;;;;;;; case ;;;;;;;;;;;;;
- (defn- shift-mask [shift mask x]
- (-> x (bit-shift-right shift) (bit-and mask)))
- (def ^:private max-mask-bits 13)
- (def ^:private max-switch-table-size (bit-shift-left 1 max-mask-bits))
- (defn- maybe-min-hash
- "takes a collection of hashes and returns [shift mask] or nil if none found"
- [hashes]
- (first
- (filter (fn [[s m]]
- (apply distinct? (map #(shift-mask s m %) hashes)))
- (for [mask (map #(dec (bit-shift-left 1 %)) (range 1 (inc max-mask-bits)))
- shift (range 0 31)]
- [shift mask]))))
- (defn- case-map
- "Transforms a sequence of test constants and a corresponding sequence of then
- expressions into a sorted map to be consumed by case*. The form of the map
- entries are {(case-f test) [(test-f test) then]}."
- [case-f test-f tests thens]
- (into1 (sorted-map)
- (zipmap (map case-f tests)
- (map vector
- (map test-f tests)
- thens))))
- (defn- fits-table?
- "Returns true if the collection of ints can fit within the
- max-table-switch-size, false otherwise."
- [ints]
- (< (- (apply max (seq ints)) (apply min (seq ints))) max-switch-table-size))
- (defn- prep-ints
- "Takes a sequence of int-sized test constants and a corresponding sequence of
- then expressions. Returns a tuple of [shift mask case-map switch-type] where
- case-map is a map of int case values to [test then] tuples, and switch-type
- is either :sparse or :compact."
- [tests thens]
- (if (fits-table? tests)
- ; compact case ints, no shift-mask
- [0 0 (case-map int int tests thens) :compact]
- (let [[shift mask] (or (maybe-min-hash (map int tests)) [0 0])]
- (if (zero? mask)
- ; sparse case ints, no shift-mask
- [0 0 (case-map int int tests thens) :sparse]
- ; compact case ints, with shift-mask
- [shift mask (case-map #(shift-mask shift mask (int %)) int tests thens) :compact]))))
- (defn- merge-hash-collisions
- "Takes a case expression, default expression, and a sequence of test constants
- and a corresponding sequence of then expressions. Returns a tuple of
- [tests thens skip-check-set] where no tests have the same hash. Each set of
- input test constants with the same hash is replaced with a single test
- constant (the case int), and their respective thens are combined into:
- (condp = expr
- test-1 then-1
- ...
- test-n then-n
- default).
- The skip-check is a set of case ints for which post-switch equivalence
- checking must not be done (the cases holding the above condp thens)."
- [expr-sym default tests thens]
- (let [buckets (loop [m {} ks tests vs thens]
- (if (and ks vs)
- (recur
- (update-in m [(hash (first ks))] (fnil conj []) [(first ks) (first vs)])
- (next ks) (next vs))
- m))
- assoc-multi (fn [m h bucket]
- (let [testexprs (apply concat bucket)
- expr `(condp = ~expr-sym ~@testexprs ~default)]
- (assoc m h expr)))
- hmap (reduce1
- (fn [m [h bucket]]
- (if (== 1 (count bucket))
- (assoc m (ffirst bucket) (second (first bucket)))
- (assoc-multi m h bucket)))
- {} buckets)
- skip-check (->> buckets
- (filter #(< 1 (count (second %))))
- (map first)
- (into1 #{}))]
- [(keys hmap) (vals hmap) skip-check]))
- (defn- prep-hashes
- "Takes a sequence of test constants and a corresponding sequence of then
- expressions. Returns a tuple of [shift mask case-map switch-type skip-check]
- where case-map is a map of int case values to [test then] tuples, switch-type
- is either :sparse or :compact, and skip-check is a set of case ints for which
- post-switch equivalence checking must not be done (occurs with hash
- collisions)."
- [expr-sym default tests thens]
- (let [hashes (into1 #{} (map hash tests))]
- (if (== (count tests) (count hashes))
- (if (fits-table? hashes)
- ; compact case ints, no shift-mask
- [0 0 (case-map hash identity tests thens) :compact]
- (let [[shift mask] (or (maybe-min-hash hashes) [0 0])]
- (if (zero? mask)
- ; sparse case ints, no shift-mask
- [0 0 (case-map hash identity tests thens) :sparse]
- ; compact case ints, with shift-mask
- [shift mask (case-map #(shift-mask shift mask (hash %)) identity tests thens) :compact])))
- ; resolve hash collisions and try again
- (let [[tests thens skip-check] (merge-hash-collisions expr-sym default tests thens)
- [shift mask case-map switch-type] (prep-hashes expr-sym default tests thens)
- skip-check (if (zero? mask)
- skip-check
- (into1 #{} (map #(shift-mask shift mask %) skip-check)))]
- [shift mask case-map switch-type skip-check]))))
- (defmacro case
- "Takes an expression, and a set of clauses.
- Each clause can take the form of either:
- test-constant result-expr
- (test-constant1 ... test-constantN) result-expr
- The test-constants are not evaluated. They must be compile-time
- literals, and need not be quoted. If the expression is equal to a
- test-constant, the corresponding result-expr is returned. A single
- default expression can follow the clauses, and its value will be
- returned if no clause matches. If no default expression is provided
- and no clause matches, an IllegalArgumentException is thrown.
- Unlike cond and condp, case does a constant-time dispatch, the
- clauses are not considered sequentially. All manner of constant
- expressions are acceptable in case, including numbers, strings,
- symbols, keywords, and (Clojure) composites thereof. Note that since
- lists are used to group multiple constants that map to the same
- expression, a vector can be used to match a list if needed. The
- test-constants need not be all of the same type."
- {:added "1.2"}
- [e & clauses]
- (let [ge (with-meta (gensym) {:tag Object})
- default (if (odd? (count clauses))
- (last clauses)
- `(throw (IllegalArgumentException. (str "No matching clause: " ~ge))))]
- (if (> 2 (count clauses))
- `(let [~ge ~e] ~default)
- (let [pairs (partition 2 clauses)
- assoc-test (fn assoc-test [m test expr]
- (if (contains? m test)
- (throw (IllegalArgumentException. (str "Duplicate case test constant: " test)))
- (assoc m test expr)))
- pairs (reduce1
- (fn [m [test expr]]
- (if (seq? test)
- (reduce1 #(assoc-test %1 %2 expr) m test)
- (assoc-test m test expr)))
- {} pairs)
- tests (keys pairs)
- thens (vals pairs)
- mode (cond
- (every? #(and (integer? %) (<= Integer/MIN_VALUE % Integer/MAX_VALUE)) tests)
- :ints
- (every? keyword? tests)
- :identity
- :else :hashes)]
- (condp = mode
- :ints
- (let [[shift mask imap switch-type] (prep-ints tests thens)]
- `(let [~ge ~e] (case* ~ge ~shift ~mask ~default ~imap ~switch-type :int)))
- :hashes
- (let [[shift mask imap switch-type skip-check] (prep-hashes ge default tests thens)]
- `(let [~ge ~e] (case* ~ge ~shift ~mask ~default ~imap ~switch-type :hash-equiv ~skip-check)))
- :identity
- (let [[shift mask imap switch-type skip-check] (prep-hashes ge default tests thens)]
- `(let [~ge ~e] (case* ~ge ~shift ~mask ~default ~imap ~switch-type :hash-identity ~skip-check))))))))
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; helper files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (alter-meta! (find-ns 'clojure.core) assoc :doc "Fundamental library of the Clojure language")
- (load "core_proxy")
- (load "core_print")
- (load "genclass")
- (load "core_deftype")
- (load "core/protocols")
- (load "gvec")
- ;; redefine reduce with internal-reduce
- (defn reduce
- "f should be a function of 2 arguments. If val is not supplied,
- returns the result of applying f to the first 2 items in coll, then
- applying f to that result and the 3rd item, etc. If coll contains no
- items, f must accept no arguments as well, and reduce returns the
- result of calling f with no arguments. If coll has only 1 item, it
- is returned and f is not called. If val is supplied, returns the
- result of applying f to val and the first item in coll, then
- applying f to that result and the 2nd item, etc. If coll contains no
- items, returns val and f is not called."
- {:added "1.0"}
- ([f coll]
- (if-let [s (seq coll)]
- (reduce f (first s) (next s))
- (f)))
- ([f val coll]
- (let [s (seq coll)]
- (clojure.core.protocols/internal-reduce s f val))))
- (defn into
- "Returns a new coll consisting of to-coll with all of the items of
- from-coll conjoined."
- {:added "1.0"
- :static true}
- [to from]
- (if (instance? clojure.lang.IEditableCollection to)
- (persistent! (reduce conj! (transient to) from))
- (reduce conj to from)))
- (defn mapv
- "Returns a vector consisting of the result of applying f to the
- set of first items of each coll, followed by applying f to the set
- of second items in each coll, until any one of the colls is
- exhausted. Any remaining items in other colls are ignored. Function
- f should accept number-of-colls arguments."
- {:added "1.4"
- :static true}
- ([f coll]
- (-> (reduce (fn [v o] (conj! v (f o))) (transient []) coll)
- persistent!))
- ([f c1 c2]
- (into [] (map f c1 c2)))
- ([f c1 c2 c3]
- (into [] (map f c1 c2 c3)))
- ([f c1 c2 c3 & colls]
- (into [] (apply map f c1 c2 c3 colls))))
- (defn filterv
- "Returns a vector of the items in coll for which
- (pred item) returns true. pred must be free of side-effects."
- {:added "1.4"
- :static true}
- [pred coll]
- (-> (reduce (fn [v o] (if (pred o) (conj! v o) v))
- (transient [])
- coll)
- persistent!))
- (require '[clojure.java.io :as jio])
- (defn- normalize-slurp-opts
- [opts]
- (if (string? (first opts))
- (do
- (println "WARNING: (slurp f enc) is deprecated, use (slurp f :encoding enc).")
- [:encoding (first opts)])
- opts))
- (defn slurp
- "Opens a reader on f and reads all its contents, returning a string.
- See clojure.java.io/reader for a complete list of supported arguments."
- {:added "1.0"}
- ([f & opts]
- (let [opts (normalize-slurp-opts opts)
- sb (StringBuilder.)]
- (with-open [#^java.io.Reader r (apply jio/reader f opts)]
- (loop [c (.read r)]
- (if (neg? c)
- (str sb)
- (do
- (.append sb (char c))
- (recur (.read r)))))))))
- (defn spit
- "Opposite of slurp. Opens f with writer, writes content, then
- closes f. Options passed to clojure.java.io/writer."
- {:added "1.2"}
- [f content & options]
- (with-open [#^java.io.Writer w (apply jio/writer f options)]
- (.write w (str content))))
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; futures (needs proxy);;;;;;;;;;;;;;;;;;
- (defn future-call
- "Takes a function of no args and yields a future object that will
- invoke the function in another thread, and will cache the result and
- return it on all subsequent calls to deref/@. If the computation has
- not yet finished, calls to deref/@ will block, unless the variant
- of deref with timeout is used. See also - realized?."
- {:added "1.1"
- :static true}
- [f]
- (let [f (binding-conveyor-fn f)
- fut (.submit clojure.lang.Agent/soloExecutor ^Callable f)]
- (reify
- clojure.lang.IDeref
- (deref [_] (.get fut))
- clojure.lang.IBlockingDeref
- (deref
- [_ timeout-ms timeout-val]
- (try (.get fut timeout-ms java.util.concurrent.TimeUnit/MILLISECONDS)
- (catch java.util.concurrent.TimeoutException e
- timeout-val)))
- clojure.lang.IPending
- (isRealized [_] (.isDone fut))
- java.util.concurrent.Future
- (get [_] (.get fut))
- (get [_ timeout unit] (.get fut timeout unit))
- (isCancelled [_] (.isCancelled fut))
- (isDone [_] (.isDone fut))
- (cancel [_ interrupt?] (.cancel fut interrupt?)))))
-
- (defmacro future
- "Takes a body of expressions and yields a future object that will
- invoke the body in another thread, and will cache the result and
- return it on all subsequent calls to deref/@. If the computation has
- not yet finished, calls to deref/@ will block, unless the variant of
- deref with timeout is used. See also - realized?."
- {:added "1.1"}
- [& body] `(future-call (^{:once true} fn* [] ~@body)))
- (defn future-cancel
- "Cancels the future, if possible."
- {:added "1.1"
- :static true}
- [^java.util.concurrent.Future f] (.cancel f true))
- (defn future-cancelled?
- "Returns true if future f is cancelled"
- {:added "1.1"
- :static true}
- [^java.util.concurrent.Future f] (.isCancelled f))
- (defn pmap
- "Like map, except f is applied in parallel. Semi-lazy in that the
- parallel computation stays ahead of the consumption, but doesn't
- realize the entire result unless required. Only useful for
- computationally intensive functions where the time of f dominates
- the coordination overhead."
- {:added "1.0"
- :static true}
- ([f coll]
- (let [n (+ 2 (.. Runtime getRuntime availableProcessors))
- rets (map #(future (f %)) coll)
- step (fn step [[x & xs :as vs] fs]
- (lazy-seq
- (if-let [s (seq fs)]
- (cons (deref x) (step xs (rest s)))
- (map deref vs))))]
- (step rets (drop n rets))))
- ([f coll & colls]
- (let [step (fn step [cs]
- (lazy-seq
- (let [ss (map seq cs)]
- (when (every? identity ss)
- (cons (map first ss) (step (map rest ss)))))))]
- (pmap #(apply f %) (step (cons coll colls))))))
- (defn pcalls
- "Executes the no-arg fns in parallel, returning a lazy sequence of
- their values"
- {:added "1.0"
- :static true}
- [& fns] (pmap #(%) fns))
- (defmacro pvalues
- "Returns a lazy sequence of the values of the exprs, which are
- evaluated in parallel"
- {:added "1.0"
- :static true}
- [& exprs]
- `(pcalls ~@(map #(list `fn [] %) exprs)))
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; clojure version number ;;;;;;;;;;;;;;;;;;;;;;
- (let [properties (with-open [version-stream (.getResourceAsStream
- (clojure.lang.rt/baseLoader)
- "clojure/version.properties")]
- (doto (new java.util.Properties)
- (.load version-stream)))
- version-string (.getProperty properties "version")
- [_ major minor incremental qualifier snapshot]
- (re-matches
- #"(\d+)\.(\d+)\.(\d+)(?:-([a-zA-Z0-9_]+))?(?:-(SNAPSHOT))?"
- version-string)
- clojure-version {:major (Integer/valueOf ^String major)
- :minor (Integer/valueOf ^String minor)
- :incremental (Integer/valueOf ^String incremental)
- :qualifier (if (= qualifier "SNAPSHOT") nil qualifier)}]
- (def ^:dynamic *clojure-version*
- (if (.contains version-string "SNAPSHOT")
- (clojure.lang.rt/assoc clojure-version :interim true)
- clojure-version)))
- (add-doc-and-meta *clojure-version*
- "The version info for Clojure core, as a map containing :major :minor
- :incremental and :qualifier keys. Feature releases may increment
- :minor and/or :major, bugfix releases will increment :incremental.
- Possible values of :qualifier include \"GA\", \"SNAPSHOT\", \"RC-x\" \"BETA-x\""
- {:added "1.0"})
- (defn
- clojure-version
- "Returns clojure version as a printable string."
- {:added "1.0"}
- []
- (str (:major *clojure-version*)
- "."
- (:minor *clojure-version*)
- (when-let [i (:incremental *clojure-version*)]
- (str "." i))
- (when-let [q (:qualifier *clojure-version*)]
- (when (pos? (count q)) (str "-" q)))
- (when (:interim *clojure-version*)
- "-SNAPSHOT")))
- (defn promise
- "Alpha - subject to change.
- Returns a promise object that can be read with deref/@, and set,
- once only, with deliver. Calls to deref/@ prior to delivery will
- block, unless the variant of deref with timeout is used. All
- subsequent derefs will return the same delivered value without
- blocking. See also - realized?."
- {:added "1.1"
- :static true}
- []
- (let [d (java.util.concurrent.CountDownLatch. 1)
- v (atom d)]
- (reify
- clojure.lang.IDeref
- (deref [_] (.await d) @v)
- clojure.lang.IBlockingDeref
- (deref
- [_ timeout-ms timeout-val]
- (if (.await d timeout-ms java.util.concurrent.TimeUnit/MILLISECONDS)
- @v
- timeout-val))
- clojure.lang.IPending
- (isRealized [this]
- (zero? (.getCount d)))
- clojure.lang.IFn
- (invoke
- [this x]
- (when (and (pos? (.getCount d))
- (compare-and-set! v d x))
- (.countDown d)
- this)))))
- (defn deliver
- "Alpha - subject to change.
- Delivers the supplied value to the promise, releasing any pending
- derefs. A subsequent call to deliver on a promise will throw an exception."
- {:added "1.1"
- :static true}
- [promise val] (promise val))
- (defn flatten
- "Takes any nested combination of sequential things (lists, vectors,
- etc.) and returns their contents as a single, flat sequence.
- (flatten nil) returns an empty sequence."
- {:added "1.2"
- :static true}
- [x]
- (filter (complement sequential?)
- (rest (tree-seq sequential? seq x))))
- (defn group-by
- "Returns a map of the elements of coll keyed by the result of
- f on each element. The value at each key will be a vector of the
- corresponding elements, in the order they appeared in coll."
- {:added "1.2"
- :static true}
- [f coll]
- (persistent!
- (reduce
- (fn [ret x]
- (let [k (f x)]
- (assoc! ret k (conj (get ret k []) x))))
- (transient {}) coll)))
- (defn partition-by
- "Applies f to each value in coll, splitting it each time f returns
- a new value. Returns a lazy seq of partitions."
- {:added "1.2"
- :static true}
- [f coll]
- (lazy-seq
- (when-let [s (seq coll)]
- (let [fst (first s)
- fv (f fst)
- run (cons fst (take-while #(= fv (f %)) (next s)))]
- (cons run (partition-by f (seq (drop (count run) s))))))))
- (defn frequencies
- "Returns a map from distinct items in coll to the number of times
- they appear."
- {:added "1.2"
- :static true}
- [coll]
- (persistent!
- (reduce (fn [counts x]
- (assoc! counts x (inc (get counts x 0))))
- (transient {}) coll)))
- (defn partiti…
Large files files are truncated, but you can click here to view the full file