conjure-js 0.0.11 → 0.0.13

package/src/clojure/core.clj

@@ -1,14 +1,32 @@
 (ns clojure.core)
 
+;; Host shims, for autocomplete only
+(def all)
+(def async)
+(def catch*)
+(def then)
+
 (defmacro defn [name & fdecl]
   (let [doc       (if (string? (first fdecl)) (first fdecl) nil)
         rest-decl (if doc (rest fdecl) fdecl)
         arglists  (if (vector? (first rest-decl))
                     (vector (first rest-decl))
-                    (reduce (fn [acc arity] (conj acc (first arity))) [] rest-decl))]
-    (if doc
-      `(def ~name (with-meta (fn ~@rest-decl) {:doc ~doc :arglists '~arglists}))
-      `(def ~name (with-meta (fn ~@rest-decl) {:arglists '~arglists})))))
+                    (reduce (fn [acc arity] (conj acc (first arity))) [] rest-decl))
+        meta-map  (let [m (if doc {:doc doc :arglists arglists} {:arglists arglists})]
+                    (if (:private (meta name)) (assoc m :private true) m))]
+    `(def ~(with-meta name meta-map) (fn ~@rest-decl))))
+
+(defmacro defn-
+  "Same as defn, but marks the var as private."
+  [name & fdecl]
+  (list* 'defn (with-meta name (assoc (meta name) :private true)) fdecl))
+
+
+(defn vary-meta
+  "Returns an object of the same type and value as obj, with
+  (apply f (meta obj) args) as its metadata."
+  [obj f & args]
+  (with-meta obj (apply f (meta obj) args)))
 
 (defn next
   "Returns a seq of the items after the first. Calls seq on its
@@ -26,10 +44,14 @@
   (first (next coll)))
 
 
-(defmacro when [condition & body]
+(defmacro when
+  "Executes body when condition is true, otherwise returns nil."
+  [condition & body]
   `(if ~condition (do ~@body) nil))
 
-(defmacro when-not [condition & body]
+(defmacro when-not
+  "Executes body when condition is false, otherwise returns nil."
+  [condition & body]
   `(if ~condition nil (do ~@body)))
 
 (defmacro if-let
@@ -90,9 +112,67 @@
       `(->> ~threaded ~@more))))
 
 (defmacro comment
-  ; Ignores body, yields nil
+  "Ignores body, yields nil"
   [& body])
 
+(defmacro as->
+  [expr name & forms]
+  `(let [~name ~expr
+         ~@(reduce (fn [acc form] (conj acc name form)) [] forms)]
+     ~name))
+
+(defmacro cond->
+  [expr & clauses]
+  (let [g (gensym "cv")
+        steps (reduce
+               (fn [acc pair]
+                 (let [test (first pair)
+                       form (second pair)
+                       threaded (if (list? form)
+                                  `(~(first form) ~g ~@(rest form))
+                                  `(~form ~g))]
+                   (conj acc `(if ~test ~threaded ~g))))
+               []
+               (partition-all 2 clauses))]
+    `(let [~g ~expr
+           ~@(reduce (fn [acc step] (conj acc g step)) [] steps)]
+       ~g)))
+
+(defmacro cond->>
+  [expr & clauses]
+  (let [g (gensym "cv")
+        steps (reduce
+               (fn [acc pair]
+                 (let [test (first pair)
+                       form (second pair)
+                       threaded (if (list? form)
+                                  `(~(first form) ~@(rest form) ~g)
+                                  `(~form ~g))]
+                   (conj acc `(if ~test ~threaded ~g))))
+               []
+               (partition-all 2 clauses))]
+    `(let [~g ~expr
+           ~@(reduce (fn [acc step] (conj acc g step)) [] steps)]
+       ~g)))
+
+(defmacro some->
+  [expr & forms]
+  (if (nil? forms)
+    expr
+    `(let [v# ~expr]
+       (if (nil? v#)
+         nil
+         (some-> (-> v# ~(first forms)) ~@(rest forms))))))
+
+(defmacro some->>
+  [expr & forms]
+  (if (nil? forms)
+    expr
+    `(let [v# ~expr]
+       (if (nil? v#)
+         nil
+         (some->> (->> v# ~(first forms)) ~@(rest forms))))))
+
 (defn constantly
   "Returns a function that takes any number of arguments and returns x."
   [x] (fn [& _] x))
@@ -390,7 +470,9 @@
        ([result] (rf result))
        ([result input] (rf result (f input))))))
   ([f coll]
-   (sequence (map f) coll))
+   (lazy-seq
+     (when-let [s (seq coll)]
+       (cons (f (first s)) (map f (rest s))))))
   ([f c1 c2]
    (loop [s1 (seq c1)
           s2 (seq c2)
@@ -423,7 +505,11 @@
           (rf result input)
           result)))))
   ([pred coll]
-   (sequence (filter pred) coll)))
+   (lazy-seq
+     (when-let [s (seq coll)]
+       (if (pred (first s))
+         (cons (first s) (filter pred (rest s)))
+         (filter pred (rest s)))))))
 
 (defn remove
   "Returns a lazy sequence of the items in coll for which
@@ -457,7 +543,10 @@
               (ensure-reduced result)
               result)))))))
   ([n coll]
-   (sequence (take n) coll)))
+   (lazy-seq
+     (when (pos? n)
+       (when-let [s (seq coll)]
+         (cons (first s) (take (dec n) (rest s))))))))
 
 ;; take-while: stateless transducer; emits reduced when pred fails
 (defn take-while
@@ -474,7 +563,10 @@
           (rf result input)
           (reduced result))))))
   ([pred coll]
-   (sequence (take-while pred) coll)))
+   (lazy-seq
+     (when-let [s (seq coll)]
+       (when (pred (first s))
+         (cons (first s) (take-while pred (rest s))))))))
 
 ;; drop: stateful transducer; skips first n items
 ;; r >= 0 → still skipping; r < 0 → past the drop zone, start taking
@@ -494,7 +586,9 @@
               result
               (rf result input))))))))
   ([n coll]
-   (sequence (drop n) coll)))
+   (if (pos? n)
+     (lazy-seq (drop (dec n) (rest coll)))
+     (lazy-seq (seq coll)))))
 
 (defn drop-last
   "Return a sequence of all but the last n (default 1) items in coll"
@@ -528,7 +622,11 @@
               (vreset! dropping false)
               (rf result input))))))))
   ([pred coll]
-   (sequence (drop-while pred) coll)))
+   (lazy-seq
+     (let [s (seq coll)]
+       (if (and s (pred (first s)))
+         (drop-while pred (rest s))
+         s)))))
 
 ;; map-indexed: stateful transducer; passes index and item to f
 (defn map-indexed
@@ -546,7 +644,11 @@
          ([result input]
           (rf result (f (vswap! i inc) input)))))))
   ([f coll]
-   (sequence (map-indexed f) coll)))
+   (letfn [(step [i s]
+             (lazy-seq
+               (when-let [xs (seq s)]
+                 (cons (f i (first xs)) (step (inc i) (rest xs))))))]
+     (step 0 coll))))
 
 ;; dedupe: stateful transducer; removes consecutive duplicates
 (defn dedupe
@@ -598,23 +700,656 @@
 ;; ── Documentation ────────────────────────────────────────────────────────────
 
 (defmacro doc [sym]
-  `(let [v#        ~sym
+  `(let [v#        (var ~sym)
          m#        (meta v#)
          d#        (:doc m#)
          args#     (:arglists m#)
          args-str# (when args#
-                     (reduce
-                      (fn [acc# a#]
-                        (if (= acc# "")
-                          (str "(" a# ")")
-                          (str acc# "\n" "(" a# ")")))
-                      ""
-                      args#))]
-     (println (str (if args-str# (str args-str# "\n\n") "")
-                   (or d# "No documentation available.")))))
-
-(defn err
+                     (str "("
+                          (reduce
+                           (fn [acc# a#]
+                             (if (= acc# "")
+                               (str a#)
+                               (str acc# " \n " a#)))
+                           ""
+                           args#)
+                          ")"))]
+     (println (str "-------------------------\n"
+                   ~(str sym) "\n"
+                   (if args-str# (str args-str# "\n") "")
+                   "  " (or d# "No documentation available.")))))
+
+(defn make-err
   "Creates an error map with type, message, data and optionally cause"
-  ([type message] (err type message nil nil))
-  ([type message data] (err type message data nil))
-  ([type message data cause] {:type type :message message :data data :cause cause}))
+  ([type message] (make-err type message nil nil))
+  ([type message data] (make-err type message data nil))
+  ([type message data cause] {:type type :message message :data data :cause cause}))
+
+;; ── Sequence utilities ──────────────────────────────────────────────────────
+
+(defn butlast
+  "Return a seq of all but the last item in coll, in linear time"
+  [coll]
+  (loop [ret [] s (seq coll)]
+    (if (next s)
+      (recur (conj ret (first s)) (next s))
+      (seq ret))))
+
+(defn fnext
+  "Same as (first (next x))"
+  [x] (first (next x)))
+
+(defn nfirst
+  "Same as (next (first x))"
+  [x] (next (first x)))
+
+(defn nnext
+  "Same as (next (next x))"
+  [x] (next (next x)))
+
+(defn nthrest
+  "Returns the nth rest of coll, coll when n is 0."
+  [coll n]
+  (loop [n n xs coll]
+    (if (and (pos? n) (seq xs))
+      (recur (dec n) (rest xs))
+      xs)))
+
+(defn nthnext
+  "Returns the nth next of coll, (seq coll) when n is 0."
+  [coll n]
+  (loop [n n xs (seq coll)]
+    (if (and (pos? n) xs)
+      (recur (dec n) (next xs))
+      xs)))
+
+(defn list*
+  "Creates a new seq containing the items prepended to the rest, the
+  last of which will be treated as a sequence."
+  ([args] (seq args))
+  ([a args] (cons a args))
+  ([a b args] (cons a (cons b args)))
+  ([a b c args] (cons a (cons b (cons c args))))
+  ([a b c d & more]
+   (cons a (cons b (cons c (apply list* d more))))))
+
+(defn mapv
+  "Returns a vector consisting of the result of applying f to the
+  set of first items of each coll, followed by applying f to the set
+  of second items in each coll, until any one of the colls is exhausted."
+  ([f coll] (into [] (map f) coll))
+  ([f c1 c2] (into [] (map f c1 c2)))
+  ([f c1 c2 c3] (into [] (map f c1 c2 c3)))
+  ([f c1 c2 c3 & colls] (into [] (apply map f c1 c2 c3 colls))))
+
+(defn filterv
+  "Returns a vector of the items in coll for which
+  (pred item) returns logical true."
+  [pred coll]
+  (into [] (filter pred) coll))
+
+(defn run!
+  "Runs the supplied procedure (via reduce), for purposes of side
+  effects, on successive items in the collection. Returns nil."
+  [proc coll]
+  (reduce (fn [_ x] (proc x) nil) nil coll))
+
+(defn keep
+  "Returns a sequence of the non-nil results of (f item). Note,
+  this means false return values will be included.  f must be free of
+  side-effects.  Returns a transducer when no collection is provided."
+  ([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)]
+       (let [v (f (first s))]
+         (if (nil? v)
+           (keep f (rest s))
+           (cons v (keep f (rest s)))))))))
+
+(defn keep-indexed
+  "Returns a sequence of the non-nil results of (f index item). Note,
+  this means false return values will be included.  f must be free of
+  side-effects.  Returns a stateful transducer when no collection is provided."
+  ([f]
+   (fn [rf]
+     (let [i (volatile! -1)]
+       (fn
+         ([] (rf))
+         ([result] (rf result))
+         ([result input]
+          (let [v (f (vswap! i inc) input)]
+            (if (nil? v)
+              result
+              (rf result v))))))))
+  ([f coll]
+   (letfn [(step [i s]
+             (lazy-seq
+               (when-let [xs (seq s)]
+                 (let [v (f i (first xs))]
+                   (if (nil? v)
+                     (step (inc i) (rest xs))
+                     (cons v (step (inc i) (rest xs))))))))]
+     (step 0 coll))))
+
+(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. Returns
+  a transducer when no collections are provided."
+  ([f]
+   (fn [rf]
+     (let [inner ((map f) (fn
+                            ([] (rf))
+                            ([result] (rf result))
+                            ([result input]
+                             (reduce rf result input))))]
+       inner)))
+  ([f coll]
+   (lazy-seq
+     (when-let [s (seq coll)]
+       (concat (f (first s)) (mapcat f (rest s))))))
+  ([f coll & more]
+   (apply concat (apply map f coll more))))
+
+(defn interleave
+  "Returns a lazy sequence of the first item in each coll, then the second etc.
+  Stops as soon as any coll is exhausted."
+  ([c1 c2]
+   (lazy-seq
+     (let [s1 (seq c1) s2 (seq c2)]
+       (when (and s1 s2)
+         (cons (first s1) (cons (first s2) (interleave (rest s1) (rest s2))))))))
+  ([c1 c2 & colls]
+   (lazy-seq
+     (let [seqs (map seq (cons c1 (cons c2 colls)))]
+       (when (every? some? seqs)
+         (concat (map first seqs) (apply interleave (map rest seqs))))))))
+
+(defn interpose
+  "Returns a 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]
+   (drop 1 (interleave (repeat sep) coll))))
+
+;; ── Lazy concat (shadows native eager concat) ──────────────────────────────
+(defn concat
+  "Returns a lazy seq representing the concatenation of the elements in the
+  supplied colls."
+  ([] nil)
+  ([x] (lazy-seq (seq x)))
+  ([x y]
+   (lazy-seq
+     (let [s (seq x)]
+       (if s
+         (cons (first s) (concat (rest s) y))
+         (seq y)))))
+  ([x y & zs]
+   (let [cat (fn cat [xy zs]
+               (lazy-seq
+                 (let [xys (seq xy)]
+                   (if xys
+                     (cons (first xys) (cat (rest xys) zs))
+                     (when (seq zs)
+                       (cat (first zs) (next zs)))))))]
+     (cat (concat x y) zs))))
+
+(defn iterate
+  "Returns a lazy sequence of x, (f x), (f (f x)) etc.
+  With 3 args, returns a finite sequence of n items (backwards compat)."
+  ([f x]
+   (lazy-seq (cons x (iterate f (f x)))))
+  ([f x n]
+   (loop [i 0 v x acc []]
+     (if (< i n)
+       (recur (inc i) (f v) (conj acc v))
+       acc))))
+
+(defn repeatedly
+  "Takes a function of no args, presumably with side effects, and
+  returns a lazy infinite sequence of calls to it.
+  With 2 args (n f), returns a finite sequence of n calls."
+  ([f] (lazy-seq (cons (f) (repeatedly f))))
+  ([n f]
+   (loop [i 0 acc []]
+     (if (< i n)
+       (recur (inc i) (conj acc (f)))
+       acc))))
+
+(defn cycle
+  "Returns a lazy infinite sequence of repetitions of the items in coll.
+  With 2 args (n coll), returns a finite sequence (backwards compat)."
+  ([coll]
+   (lazy-seq
+     (when (seq coll)
+       (concat coll (cycle coll)))))
+  ([n coll]
+   (let [s (into [] coll)]
+     (loop [i 0 acc []]
+       (if (< i n)
+         (recur (inc i) (into acc s))
+         acc)))))
+
+(defn repeat
+  "Returns a lazy infinite sequence of xs.
+  With 2 args (n x), returns a finite sequence of n copies."
+  ([x] (lazy-seq (cons x (repeat x))))
+  ([n x] (repeat* n x)))
+
+(defn range
+  "Returns a lazy infinite sequence of integers from 0.
+  With args, returns a finite sequence (delegates to native range*)."
+  ([] (iterate inc 0))
+  ([end] (range* end))
+  ([start end] (range* start end))
+  ([start end step] (range* start end step)))
+
+(defn newline
+  "Writes a newline to *out*."
+  [] (println ""))
+
+(defn dorun
+  "Forces realization of a (possibly lazy) sequence. Walks the sequence
+  without retaining the head. Returns nil."
+  [coll]
+  (when (seq coll)
+    (recur (rest coll))))
+
+(defn doall
+  "Forces realization of a (possibly lazy) sequence. Unlike dorun,
+  retains the head and returns the seq."
+  [coll]
+  (dorun coll)
+  coll)
+
+(defn take-nth
+  "Returns a sequence of every nth item in coll.  Returns a stateful
+  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? (mod idx n))
+              (rf result input)
+              result)))))))
+  ([n coll]
+   (sequence (take-nth n) coll)))
+
+(defn partition
+  "Returns a sequence of lists of n items each, at offsets step
+  apart. If step is not supplied, defaults to n, i.e. the partitions
+  do not overlap. If a pad collection is supplied, use its elements as
+  necessary to complete last partition up to n items. In case there are
+  not enough padding elements, return a partition with less than n items."
+  ([n coll] (partition n n coll))
+  ([n step coll]
+   (loop [s (seq coll) acc []]
+     (if (nil? s)
+       acc
+       (let [p (into [] (take n) s)]
+         (if (< (count p) n)
+           acc
+           (recur (seq (drop step s)) (conj acc p)))))))
+  ([n step pad coll]
+   (loop [s (seq coll) acc []]
+     (if (nil? s)
+       acc
+       (let [p (into [] (take n) s)]
+         (if (< (count p) n)
+           (conj acc (into [] (take n) (concat p pad)))
+           (recur (seq (drop step s)) (conj acc p))))))))
+
+(defn partition-by
+  "Applies f to each value in coll, splitting it each time f returns a
+  new value.  Returns a sequence of partitions.  Returns a stateful
+  transducer when no collection is provided."
+  ([f]
+   (fn [rf]
+     (let [pv (volatile! ::none)
+           buf (volatile! [])]
+       (fn
+         ([] (rf))
+         ([result]
+          (let [b @buf]
+            (vreset! buf [])
+            (if (empty? b)
+              (rf result)
+              (rf (unreduced (rf result b))))))
+         ([result input]
+          (let [v (f input)
+                p @pv]
+            (vreset! pv v)
+            (if (or (= p ::none) (= v p))
+              (do (vswap! buf conj input) result)
+              (let [b @buf]
+                (vreset! buf [input])
+                (rf result b)))))))))
+  ([f coll]
+   (lazy-seq
+     (when-let [s (seq coll)]
+       (let [fv        (f (first s))
+             run       (into [] (cons (first s) (take-while #(= (f %) fv) (next s))))
+             remaining (drop-while #(= (f %) fv) (next s))]
+         (cons run (partition-by f remaining)))))))
+
+(defn reductions
+  "Returns a sequence of the intermediate values of the reduction (as
+  by reduce) of coll by f, starting with init."
+  ([f coll]
+   (if (empty? coll)
+     (list (f))
+     (reductions f (first coll) (rest coll))))
+  ([f init coll]
+   (loop [acc [init] val init s (seq coll)]
+     (if (nil? s)
+       acc
+       (let [nval (f val (first s))]
+         (if (reduced? nval)
+           (conj acc (unreduced nval))
+           (recur (conj acc nval) nval (next s))))))))
+
+(defn split-at
+  "Returns a vector of [(take n coll) (drop n coll)]"
+  [n coll]
+  [(into [] (take n) coll) (into [] (drop n) coll)])
+
+(defn split-with
+  "Returns a vector of [(take-while pred coll) (drop-while pred coll)]"
+  [pred coll]
+  [(into [] (take-while pred) coll) (into [] (drop-while pred) coll)])
+
+(defn merge-with
+  "Returns a map that consists of the rest of the maps conj-ed onto
+  the first.  If a key occurs in more than one map, the mapping(s)
+  from the latter (left-to-right) will be combined with the mapping in
+  the result by calling (f val-in-result val-in-latter)."
+  [f & maps]
+  (reduce
+   (fn [acc m]
+     (if (nil? m)
+       acc
+       (reduce
+        (fn [macc entry]
+          (let [k (first entry)
+                v (second entry)]
+            (if (contains? macc k)
+              (assoc macc k (f (get macc k) v))
+              (assoc macc k v))))
+        (or acc {})
+        m)))
+   nil
+   maps))
+
+(defn update-keys
+  "m f => apply f to each key in m"
+  [m f]
+  (reduce
+   (fn [acc entry]
+     (assoc acc (f (first entry)) (second entry)))
+   {}
+   m))
+
+(defn update-vals
+  "m f => apply f to each val in m"
+  [m f]
+  (reduce
+   (fn [acc entry]
+     (assoc acc (first entry) (f (second entry))))
+   {}
+   m))
+
+(defn not-empty
+  "If coll is empty, returns nil, else coll"
+  [coll]
+  (when (seq coll) coll))
+
+(defn memoize
+  "Returns a memoized version of a referentially transparent function. The
+  memoized version of the function keeps a cache of the mapping from arguments
+  to results and, when calls with the same arguments are repeated often, has
+  higher performance at the expense of higher memory use."
+  [f]
+  (let [mem (atom {})]
+    (fn [& args]
+      (let [cached (get @mem args ::not-found)]
+        (if (= cached ::not-found)
+          (let [ret (apply f args)]
+            (swap! mem assoc args ret)
+            ret)
+          cached)))))
+
+(defn trampoline
+  "trampoline can be used to convert algorithms requiring mutual
+  recursion without stack consumption. Calls f with supplied args, if
+  any. If f returns a fn, calls that fn with no arguments, and
+  continues to repeat, until the return value is not a fn, then
+  returns that non-fn value."
+  ([f]
+   (loop [ret (f)]
+     (if (fn? ret)
+       (recur (ret))
+       ret)))
+  ([f & args]
+   (loop [ret (apply f args)]
+     (if (fn? ret)
+       (recur (ret))
+       ret))))
+
+(defmacro with-redefs
+  "binding => var-symbol temp-value-expr
+  Temporarily redefines Vars while executing the body. The
+  temp-value-exprs will be evaluated and each resulting value will
+  replace in parallel the root value of its Var. Always restores
+  the original values, even if body throws."
+  [bindings & body]
+  (let [pairs     (partition 2 bindings)
+        names     (mapv first pairs)
+        new-vals  (mapv second pairs)
+        orig-syms (mapv (fn [_] (gensym "orig")) names)]
+    `(let [~@(interleave orig-syms (map (fn [n] `(var-get (var ~n))) names))]
+       (try
+         (do ~@(map (fn [n v] `(alter-var-root (var ~n) (constantly ~v))) names new-vals)
+             ~@body)
+         (finally
+           ~@(map (fn [n o] `(alter-var-root (var ~n) (constantly ~o))) names orig-syms))))))
+
+;; ── Macros: conditionals and control flow ───────────────────────────────────
+
+(defmacro if-some
+  "bindings => binding-form test
+  If test is not nil, evaluates then with binding-form bound to the
+  value of test, if not, yields else"
+  ([bindings then] `(if-some ~bindings ~then nil))
+  ([bindings then else]
+   (let [form (first bindings)
+         tst  (second bindings)]
+     `(let [temp# ~tst]
+        (if (nil? temp#)
+          ~else
+          (let [~form temp#]
+            ~then))))))
+
+(defmacro when-some
+  "bindings => binding-form test
+  When test is not nil, evaluates body with binding-form bound to the
+  value of test"
+  [bindings & body]
+  (let [form (first bindings)
+        tst  (second bindings)]
+    `(let [temp# ~tst]
+       (when (some? temp#)
+         (let [~form temp#]
+           ~@body)))))
+
+(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)]
+    `(let [temp# (seq ~xs)]
+       (when temp#
+         (let [~x (first temp#)]
+           ~@body)))))
+
+(defn condp-emit [gpred gexpr clauses]
+  (if (nil? clauses)
+    `(throw (ex-info (str "No matching clause: " ~gexpr) {}))
+    (if (nil? (next clauses))
+      (first clauses)
+      `(if (~gpred ~(first clauses) ~gexpr)
+         ~(second clauses)
+         ~(condp-emit gpred gexpr (next (next clauses)))))))
+
+(defmacro condp
+  "Takes a binary predicate, an expression, and a set of clauses.
+  Each clause can take the form of either:
+    test-expr result-expr
+  The predicate is applied to each test-expr and the expression in turn."
+  [pred expr & clauses]
+  (let [gpred (gensym "pred__")
+        gexpr (gensym "expr__")]
+    `(let [~gpred ~pred
+           ~gexpr ~expr]
+       ~(condp-emit gpred gexpr clauses))))
+
+(defn case-emit [ge clauses]
+  (if (nil? clauses)
+    `(throw (ex-info (str "No matching clause: " ~ge) {}))
+    (if (nil? (next clauses))
+      (first clauses)
+      `(if (= ~ge ~(first clauses))
+         ~(second clauses)
+         ~(case-emit ge (next (next clauses)))))))
+
+(defmacro case
+  "Takes an expression, and a set of clauses. Each clause can take the form of
+  either:
+    test-constant result-expr
+  If no clause matches, and there is an odd number of forms (a default), the
+  last expression is returned."
+  [e & clauses]
+  (let [ge (gensym "case__")]
+    `(let [~ge ~e]
+       ~(case-emit ge clauses))))
+
+(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)]
+    `(let [n# ~n]
+       (loop [~i 0]
+         (when (< ~i n#)
+           ~@body
+           (recur (inc ~i)))))))
+
+(defmacro while
+  "Repeatedly executes body while test expression is true. Presumes
+  some side-effect will cause test to become false/nil."
+  [test & body]
+  `(loop []
+     (when ~test
+       ~@body
+       (recur))))
+
+(defmacro doseq
+  "Repeatedly executes body (presumably for side-effects) with
+  bindings. Supports :let, :when, and :while modifiers."
+  [seq-exprs & body]
+  (let [bindings (partition 2 seq-exprs)
+        first-binding (first bindings)
+        rest-bindings (next bindings)]
+    (if (nil? first-binding)
+      `(do ~@body nil)
+      (let [k (first first-binding)
+            v (second first-binding)]
+        (cond
+          (= k :let)
+          `(let ~v (doseq ~(apply concat rest-bindings) ~@body))
+
+          (= k :when)
+          `(when ~v (doseq ~(apply concat rest-bindings) ~@body))
+
+          (= k :while)
+          `(if ~v (doseq ~(apply concat rest-bindings) ~@body) nil)
+
+          :else
+          (if rest-bindings
+            `(run! (fn [~k] (doseq ~(apply concat rest-bindings) ~@body)) ~v)
+            `(run! (fn [~k] ~@body) ~v)))))))
+
+(defmacro for
+  "List comprehension. Takes a vector of one or more
+  binding-form/collection-expr pairs, each followed by zero or more
+  modifiers, and yields a sequence of evaluations of expr.
+  Supported modifiers: :let, :when, :while."
+  [seq-exprs & body]
+  (let [bindings (partition 2 seq-exprs)
+        first-binding (first bindings)
+        rest-bindings (next bindings)]
+    (if (nil? first-binding)
+      `(list ~@body)
+      (let [k (first first-binding)
+            v (second first-binding)]
+        (cond
+          (= k :let)
+          `(let ~v (for ~(apply concat rest-bindings) ~@body))
+
+          (= k :when)
+          `(if ~v (for ~(apply concat rest-bindings) ~@body) (list))
+
+          (= k :while)
+          `(if ~v (for ~(apply concat rest-bindings) ~@body) (list))
+
+          :else
+          (if rest-bindings
+            `(mapcat (fn [~k] (for ~(apply concat rest-bindings) ~@body)) ~v)
+            `(map (fn [~k] ~@body) ~v)))))))
+
+(defmacro with-out-str
+  "Evaluates body in a context in which *out* is bound to a fresh string
+  accumulator. Returns the string of all output produced by println, print,
+  pr, prn, pprint and newline during the evaluation."
+  [& body]
+  `(let [buf# (atom "")]
+     (binding [*out* (fn [s#] (swap! buf# str s#))]
+       ~@body)
+     @buf#))
+
+(defmacro with-err-str
+  "Like with-out-str but captures *err* output (warn, etc.)."
+  [& body]
+  `(let [buf# (atom "")]
+     (binding [*err* (fn [s#] (swap! buf# str s#))]
+       ~@body)
+     @buf#))