(defn identity
"Returns its argument."
[x] x)
(defn constantly
"Returns a function that takes any number of arguments and always returns x."
[x] (fn [& _] x))
(defn complement
"Takes a function f and returns a function that takes the same args as f,
and returns the opposite truth value."
[f] (fn [& args] (not (apply f args))))
(defn some-fn
"Takes a set of predicates and returns a function f that returns the first
logical true value of applying one of its predicates to any of its
arguments, else nil."
([p] (fn [& args] (or (some p args) false)))
([p1 p2] (fn [& args] (or (some p1 args) (some p2 args) false)))
([p1 p2 p3] (fn [& args] (or (some p1 args) (some p2 args) (some p3 args) false)))
([p1 p2 p3 & ps]
(fn [& args]
(or (some p1 args) (some p2 args) (some p3 args)
(some (fn [p] (some p args)) ps) false))))
(defn every-pred
"Takes a set of predicates and returns a function f that returns true if
all of its predicates are satisfied by all of its arguments, else false."
([p] (fn [& args] (every? p args)))
([p1 p2] (fn [& args] (and (every? p1 args) (every? p2 args))))
([p1 p2 p3] (fn [& args] (and (every? p1 args) (every? p2 args) (every? p3 args))))
([p1 p2 p3 & ps]
(fn [& args]
(and (every? p1 args) (every? p2 args) (every? p3 args)
(every? (fn [p] (every? p args)) ps)))))
(defn not=
"Same as (not (= obj1 obj2))."
[& args] (not (apply = args)))
(defn comp
"Takes a set of functions and returns a fn that is the composition of
those fns. The returned fn takes any number of args, applies the
rightmost fn to the args, the next fn (right-to-left) to the result, etc."
([] identity)
([f] f)
([f g] (fn [& args] (f (apply g args))))
([f g & more]
(reduce comp (cons f (cons g more)))))
(defn partial
"Takes a function f and fewer than the normal arguments to f, and returns
a fn that takes a variable number of additional args and applies f to
args + additional args."
[f & args]
(fn [& more] (apply f (concat args more))))
;; reduce is a native builtin (supports reduced/early-termination)
(defn completing
"Takes a reducing function f (with 2-arg step arity) and returns a fn
with 0, 1, and 2 arities: 0-arg calls (f), 1-arg calls cf (default
identity) for completion, 2-arg calls f for the step."
([f] (completing f identity))
([f cf]
(fn
([] (f))
([result] (cf result))
([result input] (f result input)))))
(defn transduce
"reduce with a transformation of f (xf). If init is not supplied,
(f) will be called to produce it. f should be a reducing function
that accepts 0 and 2 arities. Returns the value obtained by applying
(xform f) to init and the elements of coll."
([xform f coll]
(transduce xform f (f) coll))
([xform f init coll]
(let [f (xform f)
ret (reduce f init coll)]
(f ret))))
(defn sequence
"Coerces coll to a (possibly empty) sequence, if it is not already one.
With a transducer, returns a lazy sequence of applications of the transform
to the items in coll(s)."
([coll] (or (seq coll) ()))
([xform coll]
(let [rf (xform conj)
result (reduce rf [] coll)
result (rf result)]
(or (seq (if (reduced? result) (unreduced result) result)) ()))))
(defn map
"Returns a lazy sequence consisting of the result of applying f to the
set of first items of each coll, followed by applying f to the set of
second items, until any one coll is exhausted. With one collection arg,
returns a transducer."
([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)]
(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 [all-colls (list* c1 c2 c3 colls)]
(letfn [(map-step [seqs]
(lazy-seq
(let [ss (map seq seqs)]
(when (every? identity ss)
(cons (apply f (map first ss))
(map-step (map rest ss)))))))]
(map-step all-colls)))))
(defn filter
"Returns a lazy sequence of the items in coll for which (pred item)
returns logical true. With no coll, returns a transducer."
([pred]
(fn [rf]
(fn
([] (rf))
([result] (rf result))
([result input]
(if (pred input)
(rf result input)
result)))))
([pred coll]
(loop [s (seq coll) acc []]
(if s
(if (pred (first s))
(recur (next s) (conj acc (first s)))
(recur (next s) acc))
(or (seq acc) '())))))
(defn remove
"Returns a lazy sequence of the items in coll for which (pred item)
returns logical false. With no coll, returns a transducer."
([pred] (filter (complement pred)))
([pred coll] (filter (complement pred) coll)))
(defn keep
"Returns a lazy sequence of the non-nil results of (f item). Note, this
means false return values will be included. With no coll, returns a
transducer."
([f]
(fn [rf]
(fn
([] (rf))
([result] (rf result))
([result input]
(let [v (f input)]
(if (nil? v) result (rf result v)))))))
([f coll]
(loop [s (seq coll) acc []]
(if s
(let [v (f (first s))]
(if (nil? v)
(recur (next s) acc)
(recur (next s) (conj acc v))))
(or (seq acc) '())))))
(defn cat
"A transducer which concatenates the contents of each input, which must
be a collection, into the reduction."
[rf]
(fn
([] (rf))
([result] (rf result))
([result input] (reduce rf result input))))
(defn mapcat
"Returns the result of applying concat to the result of applying map to f
and colls. Thus function f should return a collection. With no coll,
returns a transducer."
([f] (comp (map f) cat))
([f coll]
(when-not (ifn? f) (throw (str "Argument must be a function: " f)))
(let [s (seq coll)]
(letfn [(cat [xs colls]
(lazy-seq
(if-let [s (seq xs)]
(cons (first s) (cat (rest s) colls))
(when-let [cs (seq colls)]
(cat (f (first cs)) (rest cs))))))]
(cat nil s))))
([f c1 c2]
(when-not (ifn? f) (throw (str "Argument must be a function: " f)))
(letfn [(cat [xs s1 s2]
(lazy-seq
(if-let [s (seq xs)]
(cons (first s) (cat (rest s) s1 s2))
(when (and s1 s2)
(cat (f (first s1) (first s2))
(next s1) (next s2))))))]
(cat nil (seq c1) (seq c2))))
([f c1 c2 & colls]
(when-not (ifn? f) (throw (str "Argument must be a function: " f)))
(let [all-colls (cons c1 (cons c2 colls))
step (fn step [xs seqs]
(lazy-seq
(if-let [s (seq xs)]
(cons (first s) (step (rest s) seqs))
(when (every? seq seqs)
(step (apply f (map first seqs))
(map next seqs))))))]
(step nil (map seq all-colls)))))
(defn tree-seq
"Returns a lazy sequence of the nodes in a tree, via a depth-first walk.
branch? must be a fn of one arg that returns true if passed a node
that can have children (but may not). children must be a fn of one
arg that returns a sequence of the children. Will only be called on
nodes for which branch? returns true. Root is the root node of the
tree."
[branch? children root]
(let [walk (fn walk [node]
(lazy-seq
(cons node
(when (branch? node)
(mapcat walk (children node))))))]
(walk root)))
(defn take
"Returns a lazy sequence of the first n items in coll, or all items if
there are fewer than n. With no coll, returns a transducer."
([n]
(fn [rf]
(let [nv (volatile! n)]
(fn
([] (rf))
([result] (rf result))
([result input]
(let [n @nv
nn (vswap! nv dec)
result (if (pos? n) (rf result input) result)]
(if (not (pos? nn))
(ensure-reduced result)
result)))))))
([n coll]
(let [n (int n)]
(cond (pos? n)
(when (pos? n)
(lazy-seq
(when-let [s (seq coll)]
(cons (first s) (take (dec n) (rest s))))))
:else []))))
(defn drop
"Returns a lazy sequence of all but the first n items in coll. With no
coll, returns a transducer."
([n]
(fn [rf]
(let [nv (volatile! n)]
(fn
([] (rf))
([result] (rf result))
([result input]
(let [n (vswap! nv dec)]
(if (neg? n)
(rf result input)
result)))))))
([n coll]
(loop [s (seq coll) n (int n)]
(if (and s (pos? n))
(recur (next s) (dec n))
(or s '())))))
(defn take-while
"Returns a lazy sequence of successive items from coll while
(pred item) returns logical true. With no coll, returns a transducer."
([pred]
(fn [rf]
(fn
([] (rf))
([result] (rf result))
([result input]
(if (pred input)
(rf result input)
(reduced result))))))
([pred coll]
(lazy-seq
(when-let [s (seq coll)]
(let [x (first s)]
(when (pred x)
(cons x (take-while pred (rest s)))))))))
(defn drop-while
"Returns a lazy sequence of the items in coll starting from the first
item for which (pred item) returns logical false. With no coll, returns
a transducer."
([pred]
(fn [rf]
(let [dv (volatile! true)]
(fn
([] (rf))
([result] (rf result))
([result input]
(if (and @dv (pred input))
result
(do (vreset! dv false)
(rf result input))))))))
([pred coll]
(loop [s (seq coll)]
(if (and s (pred (first s)))
(recur (next s))
(or s '())))))
(defn dorun
"Walks through coll, realizing each lazy element, for side effects.
Returns nil."
[coll]
(loop [s (seq coll)]
(when s (recur (next s)))))
(defn doall
"Walks through coll, realizing every lazy element, for side effects.
Returns coll."
[coll]
(dorun coll)
coll)
(defn run!
"Runs the supplied procedure (via reduce), for purposes of side effects,
on successive items in coll. Returns nil."
[proc coll]
(reduce #(proc %2) nil coll)
nil)
(defn some
"Returns the first logical true value of (pred x) for any x in coll,
else nil."
[pred coll]
(loop [s (seq coll)]
(when s
(let [v (pred (first s))]
(if v v (recur (next s)))))))
(defn every?
"Returns true if (pred x) is logical true for every x in coll, else
false."
[pred coll]
(loop [s (seq coll)]
(if s
(if (pred (first s))
(recur (next s))
false)
true)))
(defn not-any?
"Returns true if (pred x) is logical false for every x in coll, else
false."
[pred coll] (not (some pred coll)))
(defn not-every?
"Returns true if (pred x) is logical false for at least one x in coll,
else false."
[pred coll] (not (every? pred coll)))
(defn mapv
"Returns a vector consisting of the result of applying f to the set of
first items of each coll, followed by applying f to the set of second
items, until any one coll is exhausted."
[f coll] (vec (map f coll)))
(defn filterv
"Returns a vector of the items in coll for which (pred item) returns
logical true."
[pred coll] (vec (filter pred coll)))
(defn swap!
"Atomically swaps the value of atom to be (apply f current-value args)."
[a f & args] (reset! a (apply f (deref a) args)))
(defmacro when
"Evaluates test. If logical true, evaluates body in an implicit do."
[test & body]
(list 'if test (cons 'do body) nil))
(defmacro when-not
"Evaluates test. If logical false, evaluates body in an implicit do."
[test & body]
(list 'if test nil (cons 'do body)))
(defmacro if-not
"Evaluates test. If logical false, evaluates and returns then, otherwise
else (default nil)."
([test then] (list 'if test nil then))
([test then else] (list 'if test else then)))
(defmacro declare
"defs the supplied var names with no bindings, useful for making forward declarations."
[& names]
(cons 'do (map (fn [n] (list 'def n)) names)))
(defmacro if-let
"bindings => binding-form test. If test is logical true, evaluates then
with binding-form bound to the value of test, otherwise else."
([bindings then] (list 'if-let bindings then nil))
([bindings then else]
(let [form (nth bindings 0)
tst (nth bindings 1)
temp (gensym "if_let__")]
(list 'let (vector temp tst)
(list 'if temp
(list 'let (vector form temp) then)
else)))))
(defmacro when-let
"bindings => binding-form test. If test is logical true, evaluates body
with binding-form bound to the value of test."
[bindings & body]
(list 'if-let bindings (cons 'do body)))
(defmacro cond
"Takes a set of test/expr pairs. Evaluates each test one at a time. If a
test returns logical true, evaluates and returns the value of the
corresponding expr and doesn't evaluate any of the other tests or exprs.
Returns nil if no test is true."
[& clauses]
(when (seq clauses)
(list 'if (first clauses)
(if (next clauses)
(second clauses)
(throw (ex-info "cond requires even number of clauses" {})))
(cons 'cond (next (next clauses))))))
(defmacro condp
"Takes a binary predicate, an expression, and a set of test-expr/result-expr
clauses. For each clause, (pred test-expr expr) is evaluated; the first
clause for which this is logical true has its result-expr evaluated and
returned. An odd trailing clause is a default expression evaluated if no
clause matches; otherwise throws."
[pred expr & clauses]
(if (seq clauses)
(if (next clauses)
(list 'if (list pred (first clauses) expr)
(second clauses)
(cons 'condp (cons pred (cons expr (next (next clauses))))))
(first clauses))
(throw (ex-info "condp: no matching clause" {}))))
(defmacro case
"Takes an expression and a set of test-constant/result-expr clauses (test
constants may be lists of alternatives). Matches expr against the test
constants using an equality check and evaluates the corresponding
result-expr. An odd trailing clause is a default expression evaluated if
no clause matches; otherwise throws."
[expr & clauses]
(let [e (gensym)
quote-const (fn [c]
;; Quote symbols and lists so they aren't evaluated.
;; Keywords, numbers, strings, chars, booleans, nil, vectors,
;; maps, and sets are self-evaluating and need no quoting.
(if (or (symbol? c) (list? c))
(list 'quote c)
c))
build (fn build [cs]
(if (seq cs)
(if (next cs)
(let [test-expr (first cs)
then-expr (second cs)
rest-cs (next (next cs))]
;; A list test means multiple alternatives: (a b c) matches a OR b OR c
;; UNLESS it's a list wrapped in another list: ((list of things)) matches the inner list literally
(if (and (list? test-expr) (not (nil? (seq test-expr))))
(if (and (= 1 (count test-expr)) (list? (first test-expr)))
;; ((inner-list)) — match the inner list literally
(list 'if (list 'case= e (quote-const (first test-expr)))
then-expr
(build rest-cs))
;; (a b c) — match any of the alternatives
(list 'if (cons 'or (map (fn [c] (list 'case= e (quote-const c))) test-expr))
then-expr
(build rest-cs)))
(list 'if (list 'case= e (quote-const test-expr))
then-expr
(build rest-cs))))
;; odd trailing form = default expression
(first cs))
(list 'throw (list 'new 'Exception (list 'str "No matching clause: " e)))))]
(list 'let (vector e expr)
(build clauses))))
(defmacro ->
"Threads x through the forms. Inserts x as the second item in the first
form, making a list of it if it is not a list already. If there are more
forms, inserts the first form as the second item in second form, etc."
([x] x)
([x form & more]
(let [threaded (if (seq? form)
(with-meta (list* (first form) x (next form)) (meta form))
(list form x))]
(if (seq more)
(list* '-> threaded more)
threaded))))
(defmacro ->>
"Threads x through the forms. Inserts x as the last item in the first
form, making a list of it if it is not a list already. If there are more
forms, inserts the first form as the last item in second form, etc."
([x] x)
([x form & more]
(let [threaded (if (seq? form)
(with-meta (concat (list (first form)) (next form) (list x)) (meta form))
(list form x))]
(if (seq more)
(list* '->> threaded more)
threaded))))
(defmacro as->
"Binds name to expr, evaluates the first form in the lexical context of
that binding, then binds name to that result, repeating for each
successive form, returning the result of the last form."
[expr name & forms]
(list 'let (vector name expr)
(if (seq forms)
(list* 'as-> name forms)
name)))
(defmacro doto
"Evaluates x, then calls each of the forms with x as the first argument,
presumably for side effects. Returns the evaluated x."
[x & forms]
(let [gx (gensym)]
(list 'let (vector gx x)
(cons 'do (map (fn [f]
(if (seq? f)
(cons (first f) (cons gx (rest f)))
(list f gx)))
forms)))))
(defmacro dotimes
"bindings => name n. Repeatedly executes body (presumably for side
effects) with name bound to integers from 0 through n-1."
[bindings & body]
(let [i (first bindings)
n (second bindings)]
(list 'loop (vector i 0)
(list 'when (list '< i n)
(cons 'do body)
(list 'recur (list 'inc i))))))
(defmacro doseq
"bindings => binding-form coll-expr [modifier binding-form coll-expr]*.
Repeatedly executes body (presumably for side effects) with bindings and
filtering as provided by \"for\". Supports :let, :while, and :when
modifiers. Returns nil."
[bindings & body]
(letfn [(emit [binds recur-form]
(if (seq binds)
(let [tag (first binds)]
(cond
(= :when tag)
;; :when — skip element but continue loop
(let [expr (second binds)]
(list 'do
(list 'when expr (emit (next (next binds)) nil))
recur-form))
(= :while tag)
;; :while — stop loop entirely when false
(let [expr (second binds)]
(list 'when expr (emit (next (next binds)) recur-form)))
(= :let tag)
(let [let-binds (second binds)]
(list 'let let-binds (emit (next (next binds)) recur-form)))
:else
(let [x tag
coll (second binds)
rest-binds (next (next binds))
gs (gensym "s__")
inner-loop (list 'loop (vector gs (list 'seq coll))
(list 'when gs
(list 'let (vector x (list 'first gs))
(emit rest-binds (list 'recur (list 'next gs))))))]
(if recur-form
(list 'do inner-loop recur-form)
inner-loop))))
(list 'do (cons 'do body) recur-form)))]
(emit (seq bindings) nil)))
(defmacro for
"List comprehension. binding => [name coll-expr]. Returns a lazy sequence
of the results of evaluating body for each name bound to successive
elements of coll-expr."
[binding & body]
(let [x (first binding)
coll (second binding)]
(list 'map (list 'fn (vector x) (cons 'do body)) coll)))
(defn second
"Same as (first (rest x))."
[coll] (first (rest coll)))
(defn third
"Same as (first (rest (rest x)))."
[coll] (first (rest (rest coll))))
(defn ffirst
"Same as (first (first x))."
[coll] (first (first coll)))
(defn nfirst
"Same as (next (first x))."
[coll] (next (first coll)))
(defn fnext
"Same as (first (next x))."
[coll] (first (next coll)))
(defn nnext
"Same as (next (next x))."
[coll] (next (next coll)))
(defn nthnext
"Returns the nth next of coll, (seq coll) when n is 0."
[coll n]
(if (and (some? coll) (nil? n))
(throw (str "arg 2 must not be nil"))
(loop [s (seq coll) n n]
(if (and s (pos? n))
(recur (next s) (dec n))
s))))
(defn butlast
"Returns a seq of all but the last item in coll."
[coll]
(loop [s (seq coll) acc []]
(if (next s)
(recur (next s) (conj acc (first s)))
(seq acc))))
(defn drop-last
"Returns a seq of all but the last n (default 1) items in coll."
([coll] (drop-last 1 coll))
([n coll]
(let [s (seq coll)]
(if s
(take (- (count s) n) s)
'()))))
(defn take-last
"Returns a seq of the last n items in coll."
[n coll]
(let [s (seq coll)]
(loop [s s lead (nthnext s n)]
(if lead
(recur (next s) (next lead))
s))))
(defmacro lazy-seq
"Takes a body of expressions that returns an ISeq or nil, and yields a
seqable object that invokes the body only the first time seq is called,
caching the result and returning it on all subsequent seq calls."
[& body]
(list 'make-lazy-seq (list 'fn [] (cons 'do body))))
(defn iterate
"Returns a lazy sequence of x, (f x), (f (f x)), etc."
[f x]
(cons x (lazy-seq (iterate f (f x)))))
(defn repeat
"Returns a lazy (infinite, or length n if supplied) sequence of xs."
([x] (lazy-seq (cons x (repeat x))))
([n x] (take n (repeat x))))
(defn repeatedly
"Takes a function of no args and returns a lazy (infinite, or length n
if supplied) sequence of calls to it."
([f] (lazy-seq (cons (f) (repeatedly f))))
([n f] (take n (repeatedly f))))
(defn range
"Returns a lazy seq of nums from start (inclusive, default 0) to end
(exclusive) by step (default 1). Without end, returns an effectively
infinite sequence."
([] (range 0 9223372036854775807 1))
([end] (range 0 end 1))
([start end] (range start end 1))
([start end step]
(lazy-seq
(when (if (pos? step) (< start end) (> start end))
(cons start (range (+ start step) end step))))))
(defn cycle
"Returns a lazy (infinite) sequence of repetitions of the items in
coll."
[coll]
(letfn [(c [s]
(lazy-seq
(if (seq s)
(cons (first s) (c (rest s)))
(c coll))))]
(when (seq coll) (c coll))))
(defn counted?
"Returns true if coll implements count in constant time."
[x] (or (vector? x) (map? x) (set? x) (seq? x)))
(defn reversible?
"Returns true if coll implements rseq (reverse in constant time)."
[x] (or (vector? x) (sorted-map? x) (sorted-set? x)))
(defn sequential?
"Returns true if coll implements the sequential interface (vector, seq)."
[x] (or (seq? x) (vector? x)))
(defn associative?
"Returns true if coll implements the associative interface (map, vector)."
[x] (or (map? x) (vector? x)))
;; meta and vary-meta are native builtins (see builtins.rs)
(defn seqable?
"Returns true if seq can be called on x."
[x]
(or (nil? x) (seq? x) (vector? x) (map? x) (set? x) (string? x) (array? x)))
(defn nthrest [coll n]
(when-not (number? n) (throw (str "n must be a number, got: " (type n))))
(if (nil? coll)
(if (pos? n) (quote ()) nil)
(loop [s (seq coll) n n]
(if (and s (pos? n))
(recur (next s) (dec n))
(or s (quote ()))))))
(defn split-at
"Returns a vector of [(take n coll) (drop n coll)]."
[n coll]
[(take n coll) (drop n coll)])
(defn split-with
"Returns a vector of [(take-while pred coll) (drop-while pred coll)]."
[pred coll]
[(take-while pred coll) (drop-while pred coll)])
(defn partition
"Returns a seq of lists of n items each, at offsets step apart (default
step = n); drops a trailing partial partition unless pad is supplied, in
which case it's padded (and possibly still trailing-partial) with items
from pad."
([n coll]
(partition n n coll))
([n step coll]
(loop [s (seq coll) acc []]
(if s
(let [part (take n s)]
(if (= (count part) n)
(recur (nthnext s step) (conj acc part))
(seq acc)))
(seq acc))))
([n step pad coll]
(loop [s (seq coll) acc []]
(if s
(let [part (take n s)]
(if (= (count part) n)
(recur (nthnext s step) (conj acc part))
(let [padded (take n (concat part pad))]
(if (= (count padded) n)
(seq (conj acc padded))
(seq acc)))))
(seq acc)))))
(defn partition-all
([n]
(fn [rf]
(let [a (volatile! [])]
(fn
([] (rf))
([result]
(let [result (if (seq @a)
(let [v @a]
(vreset! a [])
(unreduced (rf result v)))
result)]
(rf result)))
([result input]
(let [buf (vswap! a conj input)]
(if (= (count buf) n)
(do (vreset! a [])
(rf result buf))
result)))))))
([n coll]
(loop [s (seq coll) acc []]
(if s
(let [part (take n s)]
(recur (nthnext s n) (conj acc part)))
(seq acc)))))
(defn flatten
"Takes any nested combination of sequential things (lists, vectors,
etc.) and returns their contents as a single, flat sequence."
[x]
(if (coll? x)
(mapcat flatten x)
(list x)))
(defn distinct
"Returns a seq of the elements of coll with duplicates removed. Returns
a transducer when no collection is provided."
([]
(fn [rf]
(let [seen (volatile! #{})]
(fn
([] (rf))
([result] (rf result))
([result input]
(if (contains? @seen input)
result
(do (vswap! seen conj input)
(rf result input))))))))
([coll]
(loop [s (seq coll) seen #{} acc []]
(if s
(let [v (first s)]
(if (contains? seen v)
(recur (next s) seen acc)
(recur (next s) (conj seen v) (conj acc v))))
(seq acc)))))
(defn dedupe
"Returns a lazy sequence removing consecutive duplicates in coll.
Returns a transducer when no collection is provided."
([]
(fn [rf]
(let [pv (volatile! ::none)]
(fn
([] (rf))
([result] (rf result))
([result input]
(let [prior @pv]
(vreset! pv input)
(if (= prior input)
result
(rf result input))))))))
([coll]
(sequence (dedupe) coll)))
(defn partition-by
"Applies f to each value in coll, splitting it each time f returns a
new value. Returns a lazy sequence of partitions. Returns a transducer
when no collection is provided."
([f]
(fn [rf]
(let [started (volatile! false)
a (volatile! [])
pv (volatile! nil)]
(fn
([] (rf))
([result]
(let [result (if (seq @a)
(let [v @a]
(vreset! a [])
(unreduced (rf result v)))
result)]
(rf result)))
([result input]
(let [pval @pv
val (f input)]
(vreset! pv val)
(if (or (not @started) (= val pval))
(do (vreset! started true)
(vswap! a conj input)
result)
(let [v @a]
(vreset! a [input])
(rf result v)))))))))
([f coll]
(lazy-seq
(when-let [s (seq coll)]
(let [fst (first s)
fv (f fst)
run (cons fst (take-while #(= fv (f %)) (rest s)))]
(cons (vec run)
(partition-by f (drop (count run) s))))))))
(defn map-indexed
"Returns a lazy sequence of (f index item) for each item in coll.
Returns a transducer when no collection is provided."
([f]
(fn [rf]
(let [i (volatile! -1)]
(fn
([] (rf))
([result] (rf result))
([result input]
(rf result (f (vswap! i inc) input)))))))
([f coll]
(let [idx (volatile! -1)]
(map (fn [x] (f (vswap! idx inc) x)) coll))))
(defn max
"Returns the greatest of the nums."
[& args] (reduce (fn [a b]
(cond
(NaN? a) a
(NaN? b) b
(>= a b) a
:else b))
args))
(defn min
"Returns the least of the nums."
[& args] (reduce (fn [a b]
(cond
(NaN? a) a
(NaN? b) b
(<= a b) a
:else b))
args))
(defmacro assert
"Evaluates test. If it does not return logical true, throws an
ex-info with an optional message."
[test & args]
(let [msg (first args)]
(list 'when (list 'not test)
(list 'throw (list 'ex-info (or msg "assertion failed") {})))))
(defn frequencies
"Returns a map from distinct items in coll to the number of times they
appear."
[coll]
(reduce (fn [m v] (assoc m v (inc (get m v 0)))) {} coll))
(defn group-by
"Returns a map of the elements of coll keyed by the result of f on each
element; the value at each key is a vector of the corresponding elements,
in the order they appeared in coll."
[f coll]
(reduce (fn [m v]
(let [k (f v)]
(assoc m k (conj (get m k []) v))))
{} coll))
(defn index-of
"Returns the index of the first occurrence of v in coll, or -1 if not
found."
[coll v]
(loop [s (seq coll) i 0]
(if s
(if (= (first s) v) i (recur (next s) (inc i)))
-1)))
(defn keep-indexed
"Returns a lazy sequence of the non-nil results of (f index item).
Returns a transducer when no collection is provided."
([f]
(fn [rf]
(let [i (volatile! -1)]
(fn
([] (rf))
([result] (rf result))
([result input]
(let [idx (vswap! i inc)
v (f idx input)]
(if (nil? v)
result
(rf result v))))))))
([f coll]
(loop [s (seq coll) i 0 acc []]
(if s
(let [v (f i (first s))]
(if (nil? v)
(recur (next s) (inc i) acc)
(recur (next s) (inc i) (conj acc v))))
(seq acc)))))
(defn reduce-kv [f init m]
(reduce (fn [acc kv] (f acc (first kv) (second kv))) init m))
(defn update
"Returns a new structure with the value at key updated by applying f to
the existing value (get m k), plus any supplied args."
[m k f & args]
(assoc m k (apply f (get m k) args)))
(defn update-in
"Returns a new nested structure with the value at the given key sequence
updated by applying f to the existing value there, plus any supplied
args. Missing intermediate levels are created as maps."
[m ks f & args]
(let [k (first ks)
ks (rest ks)]
(if (seq ks)
(assoc m k (apply update-in (get m k {}) ks f args))
(assoc m k (apply f (get m k) args)))))
(defn juxt
"Takes a set of functions and returns a fn that is the juxtaposition of
those fns. The returned fn takes a variable number of args, and returns
a vector containing the result of applying each fn to the args."
[& fns]
(fn [& args] (mapv (fn [f] (apply f args)) fns)))
(defn fnil
"Takes a function f and one or more default values, and returns a fn
that calls f, replacing any nil arguments with the corresponding
default value."
[f default & defaults]
(let [all-defaults (cons default defaults)
n (count all-defaults)
patch (fn patch [args defs]
(if (seq defs)
(cons (if (nil? (first args)) (first defs) (first args))
(patch (rest args) (rest defs)))
args))]
(fn [& args]
(apply f (patch args all-defaults)))))
(defn memoize
"Returns a memoized version of a referentially transparent function f.
The memoized version caches the results of f keyed on the argument list,
and returns the cached result on subsequent calls with the same
arguments instead of calling f again."
[f]
(let [cache (atom {})]
(fn [& args]
(if (contains? @cache args)
(get @cache args)
(let [result (apply f args)]
(swap! cache assoc args result)
result)))))
(defn some? [x] (not (nil? x)))
(defn any? [x] true)
(defn str? [x] (string? x))
;; int?, double?, decimal?, ratio? are native builtins
(defn pos-int? [x] (and (int? x) (pos? x)))
(defn neg-int? [x] (and (int? x) (neg? x)))
(defn nat-int? [x] (and (int? x) (not (neg? x))))
;; zero? is a native builtin
(defn NaN? [x] (and (float? x) (not (= x x))))
(defn infinite? [x] (and (float? x) (or (= x ##Inf) (= x ##-Inf))))
(defn finite? [x] (and (float? x) (not (NaN? x)) (not (infinite? x))))
(defn qualified-symbol? [x]
(and (symbol? x) (not (nil? (namespace x)))))
(defn simple-symbol? [x]
(and (symbol? x) (nil? (namespace x))))
(defn qualified-keyword? [x]
(and (keyword? x) (not (nil? (namespace x)))))
(defn simple-keyword? [x]
(and (keyword? x) (nil? (namespace x))))
(defn println-str [& args]
(str (apply str (interpose " " (map (fnil str "nil") args))) "\n"))
(defn print-str [& args]
(apply str (interpose " " (map (fnil str "nil") args))))
(defn interpose
"Returns a lazy sequence of the elements of coll separated by sep.
Returns a transducer when no collection is provided."
([sep]
(fn [rf]
(let [started (volatile! false)]
(fn
([] (rf))
([result] (rf result))
([result input]
(if @started
(let [sepr (rf result sep)]
(if (reduced? sepr)
sepr
(rf sepr input)))
(do (vreset! started true)
(rf result input))))))))
([sep coll]
(loop [s (next (seq coll))
acc (if (seq coll) [(first coll)] [])]
(if s
(recur (next s) (conj (conj acc sep) (first s)))
(or (seq acc) [])))))
(defn random-sample
"Returns items from coll for which (rand) < prob. Returns a transducer
when no collection is provided."
([prob]
(filter (fn [_] (< (rand) prob))))
([prob coll]
(filter (fn [_] (< (rand) prob)) coll)))
(defn take-nth
"Returns a lazy sequence of every nth item in coll. Returns a transducer
when no collection is provided."
([n]
(fn [rf]
(let [i (volatile! -1)]
(fn
([] (rf))
([result] (rf result))
([result input]
(let [idx (vswap! i inc)]
(if (zero? (rem idx n))
(rf result input)
result)))))))
([n coll]
(lazy-seq
(when-let [s (seq coll)]
(cons (first s) (take-nth n (drop n s)))))))
(defn clojure-version
"Returns the version string of this implementation."
[] "cljx-0.1.0")
;; ── Phase 7: Concurrency primitives ──────────────────────────────────────────
(defmacro delay [& body]
(list 'make-delay (list 'fn [] (cons 'do body))))
(defn delay? [x] (= (type x) 'Delay))
(defn promise? [x] (= (type x) 'Promise))
;; ── Phase 6 (built-in protocols): ICounted, ILookup, ISeqable ────────────────
(defprotocol ICounted
(-count [coll]))
(defprotocol ILookup
(-lookup [coll k] [-lookup [coll k not-found]]))
(defprotocol ISeqable
(-seq [coll]))
(extend-protocol ICounted
List (-count [c] (count c))
Vector (-count [c] (count c))
Map (-count [c] (count c))
Set (-count [c] (count c))
String (-count [c] (count c)))
(extend-protocol ISeqable
List (-seq [c] (seq c))
Vector (-seq [c] (seq c))
Map (-seq [c] (seq c))
Set (-seq [c] (seq c)))
;; ── Dynamic variables ──────────────────────────────────────────────────────
(def ^:dynamic *ns* nil)
(def ^:dynamic *out* nil)
(def ^:dynamic *err* nil)
(def ^:dynamic *assert* true)
(def ^:dynamic *print-dup* false)
(def ^:dynamic *print-readably* true)
(def ^:dynamic *print-length* nil)
(def ^:dynamic *print-level* nil)
(def ^:dynamic *1 nil)
(def ^:dynamic *2 nil)
(def ^:dynamic *3 nil)
(def ^:dynamic *e nil)
(defmacro with-bindings [binding-map & body]
`(with-bindings* ~binding-map (fn [] ~@body)))
(defmacro with-open
"bindings => [name init ...]
Evaluates body in a try expression with names bound to the values
of the inits, and a finally clause that calls (close name) on each
name in reverse order."
[bindings & body]
(assert (vector? bindings) "with-open requires a vector for its bindings")
(assert (even? (count bindings)) "with-open requires an even number of forms in binding vector")
(if (= (count bindings) 0)
`(do ~@body)
(let [name (first bindings)
init (second bindings)
rest-bindings (vec (drop 2 bindings))]
`(let [~name ~init]
(try
(with-open ~rest-bindings ~@body)
(finally
(close ~name)))))))
(defn max-key
"Returns the x for which (k x), a number, is greatest.
If there are multiple such xs, the last one is returned."
([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.
If there are multiple such xs, the last one is returned."
([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)))))
(defmacro comment
[& _]
nil)
(defmacro prn-str
[& body]
(list 'str (cons 'pr-str body) \newline))
; (try
; (do body)
; (finally (pop-precision!)))
(defmacro with-precision
[precision & body]
(if (and (= :rounding (first body))
(symbol? (second body)))
(list 'do (list 'push-precision! precision (list 'quote (second body)))
(list 'try
(cons 'do (drop 2 body))
(list 'finally (list 'pop-precision!))))
(list 'do (list 'push-precision! precision)
(list 'try
(cons 'do body)
(list 'finally (list 'pop-precision!))))))
(defn simple-ident?
"Returns true if x is a symbol or keyword without a namespace."
[v]
(and (or (keyword? v) (symbol? v)) (nil? (namespace v))))
(defn qualified-ident?
"Returns true if x is a symbol or keyword with a namespace."
[v]
(and (or (keyword? v) (symbol? v)) (not (nil? (namespace v)))))
(defn key
"Returns the key of a map entry."
[x]
(if (map-entry? x)
(first x)
(throw (ex-info "not a map entry" {}))))
(defn val
"Returns the value of a map entry."
[x]
(if (map-entry? x)
(second x)
(throw (ex-info "not a map entry" {}))))
(defn inc'
"Returns a number one greater than x, promoting to BigInt on overflow."
[x]
(+' x 1))
(defn dec'
"Returns a number one less than x, promoting to BigInt on overflow."
[x]
(+' x -1))
(defn ident?
"Returns true if x is a symbol or keyword."
[x] (or (symbol? x) (keyword? x)))
(defn rand-nth
"Return a random element of coll."
[coll]
(let [n (rand-int (count coll))]
(nth coll n)))
(defmacro when-first
"bindings => x xs. Roughly the same as (when (seq xs) (let [x (first
xs)] body)) but xs is evaluated only once."
[bindings & body]
(let [x (first bindings)
xs (second bindings)]
(list 'when-let [(first bindings) (list 'seq (second bindings))]
(list* 'let [(first bindings) (list 'first (first bindings))]
body))))
(defmacro bound-fn
"Returns a function defined by the given fntail, which will preserve the
current values of all thread-local bindings when called."
[& fntail]
(list 'bound-fn* (cons 'fn fntail)))
(defmacro cond->
"Takes an expression and a set of test/form pairs. Threads expr (via ->)
through each form for which the corresponding test expression is
logical true."
[expr & clauses]
(let [g (gensym)
steps (map (fn [[test step]] (list (quote if) test (list (quote ->) g step) g))
(partition 2 clauses))]
(list (quote let) (into [g expr] (interleave (repeat g) (butlast steps)))
(if (empty? steps) g (last steps)))))
(defmacro cond->>
"Takes an expression and a set of test/form pairs. Threads expr (via ->>)
through each form for which the corresponding test expression is
logical true."
[expr & clauses]
(let [g (gensym)
steps (map (fn [[test step]] (list (quote if) test (list (quote ->>) g step) g))
(partition 2 clauses))]
(list (quote let) (into [g expr] (interleave (repeat g) (butlast steps)))
(if (empty? steps)
g
(last steps)))))
(defmacro some->
"Threads expr through the forms (via ->), stopping and returning nil as
soon as a form returns nil."
[expr & forms]
(let [g (gensym)
steps (map (fn [step] (list (quote if) (list (quote nil?) g) nil (list (quote ->) g step)))
forms)]
(list (quote let) (into [g expr] (interleave (repeat g) (butlast steps)))
(if (empty? steps) g (last steps)))))
(defmacro some->>
"Threads expr through the forms (via ->>), stopping and returning nil as
soon as a form returns nil."
[expr & forms]
(let [g (gensym)
steps (map (fn [step] (list (quote if) (list (quote nil?) g) nil (list (quote ->>) g step)))
forms)]
(list (quote let) (into [g expr] (interleave (repeat g) (butlast steps)))
(if (empty? steps) g (last steps)))))
(defn re-seq
"Returns a lazy sequence of successive matches of pattern in string."
[re s]
(let [matcher (re-matcher re s)]
(seq (take-while identity (repeatedly #(re-find matcher))))))
(defmacro doc
"Returns the docstring of the given symbol (a var, macro, or special
form), or nil if it has none or doesn't resolve. See also `doc-data`,
which returns the docstring alongside the arglists."
[sym]
`(try
(:doc (doc-data (var ~sym)))
(catch Exception e# nil)))