From 69ffbc3bc5a824d1df08acdd6ed6691df618ef20 Mon Sep 17 00:00:00 2001 From: James Hamlin Date: Sat, 3 Dec 2022 16:45:03 -0800 Subject: [PATCH] Add reader support for function shorthand Signed-off-by: James Hamlin --- reader/reader.go | 160 +++++++++++++++++++------------- reader/testdata/reader/core.out | 74 +++++++-------- 2 files changed, 135 insertions(+), 99 deletions(-) diff --git a/reader/reader.go b/reader/reader.go index 6694657..9f7c444 100644 --- a/reader/reader.go +++ b/reader/reader.go @@ -103,6 +103,13 @@ type ( Reader struct { rs *trackingRuneScanner + symbolResolver SymbolResolver + + // map for function shorthand arguments. + // non-nil only when reading a function shorthand. + fnArgMap map[int]*value.Symbol + argCounter int + posStack []value.Pos } ) @@ -138,7 +145,15 @@ func New(r io.RuneScanner, opts ...Option) *Reader { opt(&o) } return &Reader{ - rs: newTrackingRuneScanner(r, o.filename), + rs: newTrackingRuneScanner(r, o.filename), + symbolResolver: o.resolver, + + // TODO: attain through a configured autogen function. + // + // we're starting at 3 here to match Clojure's behavior, which is + // likely determined by some internal behavior. improve this with a + // better test harness. + argCounter: 3, } } @@ -255,6 +270,8 @@ func (r *Reader) readExpr() (interface{}, error) { return r.readChar() case ':': return r.readKeyword() + case '%': + return r.readArg() // TODO: implement as reader macros case '\'': @@ -412,79 +429,98 @@ func (r *Reader) readString() (interface{}, error) { return str, nil } -func (r *Reader) readFunctionShorthand() (interface{}, error) { - r.pushSection() // for the list - lst, err := r.readList() +func (r *Reader) nextID() int { + id := r.argCounter + r.argCounter++ + return id +} + +func (r *Reader) genArg(i int) *value.Symbol { + prefix := "rest" + if i != -1 { + prefix = fmt.Sprintf("p%d", i) + } + return value.NewSymbol(fmt.Sprintf("%s__%d#", prefix, r.nextID())) +} + +func (r *Reader) readArg() (interface{}, error) { + r.rs.UnreadRune() + sym, err := r.readSymbol() if err != nil { return nil, err } - list := lst.(*value.List) - - // TODO: attain through a configured autogen function. - // - // we're starting at 3 here to match Clojure's behavior, which is - // likely determined by some internal behavior. improve this with a - // better test harness. - counter := 3 - var restSymbol *value.Symbol - argSymbols := make(map[int]*value.Symbol) - argCount := 0 - - body := make([]interface{}, 0, list.Count()) - for cur := list; !cur.IsEmpty(); cur = cur.Next() { - sym, ok := cur.First().(*value.Symbol) - if !ok || !strings.HasPrefix(sym.Name(), "%") { - body = append(body, cur.First()) - continue - } + // if we're not parsing function shorthand, just return the symbol + if r.fnArgMap == nil { + return sym, nil + } - argSuffix := sym.Name()[1:] - switch { - case argSuffix == "&": - if restSymbol == nil { - restSymbol = value.NewSymbol(fmt.Sprintf("rest__%d#", counter)) - } - body = append(body, restSymbol) - counter++ - case argSuffix == "": - if argCount == 0 { - argCount = 1 - } - if argSymbols[1] == nil { - argSymbols[1] = value.NewSymbol(fmt.Sprintf("p1__%d#", counter)) - } - body = append(body, argSymbols[1]) - counter++ - default: - argIndex, err := strconv.Atoi(argSuffix) - if err != nil { - return nil, r.error("arg literal must be %, %& or %integer") - } - if argIndex > argCount { - argCount = argIndex - } - if argSymbols[argIndex] == nil { - argSymbols[argIndex] = value.NewSymbol(fmt.Sprintf("p%d__%d#", argIndex, counter)) - } - body = append(body, argSymbols[argIndex]) - counter++ + argSuffix := sym.(*value.Symbol).Name()[1:] + switch { + case argSuffix == "&": + if r.fnArgMap[-1] == nil { + r.fnArgMap[-1] = r.genArg(-1) + } + return r.fnArgMap[-1], nil + case argSuffix == "": + if r.fnArgMap[1] == nil { + r.fnArgMap[1] = r.genArg(1) } + return r.fnArgMap[1], nil + default: + argIndex, err := strconv.Atoi(argSuffix) + if err != nil { + return nil, r.error("arg literal must be %, %& or %integer") + } + if r.fnArgMap[argIndex] == nil { + r.fnArgMap[argIndex] = r.genArg(argIndex) + } + return r.fnArgMap[argIndex], nil + } +} + +func (r *Reader) readFunctionShorthand() (interface{}, error) { + if r.fnArgMap != nil { + return nil, r.error("nested #()s are not allowed") + } + r.fnArgMap = make(map[int]*value.Symbol) + defer func() { + r.fnArgMap = nil + }() + + r.rs.UnreadRune() + body, err := r.readExpr() + if err != nil { + return nil, err } - var args []interface{} - for i := 1; i <= argCount; i++ { - if argSymbols[i] == nil { - argSymbols[i] = value.NewSymbol(fmt.Sprintf("p%d__%d#", i, counter)) - counter++ + + args := make([]interface{}, 0, len(r.fnArgMap)) + var restSym *value.Symbol + // NB: arg keys are 1-indexed, -1 represents a "rest" arg + for i, sym := range r.fnArgMap { + for i > len(args) { + args = append(args, nil) + } + if i == -1 { + restSym = sym + continue } - args = append(args, argSymbols[i]) + args[i-1] = sym } - if restSymbol != nil { - args = append(args, value.NewSymbol("&"), restSymbol) + if restSym != nil { + args = append(args, value.NewSymbol("&"), restSym) } + // fill in any missing args with generated args + for i, arg := range args { + if arg != nil { + continue + } + args[i] = r.genArg(i + 1) + } + return value.NewList([]interface{}{ value.NewSymbol("fn*"), value.NewVector(args), - value.NewList(body), + body, }, value.WithSection(r.popSection())), nil } diff --git a/reader/testdata/reader/core.out b/reader/testdata/reader/core.out index a86b801..410cb4c 100644 --- a/reader/testdata/reader/core.out +++ b/reader/testdata/reader/core.out @@ -254,16 +254,16 @@ (defmacro vswap! "Non-atomically swaps the value of the volatile as if:\n (apply f current-value-of-vol args). Returns the value that\n was swapped in." {:added "1.7"} [vol f & args] (let [v (with-meta vol {:tag (quote clojure.lang.Volatile)})] (quasiquote (.reset (clojure.core/unquote v) ((clojure.core/unquote f) (.deref (clojure.core/unquote v)) ~@args))))) (defn volatile? "Returns true if x is a volatile." {:added "1.7"} [x] (instance? clojure.lang.Volatile x)) (defn comp "Takes a set of functions and returns a fn that is the composition\n of those fns. The returned fn takes a variable number of args,\n applies the rightmost of fns to the args, the next\n fn (right-to-left) to the result, etc." {:added "1.0", :static true} ([] identity) ([f] f) ([f g] (fn ([] (f (g))) ([x] (f (g x))) ([x y] (f (g x y))) ([x y z] (f (g x y z))) ([x y z & args] (f (apply g x y z args))))) ([f g & fs] (reduce1 comp (list* f g fs)))) -(defn juxt "Takes a set of functions and returns a fn that is the juxtaposition\n of those fns. The returned fn takes a variable number of args, and\n returns a vector containing the result of applying each fn to the\n args (left-to-right).\n ((juxt a b c) x) => [(a x) (b x) (c x)]" {:added "1.1", :static true} ([f] (fn ([] [(f)]) ([x] [(f x)]) ([x y] [(f x y)]) ([x y z] [(f x y z)]) ([x y z & args] [(apply f x y z args)]))) ([f g] (fn ([] [(f) (g)]) ([x] [(f x) (g x)]) ([x y] [(f x y) (g x y)]) ([x y z] [(f x y z) (g x y z)]) ([x y z & args] [(apply f x y z args) (apply g x y z args)]))) ([f g h] (fn ([] [(f) (g) (h)]) ([x] [(f x) (g x) (h x)]) ([x y] [(f x y) (g x y) (h x y)]) ([x y z] [(f x y z) (g x y z) (h x y z)]) ([x y z & args] [(apply f x y z args) (apply g x y z args) (apply h x y z args)]))) ([f g h & fs] (let [fs (list* f g h fs)] (fn ([] (reduce1 (fn* [p1__3#] (conj p1__3# (%2))) [] fs)) ([x] (reduce1 (fn* [p1__3#] (conj p1__3# (%2 x))) [] fs)) ([x y] (reduce1 (fn* [p1__3#] (conj p1__3# (%2 x y))) [] fs)) ([x y z] (reduce1 (fn* [p1__3#] (conj p1__3# (%2 x y z))) [] fs)) ([x y z & args] (reduce1 (fn* [p1__3#] (conj p1__3# (apply %2 x y z args))) [] fs)))))) +(defn juxt "Takes a set of functions and returns a fn that is the juxtaposition\n of those fns. The returned fn takes a variable number of args, and\n returns a vector containing the result of applying each fn to the\n args (left-to-right).\n ((juxt a b c) x) => [(a x) (b x) (c x)]" {:added "1.1", :static true} ([f] (fn ([] [(f)]) ([x] [(f x)]) ([x y] [(f x y)]) ([x y z] [(f x y z)]) ([x y z & args] [(apply f x y z args)]))) ([f g] (fn ([] [(f) (g)]) ([x] [(f x) (g x)]) ([x y] [(f x y) (g x y)]) ([x y z] [(f x y z) (g x y z)]) ([x y z & args] [(apply f x y z args) (apply g x y z args)]))) ([f g h] (fn ([] [(f) (g) (h)]) ([x] [(f x) (g x) (h x)]) ([x y] [(f x y) (g x y) (h x y)]) ([x y z] [(f x y z) (g x y z) (h x y z)]) ([x y z & args] [(apply f x y z args) (apply g x y z args) (apply h x y z args)]))) ([f g h & fs] (let [fs (list* f g h fs)] (fn ([] (reduce1 (fn* [p1__4# p2__5#] (conj p1__4# (p2__5#))) [] fs)) ([x] (reduce1 (fn* [p1__6# p2__7#] (conj p1__6# (p2__7# x))) [] fs)) ([x y] (reduce1 (fn* [p1__8# p2__9#] (conj p1__8# (p2__9# x y))) [] fs)) ([x y z] (reduce1 (fn* [p1__10# p2__11#] (conj p1__10# (p2__11# x y z))) [] fs)) ([x y z & args] (reduce1 (fn* [p1__12# p2__13#] (conj p1__12# (apply p2__13# x y z args))) [] fs)))))) (defn partial "Takes a function f and fewer than the normal arguments to f, and\n returns a fn that takes a variable number of additional args. When\n called, the returned function calls f with args + additional args." {:added "1.0", :static true} ([f] f) ([f arg1] (fn ([] (f arg1)) ([x] (f arg1 x)) ([x y] (f arg1 x y)) ([x y z] (f arg1 x y z)) ([x y z & args] (apply f arg1 x y z args)))) ([f arg1 arg2] (fn ([] (f arg1 arg2)) ([x] (f arg1 arg2 x)) ([x y] (f arg1 arg2 x y)) ([x y z] (f arg1 arg2 x y z)) ([x y z & args] (apply f arg1 arg2 x y z args)))) ([f arg1 arg2 arg3] (fn ([] (f arg1 arg2 arg3)) ([x] (f arg1 arg2 arg3 x)) ([x y] (f arg1 arg2 arg3 x y)) ([x y z] (f arg1 arg2 arg3 x y z)) ([x y z & args] (apply f arg1 arg2 arg3 x y z args)))) ([f arg1 arg2 arg3 & more] (fn [& args] (apply f arg1 arg2 arg3 (concat more args))))) -(defn sequence "Coerces coll to a (possibly empty) sequence, if it is not already\n one. Will not force a lazy seq. (sequence nil) yields (), When a\n transducer is supplied, returns a lazy sequence of applications of\n the transform to the items in coll(s), i.e. to the set of first\n items of each coll, followed by the set of second\n items in each coll, until any one of the colls is exhausted. Any\n remaining items in other colls are ignored. The transform should accept\n number-of-colls arguments" {:added "1.0", :static true} ([coll] (if (seq? coll) coll (or (seq coll) ()))) ([xform coll] (or (clojure.lang.RT/chunkIteratorSeq (clojure.lang.TransformerIterator/create xform (clojure.lang.RT/iter coll))) ())) ([xform coll & colls] (or (clojure.lang.RT/chunkIteratorSeq (clojure.lang.TransformerIterator/createMulti xform (map (fn* [p1__3#] (clojure.lang.RT/iter p1__3#)) (cons coll colls)))) ()))) +(defn sequence "Coerces coll to a (possibly empty) sequence, if it is not already\n one. Will not force a lazy seq. (sequence nil) yields (), When a\n transducer is supplied, returns a lazy sequence of applications of\n the transform to the items in coll(s), i.e. to the set of first\n items of each coll, followed by the set of second\n items in each coll, until any one of the colls is exhausted. Any\n remaining items in other colls are ignored. The transform should accept\n number-of-colls arguments" {:added "1.0", :static true} ([coll] (if (seq? coll) coll (or (seq coll) ()))) ([xform coll] (or (clojure.lang.RT/chunkIteratorSeq (clojure.lang.TransformerIterator/create xform (clojure.lang.RT/iter coll))) ())) ([xform coll & colls] (or (clojure.lang.RT/chunkIteratorSeq (clojure.lang.TransformerIterator/createMulti xform (map (fn* [p1__14#] (clojure.lang.RT/iter p1__14#)) (cons coll colls)))) ()))) (defn every? "Returns true if (pred x) is logical true for every x in coll, else\n false." {:tag Boolean, :added "1.0", :static true} [pred coll] (cond (nil? (seq coll)) true (pred (first coll)) (recur pred (next coll)) :else false)) (def not-every? (comp not every?)) (defn some "Returns the first logical true value of (pred x) for any x in coll,\n else nil. One common idiom is to use a set as pred, for example\n this will return :fred if :fred is in the sequence, otherwise nil:\n (some #{:fred} coll)" {:added "1.0", :static true} [pred coll] (when-let [s (seq coll)] (or (pred (first s)) (recur pred (next s))))) (def not-any? (comp not some)) (defmacro dotimes "bindings => name n\n\n Repeatedly executes body (presumably for side-effects) with name\n bound to integers from 0 through n-1." {:added "1.0"} [bindings & body] (let [i (first bindings) n (second bindings)] (quasiquote (let [n# (clojure.lang.RT/longCast (clojure.core/unquote n))] (loop [(clojure.core/unquote i) 0] (when (< (clojure.core/unquote i) n#) ~@body (recur (unchecked-inc (clojure.core/unquote i))))))))) -(defn map "Returns a lazy sequence consisting of the result of applying f to\n the set of first items of each coll, followed by applying f to the\n set of second items in each coll, until any one of the colls is\n exhausted. Any remaining items in other colls are ignored. Function\n f should accept number-of-colls arguments. Returns a transducer when\n no collection is provided." {:added "1.0", :static true} ([f] (fn [rf] (fn ([] (rf)) ([result] (rf result)) ([result input] (rf result (f input))) ([result input & inputs] (rf result (apply f input inputs)))))) ([f coll] (lazy-seq (when-let [s (seq coll)] (if (chunked-seq? s) (let [c (chunk-first s) size (int (count c)) b (chunk-buffer size)] (dotimes [i size] (chunk-append b (f (.nth c i)))) (chunk-cons (chunk b) (map f (chunk-rest s)))) (cons (f (first s)) (map f (rest s))))))) ([f c1 c2] (lazy-seq (let [s1 (seq c1) s2 (seq c2)] (when (and s1 s2) (cons (f (first s1) (first s2)) (map f (rest s1) (rest s2))))))) ([f c1 c2 c3] (lazy-seq (let [s1 (seq c1) s2 (seq c2) s3 (seq c3)] (when (and s1 s2 s3) (cons (f (first s1) (first s2) (first s3)) (map f (rest s1) (rest s2) (rest s3))))))) ([f c1 c2 c3 & 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)))))))] (map (fn* [p1__3#] (apply f p1__3#)) (step (conj colls c3 c2 c1)))))) -(defmacro declare "defs the supplied var names with no bindings, useful for making forward declarations." {:added "1.0"} [& names] (quasiquote (do ~@(map (fn* [] (list (quote def) (vary-meta % assoc :declared true))) names)))) +(defn map "Returns a lazy sequence consisting of the result of applying f to\n the set of first items of each coll, followed by applying f to the\n set of second items in each coll, until any one of the colls is\n exhausted. Any remaining items in other colls are ignored. Function\n f should accept number-of-colls arguments. Returns a transducer when\n no collection is provided." {:added "1.0", :static true} ([f] (fn [rf] (fn ([] (rf)) ([result] (rf result)) ([result input] (rf result (f input))) ([result input & inputs] (rf result (apply f input inputs)))))) ([f coll] (lazy-seq (when-let [s (seq coll)] (if (chunked-seq? s) (let [c (chunk-first s) size (int (count c)) b (chunk-buffer size)] (dotimes [i size] (chunk-append b (f (.nth c i)))) (chunk-cons (chunk b) (map f (chunk-rest s)))) (cons (f (first s)) (map f (rest s))))))) ([f c1 c2] (lazy-seq (let [s1 (seq c1) s2 (seq c2)] (when (and s1 s2) (cons (f (first s1) (first s2)) (map f (rest s1) (rest s2))))))) ([f c1 c2 c3] (lazy-seq (let [s1 (seq c1) s2 (seq c2) s3 (seq c3)] (when (and s1 s2 s3) (cons (f (first s1) (first s2) (first s3)) (map f (rest s1) (rest s2) (rest s3))))))) ([f c1 c2 c3 & 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)))))))] (map (fn* [p1__15#] (apply f p1__15#)) (step (conj colls c3 c2 c1)))))) +(defmacro declare "defs the supplied var names with no bindings, useful for making forward declarations." {:added "1.0"} [& names] (quasiquote (do ~@(map (fn* [p1__16#] (list (quote def) (vary-meta p1__16# assoc :declared true))) names)))) (declare cat) (defn mapcat "Returns the result of applying concat to the result of applying map\n to f and colls. Thus function f should return a collection. Returns\n a transducer when no collections are provided" {:added "1.0", :static true} ([f] (comp (map f) cat)) ([f & colls] (apply concat (apply map f colls)))) (defn filter "Returns a lazy sequence of the items in coll for which\n (pred item) returns logical true. pred must be free of side-effects.\n Returns a transducer when no collection is provided." {:added "1.0", :static true} ([pred] (fn [rf] (fn ([] (rf)) ([result] (rf result)) ([result input] (if (pred input) (rf result input) result))))) ([pred coll] (lazy-seq (when-let [s (seq coll)] (if (chunked-seq? s) (let [c (chunk-first s) size (count c) b (chunk-buffer size)] (dotimes [i size] (let [v (.nth c i)] (when (pred v) (chunk-append b v)))) (chunk-cons (chunk b) (filter pred (chunk-rest s)))) (let [f (first s) r (rest s)] (if (pred f) (cons f (filter pred r)) (filter pred r)))))))) @@ -285,7 +285,7 @@ (defn replicate "DEPRECATED: Use 'repeat' instead.\n Returns a lazy seq of n xs." {:added "1.0", :deprecated "1.3"} [n x] (take n (repeat x))) (defn iterate "Returns a lazy sequence of x, (f x), (f (f x)) etc. f must be free of side-effects" {:added "1.0", :static true} [f x] (clojure.lang.Iterate/create f x)) (defn range "Returns a lazy seq of nums from start (inclusive) to end\n (exclusive), by step, where start defaults to 0, step to 1, and end to\n infinity. When step is equal to 0, returns an infinite sequence of\n start. When start is equal to end, returns empty list." {:added "1.0", :static true} ([] (iterate inc' 0)) ([end] (if (instance? Long end) (clojure.lang.LongRange/create end) (clojure.lang.Range/create end))) ([start end] (if (and (instance? Long start) (instance? Long end)) (clojure.lang.LongRange/create start end) (clojure.lang.Range/create start end))) ([start end step] (if (and (instance? Long start) (instance? Long end) (instance? Long step)) (clojure.lang.LongRange/create start end step) (clojure.lang.Range/create start end step)))) -(defn merge "Returns a map that consists of the rest of the maps conj-ed onto\n the first. If a key occurs in more than one map, the mapping from\n the latter (left-to-right) will be the mapping in the result." {:added "1.0", :static true} [& maps] (when (some identity maps) (reduce1 (fn* [p1__4# p2__3#] (conj (or %1 {}) p2__3#)) maps))) +(defn merge "Returns a map that consists of the rest of the maps conj-ed onto\n the first. If a key occurs in more than one map, the mapping from\n the latter (left-to-right) will be the mapping in the result." {:added "1.0", :static true} [& maps] (when (some identity maps) (reduce1 (fn* [p1__17# p2__18#] (conj (or p1__17# {}) p2__18#)) maps))) (defn merge-with "Returns a map that consists of the rest of the maps conj-ed onto\n the first. If a key occurs in more than one map, the mapping(s)\n from the latter (left-to-right) will be combined with the mapping in\n the result by calling (f val-in-result val-in-latter)." {:added "1.0", :static true} [f & maps] (when (some identity maps) (let [merge-entry (fn [m e] (let [k (key e) v (val e)] (if (contains? m k) (assoc m k (f (get m k) v)) (assoc m k v)))) merge2 (fn [m1 m2] (reduce1 merge-entry (or m1 {}) (seq m2)))] (reduce1 merge2 maps)))) (defn line-seq "Returns the lines of text from rdr as a lazy sequence of strings.\n rdr must implement java.io.BufferedReader." {:added "1.0", :static true} [rdr] (when-let [line (.readLine rdr)] (cons line (lazy-seq (line-seq rdr))))) (defn comparator "Returns an implementation of java.util.Comparator based upon pred." {:added "1.0", :static true} [pred] (fn [x y] (cond (pred x y) -1 (pred y x) 1 :else 0))) @@ -310,7 +310,7 @@ (defn pop! "Removes the last item from a transient vector. If\n the collection is empty, throws an exception. Returns coll" {:added "1.1", :static true} [coll] (.pop coll)) (defn disj! "disj[oin]. Returns a transient set of the same (hashed/sorted) type, that\n does not contain key(s)." {:added "1.1", :static true} ([set] set) ([set key] (. set (disjoin key))) ([set key & ks] (let [ret (. set (disjoin key))] (if ks (recur ret (first ks) (next ks)) ret)))) (defn into1 "Returns a new coll consisting of to-coll with all of the items of\n from-coll conjoined." {:added "1.0", :static true} [to from] (if (instance? clojure.lang.IEditableCollection to) (persistent! (reduce1 conj! (transient to) from)) (reduce1 conj to from))) -(defmacro import "import-list => (package-symbol class-name-symbols*)\n\n For each name in class-name-symbols, adds a mapping from name to the\n class named by package.name to the current namespace. Use :import in the ns\n macro in preference to calling this directly." {:added "1.0"} [& import-symbols-or-lists] (let [specs (map (fn* [p1__3#] (if (and (seq? %) (= (quote quote) (first %))) (second %) p1__3#)) import-symbols-or-lists)] (quasiquote (do ~@(map (fn* [p1__3#] (list (quote clojure.core/import*) p1__3#)) (reduce1 (fn [v spec] (if (symbol? spec) (conj v (name spec)) (let [p (first spec) cs (rest spec)] (into1 v (map (fn* [p1__3#] (str p "." p1__3#)) cs))))) [] specs)))))) +(defmacro import "import-list => (package-symbol class-name-symbols*)\n\n For each name in class-name-symbols, adds a mapping from name to the\n class named by package.name to the current namespace. Use :import in the ns\n macro in preference to calling this directly." {:added "1.0"} [& import-symbols-or-lists] (let [specs (map (fn* [p1__19#] (if (and (seq? p1__19#) (= (quote quote) (first p1__19#))) (second p1__19#) p1__19#)) import-symbols-or-lists)] (quasiquote (do ~@(map (fn* [p1__20#] (list (quote clojure.core/import*) p1__20#)) (reduce1 (fn [v spec] (if (symbol? spec) (conj v (name spec)) (let [p (first spec) cs (rest spec)] (into1 v (map (fn* [p1__21#] (str p "." p1__21#)) cs))))) [] specs)))))) (defn into-array "Returns an array with components set to the values in aseq. The array's\n component type is type if provided, or the type of the first value in\n aseq if present, or Object. All values in aseq must be compatible with\n the component type. Class objects for the primitive types can be obtained\n using, e.g., Integer/TYPE." {:added "1.0", :static true} ([aseq] (clojure.lang.RT/seqToTypedArray (seq aseq))) ([type aseq] (clojure.lang.RT/seqToTypedArray type (seq aseq)))) (defn array [& items] (into-array items)) (defn class "Returns the Class of x" {:added "1.0", :static true} [x] (if (nil? x) x (. x (getClass)))) @@ -413,13 +413,13 @@ (defn resolve "same as (ns-resolve *ns* symbol) or (ns-resolve *ns* &env symbol)" {:added "1.0", :static true} ([sym] (ns-resolve *ns* sym)) ([env sym] (ns-resolve *ns* env sym))) (defn array-map "Constructs an array-map. If any keys are equal, they are handled as\n if by repeated uses of assoc." {:added "1.0", :static true} ([] (. clojure.lang.PersistentArrayMap EMPTY)) ([& keyvals] (let [ary (to-array keyvals)] (if (odd? (alength ary)) (throw (IllegalArgumentException. (str "No value supplied for key: " (last keyvals)))) (clojure.lang.PersistentArrayMap/createAsIfByAssoc ary))))) (defn seq-to-map-for-destructuring "Builds a map from a seq as described in\n https://clojure.org/reference/special_forms#keyword-arguments" {:added "1.11"} [s] (if (next s) (clojure.lang.PersistentArrayMap/createAsIfByAssoc (to-array s)) (if (seq s) (first s) clojure.lang.PersistentArrayMap/EMPTY))) -(defn destructure [bindings] (let [bents (partition 2 bindings) pb (fn pb [bvec b v] (let [pvec (fn [bvec b val] (let [gvec (gensym "vec__") gseq (gensym "seq__") gfirst (gensym "first__") has-rest (some #{(quote &)} b)] (loop [ret (let [ret (conj bvec gvec val)] (if has-rest (conj ret gseq (list (quasiquote seq) gvec)) ret)) n 0 bs b seen-rest? false] (if (seq bs) (let [firstb (first bs)] (cond (= firstb (quote &)) (recur (pb ret (second bs) gseq) n (nnext bs) true) (= firstb :as) (pb ret (second bs) gvec) :else (if seen-rest? (throw (new Exception "Unsupported binding form, only :as can follow & parameter")) (recur (pb (if has-rest (conj ret gfirst (quasiquote (first (clojure.core/unquote gseq))) gseq (quasiquote (next (clojure.core/unquote gseq)))) ret) firstb (if has-rest gfirst (list (quasiquote nth) gvec n nil))) (inc n) (next bs) seen-rest?)))) ret)))) pmap (fn [bvec b v] (let [gmap (gensym "map__") gmapseq (with-meta gmap {:tag (quote clojure.lang.ISeq)}) defaults (:or b)] (loop [ret (-> bvec (conj gmap) (conj v) (conj gmap) (conj (quasiquote (if (seq? (clojure.core/unquote gmap)) (if (next (clojure.core/unquote gmapseq)) (clojure.lang.PersistentArrayMap/createAsIfByAssoc (to-array (clojure.core/unquote gmapseq))) (if (seq (clojure.core/unquote gmapseq)) (first (clojure.core/unquote gmapseq)) clojure.lang.PersistentArrayMap/EMPTY)) (clojure.core/unquote gmap)))) ((fn [ret] (if (:as b) (conj ret (:as b) gmap) ret)))) bes (let [transforms (reduce1 (fn [transforms mk] (if (keyword? mk) (let [mkns (namespace mk) mkn (name mk)] (cond (= mkn "keys") (assoc transforms mk (fn* [] (keyword (or mkns (namespace %)) (name %)))) (= mkn "syms") (assoc transforms mk (fn* [] (list (quasiquote quote) (symbol (or mkns (namespace %)) (name %))))) (= mkn "strs") (assoc transforms mk str) :else transforms)) transforms)) {} (keys b))] (reduce1 (fn [bes entry] (reduce1 (fn* [p1__3# p2__4#] (assoc p1__3# p2__4# ((val entry) %2))) (dissoc bes (key entry)) ((key entry) bes))) (dissoc b :as :or) transforms))] (if (seq bes) (let [bb (key (first bes)) bk (val (first bes)) local (if (instance? clojure.lang.Named bb) (with-meta (symbol nil (name bb)) (meta bb)) bb) bv (if (contains? defaults local) (list (quasiquote get) gmap bk (defaults local)) (list (quasiquote get) gmap bk))] (recur (if (ident? bb) (-> ret (conj local bv)) (pb ret bb bv)) (next bes))) ret))))] (cond (symbol? b) (-> bvec (conj b) (conj v)) (vector? b) (pvec bvec b v) (map? b) (pmap bvec b v) :else (throw (new Exception (str "Unsupported binding form: " b)))))) process-entry (fn [bvec b] (pb bvec (first b) (second b)))] (if (every? symbol? (map first bents)) bindings (reduce1 process-entry [] bents)))) +(defn destructure [bindings] (let [bents (partition 2 bindings) pb (fn pb [bvec b v] (let [pvec (fn [bvec b val] (let [gvec (gensym "vec__") gseq (gensym "seq__") gfirst (gensym "first__") has-rest (some #{(quote &)} b)] (loop [ret (let [ret (conj bvec gvec val)] (if has-rest (conj ret gseq (list (quasiquote seq) gvec)) ret)) n 0 bs b seen-rest? false] (if (seq bs) (let [firstb (first bs)] (cond (= firstb (quote &)) (recur (pb ret (second bs) gseq) n (nnext bs) true) (= firstb :as) (pb ret (second bs) gvec) :else (if seen-rest? (throw (new Exception "Unsupported binding form, only :as can follow & parameter")) (recur (pb (if has-rest (conj ret gfirst (quasiquote (first (clojure.core/unquote gseq))) gseq (quasiquote (next (clojure.core/unquote gseq)))) ret) firstb (if has-rest gfirst (list (quasiquote nth) gvec n nil))) (inc n) (next bs) seen-rest?)))) ret)))) pmap (fn [bvec b v] (let [gmap (gensym "map__") gmapseq (with-meta gmap {:tag (quote clojure.lang.ISeq)}) defaults (:or b)] (loop [ret (-> bvec (conj gmap) (conj v) (conj gmap) (conj (quasiquote (if (seq? (clojure.core/unquote gmap)) (if (next (clojure.core/unquote gmapseq)) (clojure.lang.PersistentArrayMap/createAsIfByAssoc (to-array (clojure.core/unquote gmapseq))) (if (seq (clojure.core/unquote gmapseq)) (first (clojure.core/unquote gmapseq)) clojure.lang.PersistentArrayMap/EMPTY)) (clojure.core/unquote gmap)))) ((fn [ret] (if (:as b) (conj ret (:as b) gmap) ret)))) bes (let [transforms (reduce1 (fn [transforms mk] (if (keyword? mk) (let [mkns (namespace mk) mkn (name mk)] (cond (= mkn "keys") (assoc transforms mk (fn* [p1__22#] (keyword (or mkns (namespace p1__22#)) (name p1__22#)))) (= mkn "syms") (assoc transforms mk (fn* [p1__23#] (list (quasiquote quote) (symbol (or mkns (namespace p1__23#)) (name p1__23#))))) (= mkn "strs") (assoc transforms mk str) :else transforms)) transforms)) {} (keys b))] (reduce1 (fn [bes entry] (reduce1 (fn* [p1__24# p2__25#] (assoc p1__24# p2__25# ((val entry) p2__25#))) (dissoc bes (key entry)) ((key entry) bes))) (dissoc b :as :or) transforms))] (if (seq bes) (let [bb (key (first bes)) bk (val (first bes)) local (if (instance? clojure.lang.Named bb) (with-meta (symbol nil (name bb)) (meta bb)) bb) bv (if (contains? defaults local) (list (quasiquote get) gmap bk (defaults local)) (list (quasiquote get) gmap bk))] (recur (if (ident? bb) (-> ret (conj local bv)) (pb ret bb bv)) (next bes))) ret))))] (cond (symbol? b) (-> bvec (conj b) (conj v)) (vector? b) (pvec bvec b v) (map? b) (pmap bvec b v) :else (throw (new Exception (str "Unsupported binding form: " b)))))) process-entry (fn [bvec b] (pb bvec (first b) (second b)))] (if (every? symbol? (map first bents)) bindings (reduce1 process-entry [] bents)))) (defmacro let "binding => binding-form init-expr\n binding-form => name, or destructuring-form\n destructuring-form => map-destructure-form, or seq-destructure-form\n\n Evaluates the exprs in a lexical context in which the symbols in\n the binding-forms are bound to their respective init-exprs or parts\n therein.\n\n See https://clojure.org/reference/special_forms#binding-forms for\n more information about destructuring." {:added "1.0", :special-form true, :forms (quote [(let [bindings*] exprs*)])} [bindings & body] (assert-args (vector? bindings) "a vector for its binding" (even? (count bindings)) "an even number of forms in binding vector") (quasiquote (let* (clojure.core/unquote (destructure bindings)) ~@body))) (defn maybe-destructured [params body] (if (every? symbol? params) (cons params body) (loop [params params new-params (with-meta [] (meta params)) lets []] (if params (if (symbol? (first params)) (recur (next params) (conj new-params (first params)) lets) (let [gparam (gensym "p__")] (recur (next params) (conj new-params gparam) (-> lets (conj (first params)) (conj gparam))))) (quasiquote ((clojure.core/unquote new-params) (let (clojure.core/unquote lets) ~@body))))))) (defmacro fn "params => positional-params*, or positional-params* & rest-param\n positional-param => binding-form\n rest-param => binding-form\n binding-form => name, or destructuring-form\n\n Defines a function.\n\n See https://clojure.org/reference/special_forms#fn for more information" {:added "1.0", :special-form true, :forms (quote [(fn name? [params*] exprs*) (fn name? ([params*] exprs*) +)])} [& sigs] (let [name (if (symbol? (first sigs)) (first sigs) nil) sigs (if name (next sigs) sigs) sigs (if (vector? (first sigs)) (list sigs) (if (seq? (first sigs)) sigs (throw (IllegalArgumentException. (if (seq sigs) (str "Parameter declaration " (first sigs) " should be a vector") (str "Parameter declaration missing")))))) psig (fn* [sig] (when (not (seq? sig)) (throw (IllegalArgumentException. (str "Invalid signature " sig " should be a list")))) (let [[params & body] sig _ (when (not (vector? params)) (throw (IllegalArgumentException. (if (seq? (first sigs)) (str "Parameter declaration " params " should be a vector") (str "Invalid signature " sig " should be a list"))))) conds (when (and (next body) (map? (first body))) (first body)) body (if conds (next body) body) conds (or conds (meta params)) pre (:pre conds) post (:post conds) body (if post (quasiquote ((let [(clojure.core/unquote (quote %)) (clojure.core/unquote (if (< 1 (count body)) (quasiquote (do ~@body)) (first body)))] ~@(map (fn* [c] (quasiquote (assert (clojure.core/unquote c)))) post) (clojure.core/unquote (quote %))))) body) body (if pre (concat (map (fn* [c] (quasiquote (assert (clojure.core/unquote c)))) pre) body) body)] (maybe-destructured params body))) new-sigs (map psig sigs)] (with-meta (if name (list* (quote fn*) name new-sigs) (cons (quote fn*) new-sigs)) (meta &form)))) (defmacro loop "Evaluates the exprs in a lexical context in which the symbols in\n the binding-forms are bound to their respective init-exprs or parts\n therein. Acts as a recur target." {:added "1.0", :special-form true, :forms (quote [(loop [bindings*] exprs*)])} [bindings & body] (assert-args (vector? bindings) "a vector for its binding" (even? (count bindings)) "an even number of forms in binding vector") (let [db (destructure bindings)] (if (= db bindings) (quasiquote (loop* (clojure.core/unquote bindings) ~@body)) (let [vs (take-nth 2 (drop 1 bindings)) bs (take-nth 2 bindings) gs (map (fn [b] (if (symbol? b) b (gensym))) bs) bfs (reduce1 (fn [ret [b v g]] (if (symbol? b) (conj ret g v) (conj ret g v b g))) [] (map vector bs vs gs))] (quasiquote (let (clojure.core/unquote bfs) (loop* (clojure.core/unquote (vec (interleave gs gs))) (let (clojure.core/unquote (vec (interleave bs gs))) ~@body)))))))) (defmacro when-first "bindings => x xs\n\n Roughly the same as (when (seq xs) (let [x (first xs)] body)) but xs is evaluated only once" {:added "1.0"} [bindings & body] (assert-args (vector? bindings) "a vector for its binding" (= 2 (count bindings)) "exactly 2 forms in binding vector") (let [[x xs] bindings] (quasiquote (when-let [xs# (seq (clojure.core/unquote xs))] (let [(clojure.core/unquote x) (first xs#)] ~@body))))) -(defmacro lazy-cat "Expands to code which yields a lazy sequence of the concatenation\n of the supplied colls. Each coll expr is not evaluated until it is\n needed. \n\n (lazy-cat xs ys zs) === (concat (lazy-seq xs) (lazy-seq ys) (lazy-seq zs))" {:added "1.0"} [& colls] (quasiquote (concat ~@(map (fn* [p1__3#] (list (quasiquote lazy-seq) p1__3#)) colls)))) +(defmacro lazy-cat "Expands to code which yields a lazy sequence of the concatenation\n of the supplied colls. Each coll expr is not evaluated until it is\n needed. \n\n (lazy-cat xs ys zs) === (concat (lazy-seq xs) (lazy-seq ys) (lazy-seq zs))" {:added "1.0"} [& colls] (quasiquote (concat ~@(map (fn* [p1__26#] (list (quasiquote lazy-seq) p1__26#)) colls)))) (defmacro for "List comprehension. Takes a vector of one or more\n binding-form/collection-expr pairs, each followed by zero or more\n modifiers, and yields a lazy sequence of evaluations of expr.\n Collections are iterated in a nested fashion, rightmost fastest,\n and nested coll-exprs can refer to bindings created in prior\n binding-forms. Supported modifiers are: :let [binding-form expr ...],\n :while test, :when test.\n\n (take 100 (for [x (range 100000000) y (range 1000000) :while (< y x)] [x y]))" {:added "1.0"} [seq-exprs body-expr] (assert-args (vector? seq-exprs) "a vector for its binding" (even? (count seq-exprs)) "an even number of forms in binding vector") (let [to-groups (fn [seq-exprs] (reduce1 (fn [groups [k v]] (if (keyword? k) (conj (pop groups) (conj (peek groups) [k v])) (conj groups [k v]))) [] (partition 2 seq-exprs))) err (fn [& msg] (throw (IllegalArgumentException. (apply str msg)))) emit-bind (fn emit-bind [[[bind expr & mod-pairs] & [[_ next-expr] :as next-groups]]] (let [giter (gensym "iter__") gxs (gensym "s__") do-mod (fn do-mod [[[k v :as pair] & etc]] (cond (= k :let) (quasiquote (let (clojure.core/unquote v) (clojure.core/unquote (do-mod etc)))) (= k :while) (quasiquote (when (clojure.core/unquote v) (clojure.core/unquote (do-mod etc)))) (= k :when) (quasiquote (if (clojure.core/unquote v) (clojure.core/unquote (do-mod etc)) (recur (rest (clojure.core/unquote gxs))))) (keyword? k) (err "Invalid 'for' keyword " k) next-groups (quasiquote (let [iterys# (clojure.core/unquote (emit-bind next-groups)) fs# (seq (iterys# (clojure.core/unquote next-expr)))] (if fs# (concat fs# ((clojure.core/unquote giter) (rest (clojure.core/unquote gxs)))) (recur (rest (clojure.core/unquote gxs)))))) :else (quasiquote (cons (clojure.core/unquote body-expr) ((clojure.core/unquote giter) (rest (clojure.core/unquote gxs)))))))] (if next-groups (quasiquote (fn (clojure.core/unquote giter) [(clojure.core/unquote gxs)] (lazy-seq (loop [(clojure.core/unquote gxs) (clojure.core/unquote gxs)] (when-first [(clojure.core/unquote bind) (clojure.core/unquote gxs)] (clojure.core/unquote (do-mod mod-pairs))))))) (let [gi (gensym "i__") gb (gensym "b__") do-cmod (fn do-cmod [[[k v :as pair] & etc]] (cond (= k :let) (quasiquote (let (clojure.core/unquote v) (clojure.core/unquote (do-cmod etc)))) (= k :while) (quasiquote (when (clojure.core/unquote v) (clojure.core/unquote (do-cmod etc)))) (= k :when) (quasiquote (if (clojure.core/unquote v) (clojure.core/unquote (do-cmod etc)) (recur (unchecked-inc (clojure.core/unquote gi))))) (keyword? k) (err "Invalid 'for' keyword " k) :else (quasiquote (do (chunk-append (clojure.core/unquote gb) (clojure.core/unquote body-expr)) (recur (unchecked-inc (clojure.core/unquote gi)))))))] (quasiquote (fn (clojure.core/unquote giter) [(clojure.core/unquote gxs)] (lazy-seq (loop [(clojure.core/unquote gxs) (clojure.core/unquote gxs)] (when-let [(clojure.core/unquote gxs) (seq (clojure.core/unquote gxs))] (if (chunked-seq? (clojure.core/unquote gxs)) (let [c# (chunk-first (clojure.core/unquote gxs)) size# (int (count c#)) (clojure.core/unquote gb) (chunk-buffer size#)] (if (loop [(clojure.core/unquote gi) (int 0)] (if (< (clojure.core/unquote gi) size#) (let [(clojure.core/unquote bind) (.nth c# (clojure.core/unquote gi))] (clojure.core/unquote (do-cmod mod-pairs))) true)) (chunk-cons (chunk (clojure.core/unquote gb)) ((clojure.core/unquote giter) (chunk-rest (clojure.core/unquote gxs)))) (chunk-cons (chunk (clojure.core/unquote gb)) nil))) (let [(clojure.core/unquote bind) (first (clojure.core/unquote gxs))] (clojure.core/unquote (do-mod mod-pairs)))))))))))))] (quasiquote (let [iter# (clojure.core/unquote (emit-bind (to-groups seq-exprs)))] (iter# (clojure.core/unquote (second seq-exprs))))))) (defmacro comment "Ignores body, yields nil" {:added "1.0"} [& body]) (defmacro with-out-str "Evaluates exprs in a context in which *out* is bound to a fresh\n StringWriter. Returns the string created by any nested printing\n calls." {:added "1.0"} [& body] (quasiquote (let [s# (new java.io.StringWriter)] (binding [*out* s#] ~@body (str s#))))) @@ -429,7 +429,7 @@ (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 clojure.lang.IExceptionInfo) -(defn elide-top-frames [ex class-name] (let [tr (.getStackTrace ex)] (doto ex (.setStackTrace (when tr (into-array StackTraceElement (drop-while (fn* [] (= class-name (.getClassName %1))) tr))))))) +(defn elide-top-frames [ex class-name] (let [tr (.getStackTrace ex)] (doto ex (.setStackTrace (when tr (into-array StackTraceElement (drop-while (fn* [p1__27#] (= class-name (.getClassName p1__27#))) tr))))))) (defn ex-info "Create an instance of ExceptionInfo, a RuntimeException subclass\n that carries a map of additional data." {:added "1.4"} ([msg map] (elide-top-frames (ExceptionInfo. msg map) "clojure.core$ex_info")) ([msg map cause] (elide-top-frames (ExceptionInfo. msg map cause) "clojure.core$ex_info"))) (defn ex-data "Returns exception data (a map) if ex is an IExceptionInfo.\n Otherwise returns nil." {:added "1.4"} [ex] (when (instance? IExceptionInfo ex) (.getData ex))) (defn ex-message "Returns the message attached to ex if ex is a Throwable.\n Otherwise returns nil." {:added "1.10"} [ex] (when (instance? Throwable ex) (.getMessage ex))) @@ -454,7 +454,7 @@ (defn max-key "Returns the x for which (k x), a number, is greatest.\n\n If there are multiple such xs, the last one is returned." {:added "1.0", :static true} ([k x] x) ([k x y] (if (> (k x) (k y)) x y)) ([k x y & more] (let [kx (k x) ky (k y) [v kv] (if (> kx ky) [x kx] [y ky])] (loop [v v kv kv more more] (if more (let [w (first more) kw (k w)] (if (>= kw kv) (recur w kw (next more)) (recur v kv (next more)))) v))))) (defn min-key "Returns the x for which (k x), a number, is least.\n\n If there are multiple such xs, the last one is returned." {:added "1.0", :static true} ([k x] x) ([k x y] (if (< (k x) (k y)) x y)) ([k x y & more] (let [kx (k x) ky (k y) [v kv] (if (< kx ky) [x kx] [y ky])] (loop [v v kv kv more more] (if more (let [w (first more) kw (k w)] (if (<= kw kv) (recur w kw (next more)) (recur v kv (next more)))) v))))) (defn distinct "Returns a lazy sequence of the elements of coll with duplicates removed.\n Returns a stateful transducer when no collection is provided." {:added "1.0", :static true} ([] (fn [rf] (let [seen (volatile! #{})] (fn ([] (rf)) ([result] (rf result)) ([result input] (if (contains? (clojure.core/deref seen) input) result (do (vswap! seen conj input) (rf result input)))))))) ([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 #{})))) -(defn replace "Given a map of replacement pairs and a vector/collection, returns a\n vector/seq with any elements = a key in smap replaced with the\n corresponding val in smap. Returns a transducer when no collection\n is provided." {:added "1.0", :static true} ([smap] (map (fn* [p1__3#] (if-let [e (find smap %)] (val e) p1__3#)))) ([smap coll] (if (vector? coll) (reduce1 (fn [v i] (if-let [e (find smap (nth v i))] (assoc v i (val e)) v)) coll (range (count coll))) (map (fn* [p1__3#] (if-let [e (find smap %)] (val e) p1__3#)) coll)))) +(defn replace "Given a map of replacement pairs and a vector/collection, returns a\n vector/seq with any elements = a key in smap replaced with the\n corresponding val in smap. Returns a transducer when no collection\n is provided." {:added "1.0", :static true} ([smap] (map (fn* [p1__28#] (if-let [e (find smap p1__28#)] (val e) p1__28#)))) ([smap coll] (if (vector? coll) (reduce1 (fn [v i] (if-let [e (find smap (nth v i))] (assoc v i (val e)) v)) coll (range (count coll))) (map (fn* [p1__29#] (if-let [e (find smap p1__29#)] (val e) p1__29#)) coll)))) (defmacro dosync "Runs the exprs (in an implicit do) in a transaction that encompasses\n exprs and any nested calls. Starts a transaction if none is already\n running on this thread. Any uncaught exception will abort the\n transaction and flow out of dosync. The exprs may be run more than\n once, but any effects on Refs will be atomic." {:added "1.0"} [& exprs] (quasiquote (sync nil ~@exprs))) (defmacro with-precision "Sets the precision and rounding mode to be used for BigDecimal operations.\n\n Usage: (with-precision 10 (/ 1M 3))\n or: (with-precision 10 :rounding HALF_DOWN (/ 1M 3))\n\n The rounding mode is one of CEILING, FLOOR, HALF_UP, HALF_DOWN,\n 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)) (quasiquote ((. java.math.RoundingMode (clojure.core/unquote (second exprs)))))] [exprs nil])] (quasiquote (binding [*math-context* (java.math.MathContext. (clojure.core/unquote precision) ~@rm)] ~@body)))) (defn mk-bound-fn {:private true} [sc test key] (fn [e] (test (.. sc comparator (compare (. sc entryKey e) key)) 0))) @@ -500,45 +500,45 @@ (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) (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 alter-var-root "Atomically alters the root binding of var v by applying f to its\n current value plus any args" {:added "1.0", :static true} [v f & args] (.alterRoot v f args)) -(defn bound? "Returns true if all of the vars provided as arguments have any bound value, root or thread-local.\n Implies that deref'ing the provided vars will succeed. Returns true if no vars are provided." {:added "1.2", :static true} [& vars] (every? (fn* [p1__3#] (.isBound p1__3#)) vars)) -(defn thread-bound? "Returns true if all of the vars provided as arguments have thread-local bindings.\n Implies that set!'ing the provided vars will succeed. Returns true if no vars are provided." {:added "1.2", :static true} [& vars] (every? (fn* [p1__3#] (.getThreadBinding p1__3#)) vars)) +(defn bound? "Returns true if all of the vars provided as arguments have any bound value, root or thread-local.\n Implies that deref'ing the provided vars will succeed. Returns true if no vars are provided." {:added "1.2", :static true} [& vars] (every? (fn* [p1__30#] (.isBound p1__30#)) vars)) +(defn thread-bound? "Returns true if all of the vars provided as arguments have thread-local bindings.\n Implies that set!'ing the provided vars will succeed. Returns true if no vars are provided." {:added "1.2", :static true} [& vars] (every? (fn* [p1__31#] (.getThreadBinding p1__31#)) vars)) (defn make-hierarchy "Creates a hierarchy object for use with derive, isa? etc." {:added "1.0", :static true} [] {:parents {}, :descendants {}, :ancestors {}}) (def global-hierarchy (make-hierarchy)) (defn not-empty "If coll is empty, returns nil, else coll" {:added "1.0", :static true} [coll] (when (seq coll) coll)) (defn bases "Returns the immediate superclass and direct interfaces of c, if any" {:added "1.0", :static true} [c] (when c (let [i (seq (.getInterfaces c)) s (.getSuperclass c)] (if s (cons s i) i)))) (defn supers "Returns the immediate and indirect superclasses and interfaces of c, if any" {:added "1.0", :static true} [class] (loop [ret (set (bases class)) cs ret] (if (seq cs) (let [c (first cs) bs (bases c)] (recur (into1 ret bs) (into1 (disj cs c) bs))) (not-empty ret)))) -(defn isa? "Returns true if (= child parent), or child is directly or indirectly derived from\n parent, either via a Java type inheritance relationship or a\n relationship established via derive. h must be a hierarchy obtained\n from make-hierarchy, if not supplied defaults to the global\n hierarchy" {:added "1.0"} ([child parent] (isa? global-hierarchy child parent)) ([h child parent] (or (= child parent) (and (class? parent) (class? child) (. parent isAssignableFrom child)) (contains? ((:ancestors h) child) parent) (and (class? child) (some (fn* [] (contains? ((:ancestors h) %) parent)) (supers child))) (and (vector? parent) (vector? child) (= (count parent) (count child)) (loop [ret true i 0] (if (or (not ret) (= i (count parent))) ret (recur (isa? h (child i) (parent i)) (inc i)))))))) +(defn isa? "Returns true if (= child parent), or child is directly or indirectly derived from\n parent, either via a Java type inheritance relationship or a\n relationship established via derive. h must be a hierarchy obtained\n from make-hierarchy, if not supplied defaults to the global\n hierarchy" {:added "1.0"} ([child parent] (isa? global-hierarchy child parent)) ([h child parent] (or (= child parent) (and (class? parent) (class? child) (. parent isAssignableFrom child)) (contains? ((:ancestors h) child) parent) (and (class? child) (some (fn* [p1__32#] (contains? ((:ancestors h) p1__32#) parent)) (supers child))) (and (vector? parent) (vector? child) (= (count parent) (count child)) (loop [ret true i 0] (if (or (not ret) (= i (count parent))) ret (recur (isa? h (child i) (parent i)) (inc i)))))))) (defn parents "Returns the immediate parents of tag, either via a Java type\n inheritance relationship or a relationship established via derive. h\n must be a hierarchy obtained from make-hierarchy, if not supplied\n defaults to the global hierarchy" {:added "1.0"} ([tag] (parents global-hierarchy tag)) ([h tag] (not-empty (let [tp (get (:parents h) tag)] (if (class? tag) (into1 (set (bases tag)) tp) tp))))) -(defn ancestors "Returns the immediate and indirect parents of tag, either via a Java type\n inheritance relationship or a relationship established via derive. h\n must be a hierarchy obtained from make-hierarchy, if not supplied\n defaults to the global hierarchy" {:added "1.0"} ([tag] (ancestors global-hierarchy tag)) ([h tag] (not-empty (let [ta (get (:ancestors h) tag)] (if (class? tag) (let [superclasses (set (supers tag))] (reduce1 into1 superclasses (cons ta (map (fn* [p1__3#] (get (:ancestors h) p1__3#)) superclasses)))) ta))))) +(defn ancestors "Returns the immediate and indirect parents of tag, either via a Java type\n inheritance relationship or a relationship established via derive. h\n must be a hierarchy obtained from make-hierarchy, if not supplied\n defaults to the global hierarchy" {:added "1.0"} ([tag] (ancestors global-hierarchy tag)) ([h tag] (not-empty (let [ta (get (:ancestors h) tag)] (if (class? tag) (let [superclasses (set (supers tag))] (reduce1 into1 superclasses (cons ta (map (fn* [p1__33#] (get (:ancestors h) p1__33#)) superclasses)))) ta))))) (defn descendants "Returns the immediate and indirect children of tag, through a\n relationship established via derive. h must be a hierarchy obtained\n from make-hierarchy, if not supplied defaults to the global\n hierarchy. Note: does not work on Java type inheritance\n relationships." {:added "1.0"} ([tag] (descendants global-hierarchy tag)) ([h tag] (if (class? tag) (throw (java.lang.UnsupportedOperationException. "Can't get descendants of classes")) (not-empty (get (:descendants h) tag))))) (defn derive "Establishes a parent/child relationship between parent and\n tag. Parent must be a namespace-qualified symbol or keyword and\n child can be either a namespace-qualified symbol or keyword or a\n class. h must be a hierarchy obtained from make-hierarchy, if not\n supplied defaults to, and modifies, the global hierarchy." {:added "1.0"} ([tag parent] (assert (namespace parent)) (assert (or (class? tag) (and (instance? clojure.lang.Named tag) (namespace tag)))) (alter-var-root (var global-hierarchy) derive tag parent) nil) ([h tag parent] (assert (not= tag parent)) (assert (or (class? tag) (instance? clojure.lang.Named tag))) (assert (instance? clojure.lang.Named parent)) (let [tp (:parents h) td (:descendants h) ta (:ancestors h) tf (fn [m source sources target targets] (reduce1 (fn [ret k] (assoc ret k (reduce1 conj (get targets k #{}) (cons target (targets target))))) m (cons source (sources source))))] (or (when-not (contains? (tp tag) parent) (when (contains? (ta tag) parent) (throw (Exception. (print-str tag "already has" parent "as ancestor")))) (when (contains? (ta parent) tag) (throw (Exception. (print-str "Cyclic derivation:" parent "has" tag "as ancestor")))) {:parents (assoc (:parents h) tag (conj (get tp tag #{}) parent)), :ancestors (tf (:ancestors h) tag td parent ta), :descendants (tf (:descendants h) parent ta tag td)}) h)))) (declare flatten) -(defn underive "Removes a parent/child relationship between parent and\n tag. h must be a hierarchy obtained from make-hierarchy, if not\n supplied defaults to, and modifies, the global hierarchy." {:added "1.0"} ([tag parent] (alter-var-root (var 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 (fn* [] (cons (key %) (interpose (key %) (val %)))) (seq newParents)))] (if (contains? (parentMap tag) parent) (reduce1 (fn* [p1__3# p2__4#] (apply derive p1__3# p2__4#)) (make-hierarchy) (partition 2 deriv-seq)) h)))) +(defn underive "Removes a parent/child relationship between parent and\n tag. h must be a hierarchy obtained from make-hierarchy, if not\n supplied defaults to, and modifies, the global hierarchy." {:added "1.0"} ([tag parent] (alter-var-root (var 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 (fn* [p1__34#] (cons (key p1__34#) (interpose (key p1__34#) (val p1__34#)))) (seq newParents)))] (if (contains? (parentMap tag) parent) (reduce1 (fn* [p1__35# p2__36#] (apply derive p1__35# p2__36#)) (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\n the rows in the java.sql.ResultSet rs" {:added "1.0"} [rs] (let [rsmeta (. rs (getMetaData)) idxs (range 1 (inc (. rsmeta (getColumnCount)))) keys (map (comp keyword (fn* [p1__3#] (.toLowerCase p1__3#))) (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 [i] (. rs (getObject i))) idxs)) rows (fn thisfn [] (when (. rs (next)) (cons (apply struct row-struct (row-values)) (lazy-seq (thisfn)))))] (rows))) +(defn resultset-seq "Creates and returns a lazy sequence of structmaps corresponding to\n the rows in the java.sql.ResultSet rs" {:added "1.0"} [rs] (let [rsmeta (. rs (getMetaData)) idxs (range 1 (inc (. rsmeta (getColumnCount)))) keys (map (comp keyword (fn* [p1__37#] (.toLowerCase p1__37#))) (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 [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\n providing iterators implement Iterable and thus support seq directly.\n Seqs cache values, thus iterator-seq should not be used on any\n iterator that repeatedly returns the same mutable object." {:added "1.0", :static true} [iter] (clojure.lang.RT/chunkIteratorSeq iter)) (defn enumeration-seq "Returns a seq on a java.util.Enumeration" {:added "1.0", :static true} [e] (clojure.lang.EnumerationSeq/create e)) (defn format "Formats a string using java.lang.String.format, see java.util.Formatter for format\n string syntax" {:added "1.0", :static true} [fmt & args] (String/format fmt (to-array args))) (defn printf "Prints formatted output, as per format" {:added "1.0", :static true} [fmt & args] (print (apply format fmt args))) (declare gen-class) (defmacro with-loading-context [& body] (quasiquote ((fn loading# [] (. clojure.lang.Var (pushThreadBindings {clojure.lang.Compiler/LOADER (.getClassLoader (.getClass loading#))})) (try ~@body (finally (. clojure.lang.Var (popThreadBindings)))))))) -(defmacro ns "Sets *ns* to the namespace named by name (unevaluated), creating it\n if needed. references can be zero or more of: (:refer-clojure ...)\n (:require ...) (:use ...) (:import ...) (:load ...) (:gen-class)\n with the syntax of refer-clojure/require/use/import/load/gen-class\n respectively, except the arguments are unevaluated and need not be\n quoted. (:gen-class ...), when supplied, defaults to :name\n corresponding to the ns name, :main true, :impl-ns same as ns, and\n :init-impl-ns true. All options of gen-class are\n supported. The :gen-class directive is ignored when not\n compiling. If :gen-class is not supplied, when compiled only an\n nsname__init.class will be generated. If :refer-clojure is not used, a\n default (refer 'clojure.core) is used. Use of ns is preferred to\n individual calls to in-ns/require/use/import:\n\n (ns foo.bar\n (:refer-clojure :exclude [ancestors printf])\n (:require (clojure.contrib sql combinatorics))\n (:use (my.lib this that))\n (:import (java.util Date Timer Random)\n (java.sql Connection Statement)))" {:arglists (quote ([name docstring? attr-map? references*])), :added "1.0"} [name & references] (let [process-reference (fn [[kname & args]] (quasiquote ((clojure.core/unquote (symbol "clojure.core" (clojure.core/name kname))) ~@(map (fn* [p1__3#] (list (quote quote) p1__3#)) args)))) docstring (when (string? (first references)) (first references)) references (if docstring (next references) references) name (if docstring (vary-meta name assoc :doc docstring) name) metadata (when (map? (first references)) (first references)) references (if metadata (next references) references) name (if metadata (vary-meta name merge metadata) name) gen-class-clause (first (filter (fn* [] (= :gen-class (first %))) references)) gen-class-call (when gen-class-clause (list* (quasiquote gen-class) :name (.replace (str name) \- \_) :impl-ns name :main true (next gen-class-clause))) references (remove (fn* [] (= :gen-class (first %))) references) name-metadata (meta name)] (quasiquote (do (clojure.core/in-ns (quote (clojure.core/unquote name))) ~@(when name-metadata (quasiquote ((.resetMeta (clojure.lang.Namespace/find (quote (clojure.core/unquote name))) (clojure.core/unquote name-metadata))))) (with-loading-context ~@(when gen-class-call (list gen-class-call)) ~@(when (and (not= name (quote clojure.core)) (not-any? (fn* [] (= :refer-clojure (first %))) references)) (quasiquote ((clojure.core/refer (quote (clojure.core/unquote (quote clojure.core))))))) ~@(map process-reference references)) (if (.equals (quote (clojure.core/unquote name)) (quote clojure.core)) nil (do (dosync (commute (clojure.core/deref (var *loaded-libs*)) conj (quote (clojure.core/unquote name)))) nil)))))) +(defmacro ns "Sets *ns* to the namespace named by name (unevaluated), creating it\n if needed. references can be zero or more of: (:refer-clojure ...)\n (:require ...) (:use ...) (:import ...) (:load ...) (:gen-class)\n with the syntax of refer-clojure/require/use/import/load/gen-class\n respectively, except the arguments are unevaluated and need not be\n quoted. (:gen-class ...), when supplied, defaults to :name\n corresponding to the ns name, :main true, :impl-ns same as ns, and\n :init-impl-ns true. All options of gen-class are\n supported. The :gen-class directive is ignored when not\n compiling. If :gen-class is not supplied, when compiled only an\n nsname__init.class will be generated. If :refer-clojure is not used, a\n default (refer 'clojure.core) is used. Use of ns is preferred to\n individual calls to in-ns/require/use/import:\n\n (ns foo.bar\n (:refer-clojure :exclude [ancestors printf])\n (:require (clojure.contrib sql combinatorics))\n (:use (my.lib this that))\n (:import (java.util Date Timer Random)\n (java.sql Connection Statement)))" {:arglists (quote ([name docstring? attr-map? references*])), :added "1.0"} [name & references] (let [process-reference (fn [[kname & args]] (quasiquote ((clojure.core/unquote (symbol "clojure.core" (clojure.core/name kname))) ~@(map (fn* [p1__38#] (list (quote quote) p1__38#)) args)))) docstring (when (string? (first references)) (first references)) references (if docstring (next references) references) name (if docstring (vary-meta name assoc :doc docstring) name) metadata (when (map? (first references)) (first references)) references (if metadata (next references) references) name (if metadata (vary-meta name merge metadata) name) gen-class-clause (first (filter (fn* [p1__39#] (= :gen-class (first p1__39#))) references)) gen-class-call (when gen-class-clause (list* (quasiquote gen-class) :name (.replace (str name) \- \_) :impl-ns name :main true (next gen-class-clause))) references (remove (fn* [p1__40#] (= :gen-class (first p1__40#))) references) name-metadata (meta name)] (quasiquote (do (clojure.core/in-ns (quote (clojure.core/unquote name))) ~@(when name-metadata (quasiquote ((.resetMeta (clojure.lang.Namespace/find (quote (clojure.core/unquote name))) (clojure.core/unquote name-metadata))))) (with-loading-context ~@(when gen-class-call (list gen-class-call)) ~@(when (and (not= name (quote clojure.core)) (not-any? (fn* [p1__41#] (= :refer-clojure (first p1__41#))) references)) (quasiquote ((clojure.core/refer (quote (clojure.core/unquote (quote clojure.core))))))) ~@(map process-reference references)) (if (.equals (quote (clojure.core/unquote name)) (quote clojure.core)) nil (do (dosync (commute (clojure.core/deref (var *loaded-libs*)) conj (quote (clojure.core/unquote name)))) nil)))))) (defmacro refer-clojure "Same as (refer 'clojure.core )" {:added "1.0"} [& filters] (quasiquote (clojure.core/refer (quote (clojure.core/unquote (quote clojure.core))) ~@filters))) (defmacro defonce "defs name to have the root value of the expr iff the named var has no root value,\n else expr is unevaluated" {:added "1.0"} [name expr] (quasiquote (let [v# (def (clojure.core/unquote name))] (when-not (.hasRoot v#) (def (clojure.core/unquote name) (clojure.core/unquote expr)))))) (defonce *loaded-libs* (ref (sorted-set))) (defonce *pending-paths* ()) (defonce *loading-verbosely* false) -(defn- throw-if "Throws a CompilerException with a message if pred is true" [pred fmt & args] (when pred (let [message (apply format fmt args) exception (Exception. message) raw-trace (.getStackTrace exception) boring? (fn* [] (not= (.getMethodName %) "doInvoke")) trace (into-array StackTraceElement (drop 2 (drop-while boring? raw-trace)))] (.setStackTrace exception trace) (throw (clojure.lang.Compiler$CompilerException. *file* (.deref clojure.lang.Compiler/LINE) (.deref clojure.lang.Compiler/COLUMN) exception))))) +(defn- throw-if "Throws a CompilerException with a message if pred is true" [pred fmt & args] (when pred (let [message (apply format fmt args) exception (Exception. message) raw-trace (.getStackTrace exception) boring? (fn* [p1__42#] (not= (.getMethodName p1__42#) "doInvoke")) trace (into-array StackTraceElement (drop 2 (drop-while boring? raw-trace)))] (.setStackTrace exception trace) (throw (clojure.lang.Compiler$CompilerException. *file* (.deref clojure.lang.Compiler/LINE) (.deref clojure.lang.Compiler/COLUMN) exception))))) (defn- libspec? "Returns true if x is a libspec" [x] (or (symbol? x) (and (vector? x) (or (nil? (second x)) (keyword? (second x)))))) (defn- prependss "Prepends a symbol or a seq to coll" [x coll] (if (symbol? x) (cons x coll) (concat x coll))) (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 "/")))) (def load) (defn- load-one "Loads a lib given its name. If need-ns, ensures that the associated\n namespace exists after loading. If require, records the load so any\n duplicate loads can be skipped." [lib need-ns require] (load (root-resource lib)) (throw-if (and need-ns (not (find-ns lib))) "namespace '%s' not found after loading '%s'" lib (root-resource lib)) (when require (dosync (commute *loaded-libs* conj lib)))) -(defn- load-all "Loads a lib given its name and forces a load of any libs it directly or\n indirectly loads. If need-ns, ensures that the associated namespace\n exists after loading. If require, records the load so any duplicate loads\n can be skipped." [lib need-ns require] (dosync (commute *loaded-libs* (fn* [p1__3# p2__4#] (reduce1 conj p1__3# p2__4#)) (binding [*loaded-libs* (ref (sorted-set))] (load-one lib need-ns require) (clojure.core/deref *loaded-libs*))))) +(defn- load-all "Loads a lib given its name and forces a load of any libs it directly or\n indirectly loads. If need-ns, ensures that the associated namespace\n exists after loading. If require, records the load so any duplicate loads\n can be skipped." [lib need-ns require] (dosync (commute *loaded-libs* (fn* [p1__43# p2__44#] (reduce1 conj p1__43# p2__44#)) (binding [*loaded-libs* (ref (sorted-set))] (load-one lib need-ns require) (clojure.core/deref *loaded-libs*))))) (defn- load-lib "Loads a lib with options" [prefix lib & options] (throw-if (and prefix (pos? (.indexOf (name lib) (int \.)))) "Found lib name '%s' containing period with prefix '%s'. lib names inside prefix lists must not contain periods" (name lib) prefix) (let [lib (if prefix (symbol (str prefix \. lib)) lib) opts (apply hash-map options) {:keys [as reload reload-all require use verbose as-alias]} opts loaded (contains? (clojure.core/deref *loaded-libs*) lib) need-ns (or as use) load (cond reload-all load-all reload load-one (not loaded) (cond need-ns load-one as-alias (fn [lib _need _require] (create-ns lib)) :else load-one)) filter-opts (select-keys opts (quote (:exclude :only :rename :refer))) undefined-on-entry (not (find-ns lib))] (binding [*loading-verbosely* (or *loading-verbosely* verbose)] (if load (try (load lib need-ns require) (catch Exception e (when undefined-on-entry (remove-ns lib)) (throw e))) (throw-if (and need-ns (not (find-ns lib))) "namespace '%s' not found" lib)) (when (and need-ns *loading-verbosely*) (printf "(clojure.core/in-ns '%s)\n" (ns-name *ns*))) (when as (when *loading-verbosely* (printf "(clojure.core/alias '%s '%s)\n" as lib)) (alias as lib)) (when as-alias (when *loading-verbosely* (printf "(clojure.core/alias '%s '%s)\n" as-alias lib)) (alias as-alias lib)) (when (or use (:refer filter-opts)) (when *loading-verbosely* (printf "(clojure.core/refer '%s" lib) (doseq [opt filter-opts] (printf " %s '%s" (key opt) (print-str (val opt)))) (printf ")\n")) (apply refer lib (mapcat seq filter-opts)))))) (defn- load-libs "Loads libs, interpreting libspecs, prefix lists, and flags for\n forwarding to load-lib" [& args] (let [flags (filter keyword? args) opts (interleave flags (repeat true)) args (filter (complement keyword?) args)] (let [supported #{:as :reload :reload-all :require :use :as-alias :refer :verbose} unsupported (seq (remove supported flags))] (throw-if unsupported (apply str "Unsupported option(s) supplied: " (interpose \, unsupported)))) (throw-if (not (seq args)) "Nothing specified to load") (doseq [arg args] (if (libspec? arg) (apply load-lib nil (prependss arg opts)) (let [[prefix & args] arg] (throw-if (nil? prefix) "prefix cannot be nil") (doseq [arg args] (apply load-lib prefix (prependss arg opts)))))))) -(defn- check-cyclic-dependency "Detects and rejects non-trivial cyclic load dependencies. The\n exception message shows the dependency chain with the cycle\n highlighted. Ignores the trivial case of a file attempting to load\n itself because that can occur when a gen-class'd class loads its\n implementation." [path] (when (some #{path} (rest *pending-paths*)) (let [pending (map (fn* [p1__3#] (if (= % path) (str "[ " % " ]") p1__3#)) (cons path *pending-paths*)) chain (apply str (interpose "->" pending))] (throw-if true "Cyclic load dependency: %s" chain)))) +(defn- check-cyclic-dependency "Detects and rejects non-trivial cyclic load dependencies. The\n exception message shows the dependency chain with the cycle\n highlighted. Ignores the trivial case of a file attempting to load\n itself because that can occur when a gen-class'd class loads its\n implementation." [path] (when (some #{path} (rest *pending-paths*)) (let [pending (map (fn* [p1__45#] (if (= p1__45# path) (str "[ " p1__45# " ]") p1__45#)) (cons path *pending-paths*)) chain (apply str (interpose "->" pending))] (throw-if true "Cyclic load dependency: %s" chain)))) (defn require "Loads libs, skipping any that are already loaded. Each argument is\n either a libspec that identifies a lib, a prefix list that identifies\n multiple libs whose names share a common prefix, or a flag that modifies\n how all the identified libs are loaded. Use :require in the ns macro\n in preference to calling this directly.\n\n Libs\n\n A 'lib' is a named set of resources in classpath whose contents define a\n library of Clojure code. Lib names are symbols and each lib is associated\n with a Clojure namespace and a Java package that share its name. A lib's\n name also locates its root directory within classpath using Java's\n package name to classpath-relative path mapping. All resources in a lib\n should be contained in the directory structure under its root directory.\n All definitions a lib makes should be in its associated namespace.\n\n 'require loads a lib by loading its root resource. The root resource path\n is derived from the lib name in the following manner:\n Consider a lib named by the symbol 'x.y.z; it has the root directory\n /x/y/, and its root resource is /x/y/z.clj, or\n /x/y/z.cljc if /x/y/z.clj does not exist. The\n root resource should contain code to create the lib's\n namespace (usually by using the ns macro) and load any additional\n lib resources.\n\n Libspecs\n\n A libspec is a lib name or a vector containing a lib name followed by\n options expressed as sequential keywords and arguments.\n\n Recognized options:\n :as takes a symbol as its argument and makes that symbol an alias to the\n lib's namespace in the current namespace.\n :as-alias takes a symbol as its argument and aliases like :as, however\n the lib will not be loaded. If the lib has not been loaded, a new\n empty namespace will be created (as with create-ns).\n :refer takes a list of symbols to refer from the namespace or the :all\n keyword to bring in all public vars.\n\n Prefix Lists\n\n It's common for Clojure code to depend on several libs whose names have\n the same prefix. When specifying libs, prefix lists can be used to reduce\n repetition. A prefix list contains the shared prefix followed by libspecs\n with the shared prefix removed from the lib names. After removing the\n prefix, the names that remain must not contain any periods.\n\n Flags\n\n A flag is a keyword.\n Recognized flags: :reload, :reload-all, :verbose\n :reload forces loading of all the identified libs even if they are\n already loaded (has no effect on libspecs using :as-alias)\n :reload-all implies :reload and also forces loading of all libs that the\n identified libs directly or indirectly load via require or use\n (has no effect on libspecs using :as-alias)\n :verbose triggers printing information about each load, alias, and refer\n\n Example:\n\n The following would load the libraries clojure.zip and clojure.set\n abbreviated as 's'.\n\n (require '(clojure zip [set :as s]))" {:added "1.0"} [& args] (apply load-libs :require args)) (defn- serialized-require "Like 'require', but serializes loading.\n Interim function preferred over 'require' for known asynchronous loads.\n Future changes may make these equivalent." {:added "1.10"} [& args] (locking clojure.lang.RT/REQUIRE_LOCK (apply require args))) (defn requiring-resolve "Resolves namespace-qualified sym per 'resolve'. If initial resolve\nfails, attempts to require sym's namespace and retries." {:added "1.10"} [sym] (if (qualified-symbol? sym) (or (resolve sym) (do (-> sym namespace symbol serialized-require) (resolve sym))) (throw (IllegalArgumentException. (str "Not a qualified symbol: " sym))))) @@ -593,19 +593,19 @@ (add-doc-and-meta *read-eval* "Defaults to true (or value specified by system property, see below)\n ***This setting implies that the full power of the reader is in play,\n including syntax that can cause code to execute. It should never be\n used with untrusted sources. See also: clojure.edn/read.***\n\n When set to logical false in the thread-local binding,\n the eval reader (#=) and record/type literal syntax are disabled in read/load.\n Example (will fail): (binding [*read-eval* false] (read-string \"#=(* 2 21)\"))\n\n The default binding can be controlled by the system property\n 'clojure.read.eval' System properties can be set on the command line\n like this:\n\n java -Dclojure.read.eval=false ...\n\n The system property can also be set to 'unknown' via\n -Dclojure.read.eval=unknown, in which case the default binding\n is :unknown and all reads will fail in contexts where *read-eval*\n has not been explicitly bound to either true or false. This setting\n can be a useful diagnostic tool to ensure that all of your reads\n occur in considered contexts. You can also accomplish this in a\n particular scope by binding *read-eval* to :unknown\n " {: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} [f] (.isDone f)) -(defmacro letfn "fnspec ==> (fname [params*] exprs) or (fname ([params*] exprs)+)\n\n Takes a vector of function specs and a body, and generates a set of\n bindings of functions to their names. All of the names are available\n in all of the definitions of the functions, as well as the body." {:added "1.0", :forms (quote [(letfn [fnspecs*] exprs*)]), :special-form true, :url nil} [fnspecs & body] (quasiquote (letfn* (clojure.core/unquote (vec (interleave (map first fnspecs) (map (fn* [p1__3#] (cons (quasiquote fn) p1__3#)) fnspecs)))) ~@body))) +(defmacro letfn "fnspec ==> (fname [params*] exprs) or (fname ([params*] exprs)+)\n\n Takes a vector of function specs and a body, and generates a set of\n bindings of functions to their names. All of the names are available\n in all of the definitions of the functions, as well as the body." {:added "1.0", :forms (quote [(letfn [fnspecs*] exprs*)]), :special-form true, :url nil} [fnspecs & body] (quasiquote (letfn* (clojure.core/unquote (vec (interleave (map first fnspecs) (map (fn* [p1__46#] (cons (quasiquote fn) p1__46#)) fnspecs)))) ~@body))) (defn fnil "Takes a function f, and returns a function that calls f, replacing\n a nil first argument to f with the supplied value x. Higher arity\n versions can replace arguments in the second and third\n positions (y, z). Note that the function f can take any number of\n 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))))) (defn zipmap "Returns a map with the keys mapped to the corresponding vals." {:added "1.0", :static true} [keys vals] (loop [map (transient {}) ks (seq keys) vs (seq vals)] (if (and ks vs) (recur (assoc! map (first ks) (first vs)) (next ks) (next vs)) (persistent! map)))) (defn- shift-mask [shift mask x] (-> x (bit-shift-right shift) (bit-and mask))) (def max-mask-bits 13) (def 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 (fn* [p1__3#] (shift-mask s m p1__3#)) hashes))) (for [mask (map (fn* [] (dec (bit-shift-left 1 %))) (range 1 (inc max-mask-bits))) shift (range 0 31)] [shift mask])))) +(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 (fn* [p1__47#] (shift-mask s m p1__47#)) hashes))) (for [mask (map (fn* [p1__48#] (dec (bit-shift-left 1 p1__48#))) (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\n expressions into a sorted map to be consumed by case*. The form of the map\n 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\n 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\n then expressions. Returns a tuple of [shift mask case-map switch-type] where\n case-map is a map of int case values to [test then] tuples, and switch-type\n is either :sparse or :compact." [tests thens] (if (fits-table? tests) [0 0 (case-map int int tests thens) :compact] (let [[shift mask] (or (maybe-min-hash (map int tests)) [0 0])] (if (zero? mask) [0 0 (case-map int int tests thens) :sparse] [shift mask (case-map (fn* [] (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\n and a corresponding sequence of then expressions. Returns a tuple of\n [tests thens skip-check-set] where no tests have the same hash. Each set of\n input test constants with the same hash is replaced with a single test\n constant (the case int), and their respective thens are combined into:\n (condp = expr\n test-1 then-1\n ...\n test-n then-n\n default).\n The skip-check is a set of case ints for which post-switch equivalence\n 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 m (clojure.lang.Util/hash (first ks)) (fnil conj []) [(first ks) (first vs)]) (next ks) (next vs)) m)) assoc-multi (fn [m h bucket] (let [testexprs (mapcat (fn [kv] [(list (quote quote) (first kv)) (second kv)]) bucket) expr (quasiquote (condp = (clojure.core/unquote expr-sym) ~@testexprs (clojure.core/unquote 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 (fn* [] (< 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\n expressions. Returns a tuple of [shift mask case-map switch-type skip-check]\n where case-map is a map of int case values to [test then] tuples, switch-type\n is either :sparse or :compact, and skip-check is a set of case ints for which\n post-switch equivalence checking must not be done (occurs with hash\n collisions)." [expr-sym default tests thens] (let [hashcode (fn* [p1__3#] (clojure.lang.Util/hash p1__3#)) hashes (into1 #{} (map hashcode tests))] (if (== (count tests) (count hashes)) (if (fits-table? hashes) [0 0 (case-map hashcode identity tests thens) :compact] (let [[shift mask] (or (maybe-min-hash hashes) [0 0])] (if (zero? mask) [0 0 (case-map hashcode identity tests thens) :sparse] [shift mask (case-map (fn* [] (shift-mask shift mask (hashcode %))) identity tests thens) :compact]))) (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 (fn* [p1__3#] (shift-mask shift mask p1__3#)) skip-check)))] [shift mask case-map switch-type skip-check])))) -(defmacro case "Takes an expression, and a set of clauses.\n\n Each clause can take the form of either:\n\n test-constant result-expr\n\n (test-constant1 ... test-constantN) result-expr\n\n The test-constants are not evaluated. They must be compile-time\n literals, and need not be quoted. If the expression is equal to a\n test-constant, the corresponding result-expr is returned. A single\n default expression can follow the clauses, and its value will be\n returned if no clause matches. If no default expression is provided\n and no clause matches, an IllegalArgumentException is thrown.\n\n Unlike cond and condp, case does a constant-time dispatch, the\n clauses are not considered sequentially. All manner of constant\n expressions are acceptable in case, including numbers, strings,\n symbols, keywords, and (Clojure) composites thereof. Note that since\n lists are used to group multiple constants that map to the same\n expression, a vector can be used to match a list if needed. The\n 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) (quasiquote (throw (IllegalArgumentException. (str "No matching clause: " (clojure.core/unquote ge))))))] (if (> 2 (count clauses)) (quasiquote (let [(clojure.core/unquote ge) (clojure.core/unquote e)] (clojure.core/unquote 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 (fn* [p1__3# p2__4#] (assoc-test p1__3# p2__4# expr)) m test) (assoc-test m test expr))) {} pairs) tests (keys pairs) thens (vals pairs) mode (cond (every? (fn* [] (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)] (quasiquote (let [(clojure.core/unquote ge) (clojure.core/unquote e)] (case* (clojure.core/unquote ge) (clojure.core/unquote shift) (clojure.core/unquote mask) (clojure.core/unquote default) (clojure.core/unquote imap) (clojure.core/unquote switch-type) :int)))) :hashes (let [[shift mask imap switch-type skip-check] (prep-hashes ge default tests thens)] (quasiquote (let [(clojure.core/unquote ge) (clojure.core/unquote e)] (case* (clojure.core/unquote ge) (clojure.core/unquote shift) (clojure.core/unquote mask) (clojure.core/unquote default) (clojure.core/unquote imap) (clojure.core/unquote switch-type) :hash-equiv (clojure.core/unquote skip-check))))) :identity (let [[shift mask imap switch-type skip-check] (prep-hashes ge default tests thens)] (quasiquote (let [(clojure.core/unquote ge) (clojure.core/unquote e)] (case* (clojure.core/unquote ge) (clojure.core/unquote shift) (clojure.core/unquote mask) (clojure.core/unquote default) (clojure.core/unquote imap) (clojure.core/unquote switch-type) :hash-identity (clojure.core/unquote skip-check)))))))))) +(defn- prep-ints "Takes a sequence of int-sized test constants and a corresponding sequence of\n then expressions. Returns a tuple of [shift mask case-map switch-type] where\n case-map is a map of int case values to [test then] tuples, and switch-type\n is either :sparse or :compact." [tests thens] (if (fits-table? tests) [0 0 (case-map int int tests thens) :compact] (let [[shift mask] (or (maybe-min-hash (map int tests)) [0 0])] (if (zero? mask) [0 0 (case-map int int tests thens) :sparse] [shift mask (case-map (fn* [p1__49#] (shift-mask shift mask (int p1__49#))) int tests thens) :compact])))) +(defn- merge-hash-collisions "Takes a case expression, default expression, and a sequence of test constants\n and a corresponding sequence of then expressions. Returns a tuple of\n [tests thens skip-check-set] where no tests have the same hash. Each set of\n input test constants with the same hash is replaced with a single test\n constant (the case int), and their respective thens are combined into:\n (condp = expr\n test-1 then-1\n ...\n test-n then-n\n default).\n The skip-check is a set of case ints for which post-switch equivalence\n 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 m (clojure.lang.Util/hash (first ks)) (fnil conj []) [(first ks) (first vs)]) (next ks) (next vs)) m)) assoc-multi (fn [m h bucket] (let [testexprs (mapcat (fn [kv] [(list (quote quote) (first kv)) (second kv)]) bucket) expr (quasiquote (condp = (clojure.core/unquote expr-sym) ~@testexprs (clojure.core/unquote 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 (fn* [p1__50#] (< 1 (count (second p1__50#))))) (map first) (into1 #{}))] [(keys hmap) (vals hmap) skip-check])) +(defn- prep-hashes "Takes a sequence of test constants and a corresponding sequence of then\n expressions. Returns a tuple of [shift mask case-map switch-type skip-check]\n where case-map is a map of int case values to [test then] tuples, switch-type\n is either :sparse or :compact, and skip-check is a set of case ints for which\n post-switch equivalence checking must not be done (occurs with hash\n collisions)." [expr-sym default tests thens] (let [hashcode (fn* [p1__51#] (clojure.lang.Util/hash p1__51#)) hashes (into1 #{} (map hashcode tests))] (if (== (count tests) (count hashes)) (if (fits-table? hashes) [0 0 (case-map hashcode identity tests thens) :compact] (let [[shift mask] (or (maybe-min-hash hashes) [0 0])] (if (zero? mask) [0 0 (case-map hashcode identity tests thens) :sparse] [shift mask (case-map (fn* [p1__52#] (shift-mask shift mask (hashcode p1__52#))) identity tests thens) :compact]))) (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 (fn* [p1__53#] (shift-mask shift mask p1__53#)) skip-check)))] [shift mask case-map switch-type skip-check])))) +(defmacro case "Takes an expression, and a set of clauses.\n\n Each clause can take the form of either:\n\n test-constant result-expr\n\n (test-constant1 ... test-constantN) result-expr\n\n The test-constants are not evaluated. They must be compile-time\n literals, and need not be quoted. If the expression is equal to a\n test-constant, the corresponding result-expr is returned. A single\n default expression can follow the clauses, and its value will be\n returned if no clause matches. If no default expression is provided\n and no clause matches, an IllegalArgumentException is thrown.\n\n Unlike cond and condp, case does a constant-time dispatch, the\n clauses are not considered sequentially. All manner of constant\n expressions are acceptable in case, including numbers, strings,\n symbols, keywords, and (Clojure) composites thereof. Note that since\n lists are used to group multiple constants that map to the same\n expression, a vector can be used to match a list if needed. The\n 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) (quasiquote (throw (IllegalArgumentException. (str "No matching clause: " (clojure.core/unquote ge))))))] (if (> 2 (count clauses)) (quasiquote (let [(clojure.core/unquote ge) (clojure.core/unquote e)] (clojure.core/unquote 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 (fn* [p1__54# p2__55#] (assoc-test p1__54# p2__55# expr)) m test) (assoc-test m test expr))) {} pairs) tests (keys pairs) thens (vals pairs) mode (cond (every? (fn* [p1__56#] (and (integer? p1__56#) (<= Integer/MIN_VALUE p1__56# Integer/MAX_VALUE))) tests) :ints (every? keyword? tests) :identity :else :hashes)] (condp = mode :ints (let [[shift mask imap switch-type] (prep-ints tests thens)] (quasiquote (let [(clojure.core/unquote ge) (clojure.core/unquote e)] (case* (clojure.core/unquote ge) (clojure.core/unquote shift) (clojure.core/unquote mask) (clojure.core/unquote default) (clojure.core/unquote imap) (clojure.core/unquote switch-type) :int)))) :hashes (let [[shift mask imap switch-type skip-check] (prep-hashes ge default tests thens)] (quasiquote (let [(clojure.core/unquote ge) (clojure.core/unquote e)] (case* (clojure.core/unquote ge) (clojure.core/unquote shift) (clojure.core/unquote mask) (clojure.core/unquote default) (clojure.core/unquote imap) (clojure.core/unquote switch-type) :hash-equiv (clojure.core/unquote skip-check))))) :identity (let [[shift mask imap switch-type skip-check] (prep-hashes ge default tests thens)] (quasiquote (let [(clojure.core/unquote ge) (clojure.core/unquote e)] (case* (clojure.core/unquote ge) (clojure.core/unquote shift) (clojure.core/unquote mask) (clojure.core/unquote default) (clojure.core/unquote imap) (clojure.core/unquote switch-type) :hash-identity (clojure.core/unquote skip-check)))))))))) (alter-meta! (find-ns (quote clojure.core)) assoc :doc "Fundamental library of the Clojure language") (load "core_proxy") (load "core_print") @@ -639,9 +639,9 @@ (defmacro future "Takes a body of expressions and yields a future object that will\n invoke the body in another thread, and will cache the result and\n return it on all subsequent calls to deref/@. If the computation has\n not yet finished, calls to deref/@ will block, unless the variant of\n deref with timeout is used. See also - realized?." {:added "1.1"} [& body] (quasiquote (future-call (fn* [] ~@body)))) (defn future-cancel "Cancels the future, if possible." {:added "1.1", :static true} [f] (.cancel f true)) (defn future-cancelled? "Returns true if future f is cancelled" {:added "1.1", :static true} [f] (.isCancelled f)) -(defn pmap "Like map, except f is applied in parallel. Semi-lazy in that the\n parallel computation stays ahead of the consumption, but doesn't\n realize the entire result unless required. Only useful for\n computationally intensive functions where the time of f dominates\n the coordination overhead." {:added "1.0", :static true} ([f coll] (let [n (+ 2 (.. Runtime getRuntime availableProcessors)) rets (map (fn* [] (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 (fn* [p1__3#] (apply f p1__3#)) (step (cons coll colls)))))) -(defn pcalls "Executes the no-arg fns in parallel, returning a lazy sequence of\n their values" {:added "1.0", :static true} [& fns] (pmap (fn* [p1__3#] (p1__3#)) fns)) -(defmacro pvalues "Returns a lazy sequence of the values of the exprs, which are\n evaluated in parallel" {:added "1.0", :static true} [& exprs] (quasiquote (pcalls ~@(map (fn* [p1__3#] (list (quasiquote fn) [] p1__3#)) exprs)))) +(defn pmap "Like map, except f is applied in parallel. Semi-lazy in that the\n parallel computation stays ahead of the consumption, but doesn't\n realize the entire result unless required. Only useful for\n computationally intensive functions where the time of f dominates\n the coordination overhead." {:added "1.0", :static true} ([f coll] (let [n (+ 2 (.. Runtime getRuntime availableProcessors)) rets (map (fn* [p1__57#] (future (f p1__57#))) 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 (fn* [p1__58#] (apply f p1__58#)) (step (cons coll colls)))))) +(defn pcalls "Executes the no-arg fns in parallel, returning a lazy sequence of\n their values" {:added "1.0", :static true} [& fns] (pmap (fn* [p1__59#] (p1__59#)) fns)) +(defmacro pvalues "Returns a lazy sequence of the values of the exprs, which are\n evaluated in parallel" {:added "1.0", :static true} [& exprs] (quasiquote (pcalls ~@(map (fn* [p1__60#] (list (quasiquote fn) [] p1__60#)) exprs)))) (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 major), :minor (Integer/valueOf minor), :incremental (Integer/valueOf incremental), :qualifier (if (= qualifier "SNAPSHOT") nil qualifier)}] (def *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 \n :incremental and :qualifier keys. Feature releases may increment \n :minor and/or :major, bugfix releases will increment :incremental. \n 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"))) @@ -649,7 +649,7 @@ (defn deliver "Delivers the supplied value to the promise, releasing any pending\n derefs. A subsequent call to deliver on a promise will have no effect." {:added "1.1", :static true} [promise val] (promise val)) (defn flatten "Takes any nested combination of sequential things (lists, vectors,\n etc.) and returns their contents as a single, flat lazy sequence.\n (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\n f on each element. The value at each key will be a vector of the\n 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\n new value. Returns a lazy seq of partitions. Returns a stateful\n transducer when no collection is provided." {:added "1.2", :static true} ([f] (fn [rf] (let [a (java.util.ArrayList.) pv (volatile! ::none)] (fn ([] (rf)) ([result] (let [result (if (.isEmpty a) result (let [v (vec (.toArray a))] (.clear a) (unreduced (rf result v))))] (rf result))) ([result input] (let [pval (clojure.core/deref pv) val (f input)] (vreset! pv val) (if (or (identical? pval ::none) (= val pval)) (do (.add a input) result) (let [v (vec (.toArray a))] (.clear a) (let [ret (rf result v)] (when-not (reduced? ret) (.add a input)) ret))))))))) ([f coll] (lazy-seq (when-let [s (seq coll)] (let [fst (first s) fv (f fst) run (cons fst (take-while (fn* [] (= fv (f %))) (next s)))] (cons run (partition-by f (lazy-seq (drop (count run) s))))))))) +(defn partition-by "Applies f to each value in coll, splitting it each time f returns a\n new value. Returns a lazy seq of partitions. Returns a stateful\n transducer when no collection is provided." {:added "1.2", :static true} ([f] (fn [rf] (let [a (java.util.ArrayList.) pv (volatile! ::none)] (fn ([] (rf)) ([result] (let [result (if (.isEmpty a) result (let [v (vec (.toArray a))] (.clear a) (unreduced (rf result v))))] (rf result))) ([result input] (let [pval (clojure.core/deref pv) val (f input)] (vreset! pv val) (if (or (identical? pval ::none) (= val pval)) (do (.add a input) result) (let [v (vec (.toArray a))] (.clear a) (let [ret (rf result v)] (when-not (reduced? ret) (.add a input)) ret))))))))) ([f coll] (lazy-seq (when-let [s (seq coll)] (let [fst (first s) fv (f fst) run (cons fst (take-while (fn* [p1__61#] (= fv (f p1__61#))) (next s)))] (cons run (partition-by f (lazy-seq (drop (count run) s))))))))) (defn frequencies "Returns a map from distinct items in coll to the number of times\n they appear." {:added "1.2", :static true} [coll] (persistent! (reduce (fn [counts x] (assoc! counts x (inc (get counts x 0)))) (transient {}) coll))) (defn reductions "Returns a lazy seq of the intermediate values of the reduction (as\n per reduce) of coll by f, starting with init." {:added "1.2"} ([f coll] (lazy-seq (if-let [s (seq coll)] (reductions f (first s) (rest s)) (list (f))))) ([f init coll] (if (reduced? init) (list (clojure.core/deref init)) (cons init (lazy-seq (when-let [s (seq coll)] (reductions f (f init (first s)) (rest s)))))))) (defn rand-nth "Return a random element of the (sequential) collection. Will have\n the same performance characteristics as nth for the given\n collection." {:added "1.2", :static true} [coll] (nth coll (rand-int (count coll)))) @@ -662,18 +662,18 @@ (defn keep "Returns a lazy sequence of the non-nil results of (f item). Note,\n this means false return values will be included. f must be free of\n side-effects. Returns a transducer when no collection is provided." {:added "1.2", :static true} ([f] (fn [rf] (fn ([] (rf)) ([result] (rf result)) ([result input] (let [v (f input)] (if (nil? v) result (rf result v))))))) ([f coll] (lazy-seq (when-let [s (seq coll)] (if (chunked-seq? s) (let [c (chunk-first s) size (count c) b (chunk-buffer size)] (dotimes [i size] (let [x (f (.nth c i))] (when-not (nil? x) (chunk-append b x)))) (chunk-cons (chunk b) (keep f (chunk-rest s)))) (let [x (f (first s))] (if (nil? x) (keep f (rest s)) (cons x (keep f (rest s)))))))))) (defn keep-indexed "Returns a lazy sequence of the non-nil results of (f index item). Note,\n this means false return values will be included. f must be free of\n side-effects. Returns a stateful transducer when no collection is\n provided." {:added "1.2", :static true} ([f] (fn [rf] (let [iv (volatile! -1)] (fn ([] (rf)) ([result] (rf result)) ([result input] (let [i (vswap! iv inc) v (f i input)] (if (nil? v) result (rf result v)))))))) ([f coll] (letfn [(keepi [idx coll] (lazy-seq (when-let [s (seq coll)] (if (chunked-seq? s) (let [c (chunk-first s) size (count c) b (chunk-buffer size)] (dotimes [i size] (let [x (f (+ idx i) (.nth c i))] (when-not (nil? x) (chunk-append b x)))) (chunk-cons (chunk b) (keepi (+ idx size) (chunk-rest s)))) (let [x (f idx (first s))] (if (nil? x) (keepi (inc idx) (rest s)) (cons x (keepi (inc idx) (rest s)))))))))] (keepi 0 coll)))) (defn bounded-count "If coll is counted? returns its count, else will count at most the first n\n elements of coll using its seq" {:added "1.9"} [n coll] (if (counted? coll) (count coll) (loop [i 0 s (seq coll)] (if (and s (< i n)) (recur (inc i) (next s)) i)))) -(defn every-pred "Takes a set of predicates and returns a function f that returns true if all of its\n composing predicates return a logical true value against all of its arguments, else it returns\n false. Note that f is short-circuiting in that it will stop execution on the first\n argument that triggers a logical false result against the original predicates." {:added "1.3"} ([p] (fn ep1 ([] true) ([x] (boolean (p x))) ([x y] (boolean (and (p x) (p y)))) ([x y z] (boolean (and (p x) (p y) (p z)))) ([x y z & args] (boolean (and (ep1 x y z) (every? p args)))))) ([p1 p2] (fn ep2 ([] true) ([x] (boolean (and (p1 x) (p2 x)))) ([x y] (boolean (and (p1 x) (p1 y) (p2 x) (p2 y)))) ([x y z] (boolean (and (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z)))) ([x y z & args] (boolean (and (ep2 x y z) (every? (fn* [] (and (p1 %) (p2 %))) args)))))) ([p1 p2 p3] (fn ep3 ([] true) ([x] (boolean (and (p1 x) (p2 x) (p3 x)))) ([x y] (boolean (and (p1 x) (p1 y) (p2 x) (p2 y) (p3 x) (p3 y)))) ([x y z] (boolean (and (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z) (p3 x) (p3 y) (p3 z)))) ([x y z & args] (boolean (and (ep3 x y z) (every? (fn* [] (and (p1 %) (p2 %) (p3 %))) args)))))) ([p1 p2 p3 & ps] (let [ps (list* p1 p2 p3 ps)] (fn epn ([] true) ([x] (every? (fn* [p1__3#] (p1__3# x)) ps)) ([x y] (every? (fn* [] (and (% x) (% y))) ps)) ([x y z] (every? (fn* [] (and (% x) (% y) (% z))) ps)) ([x y z & args] (boolean (and (epn x y z) (every? (fn* [p1__3#] (every? p1__3# args)) ps)))))))) -(defn some-fn "Takes a set of predicates and returns a function f that returns the first logical true value\n returned by one of its composing predicates against any of its arguments, else it returns\n logical false. Note that f is short-circuiting in that it will stop execution on the first\n argument that triggers a logical true result against the original predicates." {:added "1.3"} ([p] (fn sp1 ([] nil) ([x] (p x)) ([x y] (or (p x) (p y))) ([x y z] (or (p x) (p y) (p z))) ([x y z & args] (or (sp1 x y z) (some p args))))) ([p1 p2] (fn sp2 ([] nil) ([x] (or (p1 x) (p2 x))) ([x y] (or (p1 x) (p1 y) (p2 x) (p2 y))) ([x y z] (or (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z))) ([x y z & args] (or (sp2 x y z) (some (fn* [] (or (p1 %) (p2 %))) args))))) ([p1 p2 p3] (fn sp3 ([] nil) ([x] (or (p1 x) (p2 x) (p3 x))) ([x y] (or (p1 x) (p1 y) (p2 x) (p2 y) (p3 x) (p3 y))) ([x y z] (or (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z) (p3 x) (p3 y) (p3 z))) ([x y z & args] (or (sp3 x y z) (some (fn* [] (or (p1 %) (p2 %) (p3 %))) args))))) ([p1 p2 p3 & ps] (let [ps (list* p1 p2 p3 ps)] (fn spn ([] nil) ([x] (some (fn* [p1__3#] (p1__3# x)) ps)) ([x y] (some (fn* [] (or (% x) (% y))) ps)) ([x y z] (some (fn* [] (or (% x) (% y) (% z))) ps)) ([x y z & args] (or (spn x y z) (some (fn* [p1__3#] (some p1__3# args)) ps))))))) -(defn- assert-valid-fdecl "A good fdecl looks like (([a] ...) ([a b] ...)) near the end of defn." [fdecl] (when (empty? fdecl) (throw (IllegalArgumentException. "Parameter declaration missing"))) (let [argdecls (map (fn* [] (if (seq? %) (first %) (throw (IllegalArgumentException. (if (seq? (first fdecl)) (str "Invalid signature \"" % "\" should be a list") (str "Parameter declaration \"" % "\" should be a vector")))))) fdecl) bad-args (seq (remove (fn* [p1__3#] (vector? p1__3#)) argdecls))] (when bad-args (throw (IllegalArgumentException. (str "Parameter declaration \"" (first bad-args) "\" should be a vector")))))) -(defn with-redefs-fn "Temporarily redefines Vars during a call to func. Each val of\n binding-map will replace the root value of its key which must be\n a Var. After func is called with no args, the root values of all\n the Vars will be set back to their old values. These temporary\n changes will be visible in all threads. Useful for mocking out\n functions during testing." {:added "1.3"} [binding-map func] (let [root-bind (fn [m] (doseq [[a-var a-val] m] (.bindRoot a-var a-val))) old-vals (zipmap (keys binding-map) (map (fn* [p1__3#] (.getRawRoot p1__3#)) (keys binding-map)))] (try (root-bind binding-map) (func) (finally (root-bind old-vals))))) -(defmacro with-redefs "binding => var-symbol temp-value-expr\n\n Temporarily redefines Vars while executing the body. The\n temp-value-exprs will be evaluated and each resulting value will\n replace in parallel the root value of its Var. After the body is\n executed, the root values of all the Vars will be set back to their\n old values. These temporary changes will be visible in all threads.\n Useful for mocking out functions during testing." {:added "1.3"} [bindings & body] (quasiquote (with-redefs-fn (clojure.core/unquote (zipmap (map (fn* [p1__3#] (list (quasiquote var) p1__3#)) (take-nth 2 bindings)) (take-nth 2 (next bindings)))) (fn [] ~@body)))) +(defn every-pred "Takes a set of predicates and returns a function f that returns true if all of its\n composing predicates return a logical true value against all of its arguments, else it returns\n false. Note that f is short-circuiting in that it will stop execution on the first\n argument that triggers a logical false result against the original predicates." {:added "1.3"} ([p] (fn ep1 ([] true) ([x] (boolean (p x))) ([x y] (boolean (and (p x) (p y)))) ([x y z] (boolean (and (p x) (p y) (p z)))) ([x y z & args] (boolean (and (ep1 x y z) (every? p args)))))) ([p1 p2] (fn ep2 ([] true) ([x] (boolean (and (p1 x) (p2 x)))) ([x y] (boolean (and (p1 x) (p1 y) (p2 x) (p2 y)))) ([x y z] (boolean (and (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z)))) ([x y z & args] (boolean (and (ep2 x y z) (every? (fn* [p1__62#] (and (p1 p1__62#) (p2 p1__62#))) args)))))) ([p1 p2 p3] (fn ep3 ([] true) ([x] (boolean (and (p1 x) (p2 x) (p3 x)))) ([x y] (boolean (and (p1 x) (p1 y) (p2 x) (p2 y) (p3 x) (p3 y)))) ([x y z] (boolean (and (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z) (p3 x) (p3 y) (p3 z)))) ([x y z & args] (boolean (and (ep3 x y z) (every? (fn* [p1__63#] (and (p1 p1__63#) (p2 p1__63#) (p3 p1__63#))) args)))))) ([p1 p2 p3 & ps] (let [ps (list* p1 p2 p3 ps)] (fn epn ([] true) ([x] (every? (fn* [p1__64#] (p1__64# x)) ps)) ([x y] (every? (fn* [p1__65#] (and (p1__65# x) (p1__65# y))) ps)) ([x y z] (every? (fn* [p1__66#] (and (p1__66# x) (p1__66# y) (p1__66# z))) ps)) ([x y z & args] (boolean (and (epn x y z) (every? (fn* [p1__67#] (every? p1__67# args)) ps)))))))) +(defn some-fn "Takes a set of predicates and returns a function f that returns the first logical true value\n returned by one of its composing predicates against any of its arguments, else it returns\n logical false. Note that f is short-circuiting in that it will stop execution on the first\n argument that triggers a logical true result against the original predicates." {:added "1.3"} ([p] (fn sp1 ([] nil) ([x] (p x)) ([x y] (or (p x) (p y))) ([x y z] (or (p x) (p y) (p z))) ([x y z & args] (or (sp1 x y z) (some p args))))) ([p1 p2] (fn sp2 ([] nil) ([x] (or (p1 x) (p2 x))) ([x y] (or (p1 x) (p1 y) (p2 x) (p2 y))) ([x y z] (or (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z))) ([x y z & args] (or (sp2 x y z) (some (fn* [p1__68#] (or (p1 p1__68#) (p2 p1__68#))) args))))) ([p1 p2 p3] (fn sp3 ([] nil) ([x] (or (p1 x) (p2 x) (p3 x))) ([x y] (or (p1 x) (p1 y) (p2 x) (p2 y) (p3 x) (p3 y))) ([x y z] (or (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z) (p3 x) (p3 y) (p3 z))) ([x y z & args] (or (sp3 x y z) (some (fn* [p1__69#] (or (p1 p1__69#) (p2 p1__69#) (p3 p1__69#))) args))))) ([p1 p2 p3 & ps] (let [ps (list* p1 p2 p3 ps)] (fn spn ([] nil) ([x] (some (fn* [p1__70#] (p1__70# x)) ps)) ([x y] (some (fn* [p1__71#] (or (p1__71# x) (p1__71# y))) ps)) ([x y z] (some (fn* [p1__72#] (or (p1__72# x) (p1__72# y) (p1__72# z))) ps)) ([x y z & args] (or (spn x y z) (some (fn* [p1__73#] (some p1__73# args)) ps))))))) +(defn- assert-valid-fdecl "A good fdecl looks like (([a] ...) ([a b] ...)) near the end of defn." [fdecl] (when (empty? fdecl) (throw (IllegalArgumentException. "Parameter declaration missing"))) (let [argdecls (map (fn* [p1__74#] (if (seq? p1__74#) (first p1__74#) (throw (IllegalArgumentException. (if (seq? (first fdecl)) (str "Invalid signature \"" p1__74# "\" should be a list") (str "Parameter declaration \"" p1__74# "\" should be a vector")))))) fdecl) bad-args (seq (remove (fn* [p1__75#] (vector? p1__75#)) argdecls))] (when bad-args (throw (IllegalArgumentException. (str "Parameter declaration \"" (first bad-args) "\" should be a vector")))))) +(defn with-redefs-fn "Temporarily redefines Vars during a call to func. Each val of\n binding-map will replace the root value of its key which must be\n a Var. After func is called with no args, the root values of all\n the Vars will be set back to their old values. These temporary\n changes will be visible in all threads. Useful for mocking out\n functions during testing." {:added "1.3"} [binding-map func] (let [root-bind (fn [m] (doseq [[a-var a-val] m] (.bindRoot a-var a-val))) old-vals (zipmap (keys binding-map) (map (fn* [p1__76#] (.getRawRoot p1__76#)) (keys binding-map)))] (try (root-bind binding-map) (func) (finally (root-bind old-vals))))) +(defmacro with-redefs "binding => var-symbol temp-value-expr\n\n Temporarily redefines Vars while executing the body. The\n temp-value-exprs will be evaluated and each resulting value will\n replace in parallel the root value of its Var. After the body is\n executed, the root values of all the Vars will be set back to their\n old values. These temporary changes will be visible in all threads.\n Useful for mocking out functions during testing." {:added "1.3"} [bindings & body] (quasiquote (with-redefs-fn (clojure.core/unquote (zipmap (map (fn* [p1__77#] (list (quasiquote var) p1__77#)) (take-nth 2 bindings)) (take-nth 2 (next bindings)))) (fn [] ~@body)))) (defn realized? "Returns true if a value has been produced for a promise, delay, future or lazy sequence." {:added "1.3"} [x] (.isRealized x)) (defmacro cond-> "Takes an expression and a set of test/form pairs. Threads expr (via ->)\n through each form for which the corresponding test\n expression is true. Note that, unlike cond branching, cond-> threading does\n not short circuit after the first true test expression." {:added "1.5"} [expr & clauses] (assert (even? (count clauses))) (let [g (gensym) steps (map (fn [[test step]] (quasiquote (if (clojure.core/unquote test) (-> (clojure.core/unquote g) (clojure.core/unquote step)) (clojure.core/unquote g)))) (partition 2 clauses))] (quasiquote (let [(clojure.core/unquote g) (clojure.core/unquote expr) ~@(interleave (repeat g) (butlast steps))] (clojure.core/unquote (if (empty? steps) g (last steps))))))) (defmacro cond->> "Takes an expression and a set of test/form pairs. Threads expr (via ->>)\n through each form for which the corresponding test expression\n is true. Note that, unlike cond branching, cond->> threading does not short circuit\n after the first true test expression." {:added "1.5"} [expr & clauses] (assert (even? (count clauses))) (let [g (gensym) steps (map (fn [[test step]] (quasiquote (if (clojure.core/unquote test) (->> (clojure.core/unquote g) (clojure.core/unquote step)) (clojure.core/unquote g)))) (partition 2 clauses))] (quasiquote (let [(clojure.core/unquote g) (clojure.core/unquote expr) ~@(interleave (repeat g) (butlast steps))] (clojure.core/unquote (if (empty? steps) g (last steps))))))) (defmacro as-> "Binds name to expr, evaluates the first form in the lexical context\n of that binding, then binds name to that result, repeating for each\n successive form, returning the result of the last form." {:added "1.5"} [expr name & forms] (quasiquote (let [(clojure.core/unquote name) (clojure.core/unquote expr) ~@(interleave (repeat name) (butlast forms))] (clojure.core/unquote (if (empty? forms) name (last forms)))))) (defmacro some-> "When expr is not nil, threads it into the first form (via ->),\n and when that result is not nil, through the next etc" {:added "1.5"} [expr & forms] (let [g (gensym) steps (map (fn [step] (quasiquote (if (nil? (clojure.core/unquote g)) nil (-> (clojure.core/unquote g) (clojure.core/unquote step))))) forms)] (quasiquote (let [(clojure.core/unquote g) (clojure.core/unquote expr) ~@(interleave (repeat g) (butlast steps))] (clojure.core/unquote (if (empty? steps) g (last steps))))))) (defmacro some->> "When expr is not nil, threads it into the first form (via ->>),\n and when that result is not nil, through the next etc" {:added "1.5"} [expr & forms] (let [g (gensym) steps (map (fn [step] (quasiquote (if (nil? (clojure.core/unquote g)) nil (->> (clojure.core/unquote g) (clojure.core/unquote step))))) forms)] (quasiquote (let [(clojure.core/unquote g) (clojure.core/unquote expr) ~@(interleave (repeat g) (butlast steps))] (clojure.core/unquote (if (empty? steps) g (last steps))))))) -(defn preserving-reduced [rf] (fn* [] (let [ret (rf %1 %2)] (if (reduced? ret) (reduced ret) ret)))) +(defn preserving-reduced [rf] (fn* [p1__78# p2__79#] (let [ret (rf p1__78# p2__79#)] (if (reduced? ret) (reduced ret) ret)))) (defn cat "A transducer which concatenates the contents of each input, which must be a\n collection, into the reduction." {:added "1.7"} [rf] (let [rrf (preserving-reduced rf)] (fn ([] (rf)) ([result] (rf result)) ([result input] (reduce rrf result input))))) (defn halt-when "Returns a transducer that ends transduction when pred returns true\n for an input. When retf is supplied it must be a fn of 2 arguments -\n it will be passed the (completed) result so far and the input that\n triggered the predicate, and its return value (if it does not throw\n an exception) will be the return value of the transducer. If retf\n is not supplied, the input that triggered the predicate will be\n returned. If the predicate never returns true the transduction is\n unaffected." {:added "1.9"} ([pred] (halt-when pred nil)) ([pred retf] (fn [rf] (fn ([] (rf)) ([result] (if (and (map? result) (contains? result ::halt)) (::halt result) (rf result))) ([result input] (if (pred input) (reduced {::halt (if retf (retf (rf result) input) input)}) (rf result input))))))) (defn dedupe "Returns a lazy sequence removing consecutive duplicates in coll.\n Returns a transducer when no collection is provided." {:added "1.7"} ([] (fn [rf] (let [pv (volatile! ::none)] (fn ([] (rf)) ([result] (rf result)) ([result input] (let [prior (clojure.core/deref pv)] (vreset! pv input) (if (= prior input) result (rf result input)))))))) ([coll] (sequence (dedupe) coll))) @@ -681,7 +681,7 @@ (deftype Eduction [xform coll] Iterable (iterator [_] (clojure.lang.TransformerIterator/create xform (clojure.lang.RT/iter coll))) clojure.lang.IReduceInit (reduce [_ f init] (transduce xform (completing f) init coll)) clojure.lang.Sequential) (defn eduction "Returns a reducible/iterable application of the transducers\n to the items in coll. Transducers are applied in order as if\n combined with comp. Note that these applications will be\n performed every time reduce/iterator is called." {:arglists (quote ([xform* coll])), :added "1.7"} [& xforms] (Eduction. (apply comp (butlast xforms)) (last xforms))) (defmethod print-method Eduction [c w] (if *print-readably* (do (print-sequential "(" pr-on " " ")" c w)) (print-object c w))) -(defn run! "Runs the supplied procedure (via reduce), for purposes of side\n effects, on successive items in the collection. Returns nil" {:added "1.7"} [proc coll] (reduce (fn* [p1__4# p2__3#] (proc p2__3#)) nil coll) nil) +(defn run! "Runs the supplied procedure (via reduce), for purposes of side\n effects, on successive items in the collection. Returns nil" {:added "1.7"} [proc coll] (reduce (fn* [p1__81# p2__80#] (proc p2__80#)) nil coll) nil) (defn iteration "Creates a seqable/reducible via repeated calls to step,\n a function of some (continuation token) 'k'. The first call to step\n will be passed initk, returning 'ret'. Iff (somef ret) is true,\n (vf ret) will be included in the iteration, else iteration will\n terminate and vf/kf will not be called. If (kf ret) is non-nil it\n will be passed to the next step call, else iteration will terminate.\n\n This can be used e.g. to consume APIs that return paginated or batched data.\n\n step - (possibly impure) fn of 'k' -> 'ret'\n\n :somef - fn of 'ret' -> logical true/false, default 'some?'\n :vf - fn of 'ret' -> 'v', a value produced by the iteration, default 'identity'\n :kf - fn of 'ret' -> 'next-k' or nil (signaling 'do not continue'), default 'identity'\n :initk - the first value passed to step, default 'nil'\n\n It is presumed that step with non-initk is unreproducible/non-idempotent.\n If step with initk is unreproducible it is on the consumer to not consume twice." {:added "1.11"} [step & {:keys [somef vf kf initk], :or {vf identity, kf identity, somef some?, initk nil}}] (reify clojure.lang.Seqable (seq [_] ((fn next [ret] (when (somef ret) (cons (vf ret) (when-some [k (kf ret)] (lazy-seq (next (step k))))))) (step initk))) clojure.lang.IReduceInit (reduce [_ rf init] (loop [acc init ret (step initk)] (if (somef ret) (let [acc (rf acc (vf ret))] (if (reduced? acc) (clojure.core/deref acc) (if-some [k (kf ret)] (recur acc (step k)) acc))) acc))))) (defn tagged-literal? "Return true if the value is the data representation of a tagged literal" {:added "1.7"} [value] (instance? clojure.lang.TaggedLiteral value)) (defn tagged-literal "Construct a data representation of a tagged literal from a\n tag symbol and a form." {:added "1.7"} [tag form] (clojure.lang.TaggedLiteral/create tag form))