(defn identity [x] x)
(defn constantly [x] (fn [& _] x))
(defn complement [f] (fn [& args] (not (apply f args))))
(defn some-fn
([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
([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= [& args] (not (apply = args)))
(defn comp
([] identity)
([f] f)
([f g] (fn [& args] (f (apply g args))))
([f g & more]
(reduce comp (cons f (cons g more)))))
(defn partial [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
([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
([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))
(seq acc)))))
(defn remove
([pred] (filter (complement pred)))
([pred coll] (filter (complement pred) coll)))
(defn keep
([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))))
(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
([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 take
([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
([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
([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
([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 [coll]
(loop [s (seq coll)]
(when s (recur (next s)))))
(defn doall [coll]
(dorun coll)
coll)
(defn some [pred coll]
(loop [s (seq coll)]
(when s
(let [v (pred (first s))]
(if v v (recur (next s)))))))
(defn every? [pred coll]
(loop [s (seq coll)]
(if s
(if (pred (first s))
(recur (next s))
false)
true)))
(defn not-any? [pred coll] (not (some pred coll)))
(defn not-every? [pred coll] (not (every? pred coll)))
(defn mapv [f coll] (vec (map f coll)))
(defn filterv [pred coll] (vec (filter pred coll)))
(defn swap! [a f & args] (reset! a (apply f (deref a) args)))
(defmacro when [test & body]
(list 'if test (cons 'do body) nil))
(defmacro when-not [test & body]
(list 'if test nil (cons 'do body)))
(defmacro if-let
([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 & body]
(list 'if-let bindings (cons 'do body)))
(defmacro cond [& 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 [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 [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 ->
([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 ->>
([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->
[expr name & forms]
(list 'let (vector name expr)
(if (seq forms)
(list* 'as-> name forms)
name)))
(defmacro doto [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 & 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 & 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 [binding & body]
(let [x (first binding)
coll (second binding)]
(list 'map (list 'fn (vector x) (cons 'do body)) coll)))
(defn second [coll] (first (rest coll)))
(defn third [coll] (first (rest (rest coll))))
(defn ffirst [coll] (first (first coll)))
(defn nfirst [coll] (next (first coll)))
(defn fnext [coll] (first (next coll)))
(defn nnext [coll] (next (next coll)))
(defn nthnext [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 [coll]
(loop [s (seq coll) acc []]
(if (next s)
(recur (next s) (conj acc (first s)))
(seq acc))))
(defn drop-last
([coll] (drop-last 1 coll))
([n coll]
(let [s (seq coll)]
(if s
(take (- (count s) n) s)
'()))))
(defn take-last [n coll]
(let [s (seq coll)]
(loop [s s lead (nthnext s n)]
(if lead
(recur (next s) (next lead))
s))))
(defmacro lazy-seq [& body]
(list 'make-lazy-seq (list 'fn [] (cons 'do body))))
(defn iterate [f x]
(cons x (lazy-seq (iterate f (f x)))))
(defn repeat
([x] (lazy-seq (cons x (repeat x))))
([n x] (take n (repeat x))))
(defn repeatedly
([f] (lazy-seq (cons (f) (repeatedly f))))
([n f] (take n (repeatedly f))))
(defn range
([] (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 [coll]
(letfn [(c [s]
(lazy-seq
(if (seq s)
(cons (first s) (c (rest s)))
(c coll))))]
(when (seq coll) (c coll))))
(defn counted? [x] (or (vector? x) (map? x) (set? x) (seq? x)))
(defn reversible? [x] (or (vector? x) (sorted-map? x) (sorted-set? x)))
(defn sequential? [x] (or (seq? x) (vector? x)))
(defn associative? [x] (or (map? x) (vector? x)))
;; meta and vary-meta are native builtins (see builtins.rs)
(defn seqable? [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 [n coll]
[(take n coll) (drop n coll)])
(defn split-with [pred coll]
[(take-while pred coll) (drop-while pred coll)])
(defn partition [n coll]
(loop [s (seq coll) acc []]
(if s
(let [part (take n s)]
(if (= (count part) n)
(recur (nthnext s n) (conj acc part))
(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 [x]
(if (coll? x)
(mapcat flatten x)
(list x)))
(defn distinct
([]
(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 [& args] (reduce (fn [a b]
(cond
(NaN? a) a
(NaN? b) b
(>= a b) a
:else b))
args))
(defn min [& args] (reduce (fn [a b]
(cond
(NaN? a) a
(NaN? b) b
(<= a b) a
:else b))
args))
(defmacro assert [test & args]
(let [msg (first args)]
(list 'when (list 'not test)
(list 'throw (list 'ex-info (or msg "assertion failed") {})))))
(defn frequencies [coll]
(reduce (fn [m v] (assoc m v (inc (get m v 0)))) {} coll))
(defn group-by [f coll]
(reduce (fn [m v]
(let [k (f v)]
(assoc m k (conj (get m k []) v))))
{} coll))
(defn index-of [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 [m k f & args]
(assoc m k (apply f (get m k) args)))
(defn update-in [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 [& fns]
(fn [& args] (mapv (fn [f] (apply f args)) fns)))
(defn fnil [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 [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 [] "cljx-0.1.0")
;; ── Phase 7: Concurrency primitives ──────────────────────────────────────────
(defmacro delay [& body]
(list 'make-delay (list 'fn [] (cons 'do body))))
(defn future? [x] (= (type x) 'Future))
(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 future
[& body]
(list 'future-call* (list 'fn [] (cons 'do body)) []))
(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?
[v]
(and (or (keyword? v) (symbol? v)) (nil? (namespace v))))
(defn qualified-ident?
[v]
(and (or (keyword? v) (symbol? v)) (not (nil? (namespace v)))))
(defn key
[x]
(if (and (vector? x) (= 2 (count x)))
(first x)
(throw (ex-info "not a map entry" {}))))
(defn val
[x]
(if (and (vector? x) (= 2 (count x)))
(second x)
(throw (ex-info "not a map entry" {}))))
(defn inc'
[x]
(+' x 1))
(defn dec'
[x]
(+' x -1))
(defn ident? [x] (or (symbol? x) (keyword? x)))
(defn rand-nth
[coll]
(let [n (rand-int (count coll))]
(nth coll n)))
(defmacro when-first
[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
[& fntail]
(list 'bound-fn* (cons 'fn fntail)))
(defmacro cond->
[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->>
[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)))))
(defn re-seq
[re s]
(let [matcher (re-matcher re s)]
))