Bonus material for the "Rewriting the Technical Interview" story

class.clj

(ns scratch.object.class
  "This namespace defines a basic framework for class-based object-oriented
  programming, including classes, instances, fields, methods, single
  inheritance, and multiple inheritance through abstract classes."
  (:refer-clojure :exclude [class])
  (:require [clojure [core :as c]
                     [pprint :refer [pprint]]
                     [set :as set]
                     [string :as str]
                     [walk :as walk]]
            [scratch.rewrite :as r :refer [rewrite]]))

;; OO syntax

(defn dot-sym
  "Returns the keyword :foo when given '.foo"
  [x]
  (when (and (symbol? x)
             (= \. (first (name x))))
    (keyword (subs (name x) 1))))

(defn sym-dot-sym
  "Returns the sequence '(foo .bar .baz) given .foo .bar .baz."
  [x]
  (when (symbol? x)
    (let [[sym & more] (remove #{""} (str/split (name x) #"\."))]
      (when more
        (cons (if (qualified-symbol? x)
                (symbol (namespace x) sym)
                (symbol sym))
              (map symbol (map (partial str ".") more)))))))

(defn plain-sym?
  "Is this a boring old symbol?"
  [x]
  (and (symbol? x)
       (not (dot-sym x))))

(def space
  "Having trouble fitting else if into nested branches? Try this SPECIAL SPACE
  [ ]"
  " ")

(defn spaced-sym
  "Splits up magic-spaced symbols into their parts."
  [x]
  (when (symbol? x)
    (let [parts (str/split (name x) (re-pattern space))]
      (when (< 1 (count parts))
        (map symbol parts)))))

(defmacro a
  "Takes an AST node name (e.g. ::method, ::field=) or a class, and generates a
  predicate function checking if a node is that kind of AST node."
  [node-type]
  (if (keyword? node-type)
    `(fn ~'a [term#]
       (and (vector? term#)
            (= ~node-type (first term#))))
    `(fn ~'a [term#]
       (instance? ~node-type term#))))

(defmacro either
  [& fs]
  (let [term (gensym 'term)]
    `(fn ~'or* [~term]
       (or ~@(map list fs (repeat term))))))

(declare call-method)
(declare get-field)
(declare set-field!)

(defrecord Cond   [branches])
(defrecord Elsif  [test body])
(defrecord FnCall [fun args])

(def infix (into '{%  mod
                   == =}
                 (map (juxt identity identity) '[< <= > >= + - / *])))

(defn sym++
  "Takes a symbol like i++ and returns 'i"
  [x]
  (when (symbol? x)
    (when-let [[_ v] (re-find #"(.+)\+\+$" (name x))]
      (symbol v))))

(def postfixes {"++" inc
                "--" dec})

(defn postfix-sym
  [x]
  (when (symbol? x)
    (when-let [p (first (filter (partial str/ends-with? (name x))
                                (keys postfixes)))]
      (list (postfixes p)
            (symbol (str/replace (name x) p ""))))))

(defn gen-for
  "Takes for expressions separated by a fake semicolon (;) and generates a
  loop/recur around them."
  [exprs body]
  (let [[[var _ init :as start] test change]
        (remove '#{(;)} (partition-by #{';} exprs))

        body (mapcat identity body)]
    ; (prn :start start :test test :change change)
    `(loop([~var ~init
            ret# nil]
       if (~@test) {
         recur(do(~@change), do(~@body))
       } ~'else {
         ~'return ret#
       }))))

(defn braces
  "Turns { x y z t } to `(do x y z t)"
  [m]
  (cons 'do (mapcat identity m)))

(defn do-one
  "Is this a (do x)?"
  [x]
  (when (and (seq? x)
             (= 'do (first x))
             (= 2 (count x)))
       (second x)))


(defmacro oo
  "This macro executes any number of expressions in our object-oriented
  paradigm. Expressions are resolved as Clojure, except we offer special syntax
  for getting fields and calling methods, as per transform-oo."
  [& exprs]
  (rewrite `(do ~@exprs)
           ; foo.bar.baz in seqs
           [sym-dot-sym s]              (sym-dot-sym s)
           ; foo.bar.baz alone
           (sym-dot-sym s)              `(do ~@(sym-dot-sym s))
           ; .method(a,b)
           [dot-sym method, seq? args]  [[::method (dot-sym method) args]]

           ; for (init, test, change) { ... }
           [#{'for} _, seq? expr, map? body] (gen-for expr body)

           ; Magic spaces
           [spaced-sym s] (spaced-sym s)

           ; else if (pred) { t }
           [#{'else} _, #{'if} _, seq? test, map? body]
           [(Elsif. `(do ~@test) (braces body))]
           ; if (pred) { t }
           [#{'if} _, seq? test, map? t] [(Cond. [`(do ~@test) (braces t)])]
           ; Cond Elsif
           [(a Cond) cond, (a Elsif) elsif]
           [(update cond :branches conj (:test elsif) (:body elsif))]
           ; Cond else { ... }
           [(a Cond) cond, #{'else} _, map? body]
           [(update cond :branches conj :else (braces body))]

           ; some_fun(a, b)
           [plain-sym? fun, seq? args]  [(FnCall. fun args)]

           ; .field =
           [dot-sym field, #{'=} _]     [[::field= (dot-sym field)]]
           ; .field
           [dot-sym field]              [[::field (dot-sym field)]]

           ; We want methods and fields to bind left-to-right, so they chain
           ; properly--and they *must* have equal binding precedence. We can't
           ; run these rules separately.
           [any? obj, (either (a ::field) (a ::method)) [type field args]]
           [(if (= ::field type)
             `(get-field ~obj ~field)
             `(call-method ~obj ~field ~@args))]

           ; ++
           [sym++ x] [`(inc ~(sym++ x))]

           ; Infix
           [any? a, infix f, any? b] [(FnCall. (infix f) [a b])]

           ; obj [:field= :bar] rhs
           [any? obj, (a ::field=) [_ field], any? rhs]
           [`(set-field! ~obj ~field ~rhs)]
           ; sym = rhs
           [plain-sym? var, #{'=} _, any? rhs, & more]
           [`(let [~var ~rhs] ~@more)]

           ; I *do* so love the ternary (NOT ACTUALLY A :)
           [any? test, #{'?} _, any? t, #{'∶} _, any? f] [`(if ~test ~t ~f)]

           ; Unwrap function calls
           ((a FnCall) fc) (cons (:fun fc) (:args fc))

           ; Unwrap Conds
           ((a Cond) c) `(cond ~@(:branches c))

           ; Strip return and fake semicolons (0x37e Greek Question Mark)
           ['#{return ;} _] nil
           ))

(pprint (macroexpand (quote (oo
  ;x = 1
  ;foo.bar
  ;dog.toys()
  ;dog.parts.mouth = dog.toys().ball
  ;prn()
  ;Person(1)
  ;my-count = count([1, dog.toys])
  ;println("Hi! My name is", name.str(),
  ;             "and my bestie is", bff.name.str())
  ;dog.cute() ? :yes ∶ :no
  ; if (test expr) { true branch } else { false branch }
  ;for (i = 1 ; i < 10 ; i++) {
  ;  println(i);
  ;}
  ;if (test) {
  ;  true branch
  ;} else if (test2) {
  ;  other branch
  ;} else {
  ;  final yay
  ;}
))))

;(pprint (oo
;  for (i = 1 ; i < 10 ; i++) {
;    println(i);
;    return [:got i];
;  }
;))

(pprint (macroexpand '(oo
  for (i = 1 ; i < 101 ; i++) {
    if (i % 15 == 0) {
      println("FizzBuzz");
    } else if (i % 3 == 0) {
      println("Fizz");
    } else if (i % 5 == 0) {
      println("Buzz");
    } else {
      println(i);
    };
  }
)))


;(assert false)

;; Algol-style

(defmacro algol
  "OO, mildly less terrifying"
  [& exprs]
  (rewrite `(do ~@exprs)
           ; for (init, test, change) { ... }
           [#{'for} _, seq? expr, map? body] (gen-for expr body)

           ; Magic spaces
           [spaced-sym s] (spaced-sym s)

           ; else if (pred) { t }
           [#{'else} _, #{'if} _, seq? test, map? body]
           [(Elsif. `(do ~@test) (braces body))]
           ; if (pred) { t }
           [#{'if} _, seq? test, map? t] [(Cond. [`(do ~@test) (braces t)])]
           ; Cond Elsif
           [(a Cond) cond, (a Elsif) elsif]
           [(update cond :branches conj (:test elsif) (:body elsif))]
           ; Cond else { ... }
           [(a Cond) cond, #{'else} _, map? body]
           [(update cond :branches conj :else (braces body))]

           ; some_fun(a, b)
           [symbol? fun, seq? args]  [(FnCall. fun args)]

           ; ++
           [sym++ x] [`(inc ~(sym++ x))]

           ; Infix
           [any? a, infix f, any? b] [(FnCall. (infix f) [a b])]

           ; sym = rhs
           [symbol? var, #{'=} _, any? rhs, & more]
           [`(let [~var ~rhs] ~@more)]

           ; I *do* so love the ternary (NOT ACTUALLY A :)
           [any? test, #{'?} _, any? t, #{'∶} _, any? f] [`(if ~test ~t ~f)]

           ; Unwrap function calls
           ((a FnCall) fc) (cons (:fun fc) (:args fc))

           ; Unwrap Conds
           ((a Cond) c) `(cond ~@(:branches c))

           ; Strip return and fake semicolons (0x37e Greek Question Mark)
           ['#{return ;} _] nil
           ))


;; Classes

(defn field-opts
  "Given a class and a field name, returns the options for that field."
  [class field]
  (let [field-opts (:field-opts class)]
    (assert (contains? (:field-opts class) field)
            (str "No such field " field " defined in class " (:name class)))
    (get field-opts field)))

(defn mutable?
  "Is the given field mutable?"
  [class field]
  (boolean (:mutable? (field-opts class field))))

(defn instance
  "Constructs an instance of a class. Takes the class as the first argument,
  and a map of field values as the second."
  [class fields]
  {:class   class
   :fields  (->> fields
                 (map (fn [[field value]]
                   ; Wrap mutable fields in atoms.
                   [field (if (mutable? class field)
                            (atom value)
                            value)]))
                 (into {}))})

; Hat tip to https://gist.github.com/devn/c52a7f5f7cdd45d772a9
(defn gen-nonvariadic-invokes [f]
  (for [arity (range 1 21),
        :let [args (repeatedly arity gensym)]]
    `(~'invoke [~@args] (~f ~@args))))

(defn gen-variadic-invoke [f]
  (let [args (repeatedly 22 gensym)]
    `(~'invoke [~@args] (apply ~f ~@args))))

(defn gen-apply-to [f]
  `(~'applyTo [this# args#] (apply ~f this# args#)))

(defn extend-IFn [f]
  `(clojure.lang.IFn
    ~@(gen-nonvariadic-invokes f)
    ~(gen-variadic-invoke f)
    ~(gen-apply-to f)))

(defmacro defrecordfn
  "Like defrecord, but accepts a function f before any specs that is
  used to implement clojure.lang.IFn.  f should accept at least one
  argument, 'this'."
  [name [& fields] f & opts+specs]
  `(defrecord ~name [~@fields]
     ~@(extend-IFn f)
     ~@opts+specs))

(defrecordfn Classy [name super fields field-opts methods]
  (fn constructor [this & args]
    (instance this (zipmap fields args)))

  Object
  (toString [this]
    (c/name name)))

(defn make-class
  "A *class* extends a superclass with a sequence of fields which each
  instance must have, a map of option maps for those fields, and a map of
  method names to functions implementing those methods. Keys in field maps are
  keywords, and their values are maps describing those fields, like {:mutable?
  true}. `nil` is a legal field map."
  [name super fields field-opts methods]
  (let [field-opts (merge (zipmap fields (repeat nil))
                          field-opts)]
    (Classy. name super fields field-opts methods)))

(def Top
  "This is the top-level class for all objects---including Clojure objects that
  don't participate in our little OO party."
  (make-class 'Top nil nil nil
              {:class   #(or (:class %) Top)
               :super   (fn [_] nil)
               :str     str
               :inspect pr-str
               :pp (fn [this]
                     (println (call-method this :inspect)))}))

(defn get-class
  "Returns the class of anything. If an object has a :class, uses that;
  otherwise, the class is Top."
  [x]
  (or (:class x) Top))

(defmacro class
  "Works as both defclass and get-class"
  ([instance]
   `(get-class ~instance))
  ([name & args]
   `(defclass ~name ~@args)))

(defn get-field
  "Gets the value of a field in the given object."
  [obj field-name]
  (if (mutable? (class obj) field-name)
    @(get (:fields obj) field-name)
    (get (:fields obj) field-name)))

(defn set-field!
  "Sets the value of a mutable field in the given object. Returns value."
  [obj field-name value]
  (assert (mutable? (class obj) field-name))
  (reset! (get (:fields obj) field-name) value)
  value)

(defn all-methods
  "Returns all methods available on an object, including via superclasses."
  [obj]
  (loop [methods #{}
         c       (class obj)]
    (if c
      (recur (into methods (keys (:methods c)))
             (:super c))
      methods)))

(defn resolve-method
  "Takes a class, and looks up the given method name on it, checking
  superclasses if necessary."
  [class method-name]
  (if-let [f (-> class :methods (get method-name))]
    f
    (when-let [super (:super class)]
      (resolve-method super method-name))))

(defn call-method-with-class
  "Takes a class, an object, and a method name. Looks up the corresponding
  method in this class (or superclasses) via resolve-method. Calls that method,
  providing the object as the first argument, and passing in any additional
  arguments thereafter."
  [class obj method-name args]
  (if-let [method (resolve-method class method-name)]
    (apply method obj args)
    (throw (ex-info (str "No such method " method-name
                         " for object of class " (:name class) ": "
                         (pr-str obj))
                    {}))))

(defn call-method
  "Takes an object and a method name. Looks up the corresponding method in the
  object's class (or superclasses) via resolve-method. Calls that method,
  providing the object as the first argument, and passing in any additional
  arguments thereafter."
  [obj method-name & args]
  (call-method-with-class (class obj) obj method-name args))

(def Obj
  (make-class
    'Obj Top nil nil
    {:super (fn super [this]
              (update this :class :super))
     :inspect
     (fn inspect [this]
       (let [class (class this)]
         ; For standard objects, we print out their fields and values.
         (c/str "<"
                (:name class)
                " "
                (->> (:fields class)
                     (map (fn [field]
                            (c/str (name field)
                                   "="
                                   (-> this
                                       (get-field field)
                                       (call-method :inspect)))))
                     (str/join " "))
                ">")))

     :str (fn str [this]
           (call-method this :inspect))}))

(defn rewrite-method
  "Takes a set of instance variable names, as well as method expression like
  (greet [name] ...) and rewrites it to [:greet (fn greet [this name] ...).
  References to instance variables are rewritten to `this.varname`. This *does*
  prevent you from binding field names in let bindings etc, but this is a
  quick-and-dirty example and we're trying to save space."
  [instance-vars [method-name arglist body]]
  (let [; Allow using map literals for bodies
        body (if (map? body)
               (mapcat identity body)
               body)
        ; Rewrite variables in instance scope
        body (walk/postwalk
               (fn [expr]
                 (if (and (symbol? expr)
                          (not (qualified-symbol? expr))
                          ; For foo.bar.baz, check to see if foo is a field.
                          (contains? instance-vars (-> (name expr)
                                                       (str/split #"\.")
                                                       first
                                                       symbol)))
                   (symbol (str "this." expr))
                   expr))
               body)]
    `[~(keyword method-name)
      (fn ~method-name [~'this ~@arglist]
        (oo ~@body))]))

(defn parse-fields
  "Parses field definitions from a series of forms, returning [fields,
  field-opts, remaining-forms]."
  [forms]
  (loop [fields           []
         field-opts       {}
         next-field-opts  {}
         [form & more :as forms] (seq forms)]
    (let [next-form (first more)]
      (cond (or (empty? forms)    ; End of class
                (seq? next-form)) ; Arglist impending
            [fields field-opts forms]

            ; We're a modifier
            (= 'mutable form)
            (recur fields
                   field-opts
                   (assoc next-field-opts :mutable? true)
                   more)

            ; We're a field
            true
            (let [field (keyword form)]
              (recur (conj fields field)
                     (assoc field-opts field next-field-opts)
                     {}
                     more))))))

; We could define all our classes this way, but it might be convenient to have
; a macro for this.
(defmacro defclass
  "Defines a class with the given name, and binds it to the Clojure Var of the
  same name. Forms proceed in the following order:

  1. Superclass. Provide < Foo to indicate that this class inherits from Foo.
     If not provided, defaults to Obj.

  2. Fields. A series of symbols. The special symbol 'mutable modifies the
     following field name. For instance, `id mutable age mutable gender`
     defines three fields: id, age, and gender.

  3. Methods. Methods begin with a symbol (the method name) and are followed by
     a list of arguments, followed by a list of forms--the method body. Method
     arguments omit the receiver, which is bound automatically to `this`. In
     method bodies, oo syntax applies, and this class's instance variables and
     methods are in local scope. If your body contains an even number--fewer
     than 17--of expressions, and does not repeat odd-numbered forms, you may
     write it using braces. You may write longer bodies, at the cost (feature?)
     of nondeterministic execution order.

      (defclass Person < Obj
        name;
        mutable bff;

        make-bffs(friend) {
          this.bff   = friend;
          friend.bff = this;
        }

        say-hi () (
          (println \"Hi! My name is \" name \" and my bestie is \" bff.name));
        )"
  [name & forms]
  (let [; 1. Identify the superclass.
        [super forms] (if (= '< (first forms))
                        [(second forms) (drop 2 forms)]
                        [Obj forms])

        ; 2. Parse field definitions
        [fields field-opts forms] (parse-fields forms)

        ; 3. Parse methods. Each method comes in a `name (arglist) body` trio.
        methods (partition 3 forms)

        ; In methods, our local scope will include all fields defined on this
        ; class itself, and all methods on this class *or* its supers.
        instance-vars (->> (concat fields
                                   (map first methods)
                                   (all-methods {:class (eval super)}))
                           (map symbol)
                           set)

        ; Now, transform methods bodies into a map of names to functions.
        methods (->> methods
                     (map (partial rewrite-method instance-vars))
                     (into {}))]
    `(do ; Define class
         (def ~name
           (make-class '~name
                       ~super
                       ~fields
                       ~field-opts
                       ~methods)))))

(def return
  "for ~reasons~"
  nil)

;(pprint (clojure.walk/macroexpand-all (quote
(class Person < Obj
  name;
  mutable bff;

  say-hi() {
    println("Hi! My name is", name.str(),
            "and my bestie is", bff.name.str());
  }

  make-bffs(friend) {
    this.bff   = friend;
    friend.bff = this;
  }
)
;)))

;(pprint (macroexpand '
(oo

  kate = Person("Kate", nil);
  onika = Person("Onika", nil);
  kate.make-bffs(onika);
  onika.bff.say-hi();

)
;))


; Sequential defines the basic features of sequential collections: first, rest,
; map, etc.
(declare LazyCons)

(class Sequential
  first() { return :not-implemented }
  rest()  { return :not-implemented }
  count() { return :not-implemented }

  empty?() {
    zero?(count());
  }

  map(f) {
   return empty?() ? this ∶ LazyCons(f(first()), fn([] rest().map(f)));
  }

  reduce(init, f) {
    loop([s this, acc init]
      if (s.empty?()) {
        return acc;
      } else {
        recur(s.rest(), f(acc, s.first()));
      });
  }

  clj-seq() {
    if (empty?()) {
      return nil;
    } else {
      lazy-seq(
        c/cons(first(), rest().clj-seq()));
    };
  }

  inspect() (
   ;prn("Inspecting" call-method-with-class(Obj, this, :inspect, []))
   c/str("(",
         str/join(", " map(fn([x] x.str())).clj-seq()),
         ")"));
)

(class Empty < Sequential
  first() { }
  rest()  ( (Empty) )
  count() ( 0 )
)

(class Cons < Sequential
  first;
  rest;
  count;

  first() { return first }
  rest()  { return rest  }
  count() { return count }
)

(defn ->Cons
  [first rest]
  (oo count = inc(rest.count())
      Cons(first, rest, count)))

(defn clj->Cons
  "Converts a Clojure sequence to a Cons representation."
  [s]
  (reduce (fn [more x]
            (->Cons x more))
          (Empty)
          (reverse s)))

(class LazyCons < Sequential
  first;
  rest-fn;

  empty?() { return false }
  first()  { return first }
  rest() (
    f = rest-fn;
    return f();
  )
)

(class Array < Sequential
  mutable v;

  count() {
    c/count(v);
  }

  first() {
    c/first(v);
  }

  rest() {
    c/empty?(v) ? Empty() ∶ Array(subvec(v, 1));
  }

  get(i) {
    nth(v, i);
  }

  set [i value] {
    v = assoc(v, i, value);
  }

  map(f) {
    ; Our map returns an Array. FOR PERFORMANCE.
    Array(c/mapv(f v));
  }

  reduce(init, f) {
    c/reduce(f, init, v);
  }

  inspect() {
    seq-rep = call-method-with-class(Sequential, this, :inspect, [])
    c/str("[", subs(seq-rep, 1, dec(c/count(seq-rep))), "]");
  }
)

(oo
  ;l = ->Cons(1, ->Cons(2, Empty()))
  ;l.pp()
  ;l.map(inc).pp()

  ;a = Array([1 2 3])
  ;a.pp()
  ;a.get(2).pp()
  ;a.set(0, 5)
  ;a.pp()
  ;a.map(inc).pp()

  ; Arrays are fast!
  n    = 10000
  coll = range(n)
  bigl = clj->Cons(coll)
  biga = Array(vec(coll))
  time(bigl.map(inc).reduce(0, +).pp())
  time(biga.map(inc).reduce(0, +).pp())
  time(->>(coll, map(inc), reduce(+, 0)).pp())
)

rewrite.clj

(ns scratch.rewrite
  "The world's shittiest term rewriting system"
  (:require [clojure [pprint :refer [pprint]]
                     [walk :refer [postwalk]]]))

(defn fixed-point
  "Applies f repeatedly to x until it converges."
  [f x]
  (let [x' (f x)]
    ;(Thread/sleep 3000)
    ;(prn :fp x')
    (if (= x x')
      x
      (recur f x'))))

(defn rewrite-seq-1
  "Scans a sequence once, applying rewrite function f to expr, then (next
  expr), then (next (next expr), etc. Returns `expr` with that change. f
  returns something falsey when it doesn't want to change that subsequence. Not
  recursive."
  ([f expr]
   (rewrite-seq-1 f [] expr))
  ([f scanned expr]
   ; (prn :scan expr)
   (if (seq expr)
     (if-let [expr' (f expr)]
       (into scanned expr')
       (recur f
              (conj scanned (first expr))
              (next expr)))
     scanned)))

(defn rewrite-term
  "Rewrites any term, without recursion."
  [f term]
  ; ah yes, the three genders
  ; (prn :rewrite-term term (class term))
  (cond (map-entry? term) term
        (vector? term)    (vec (rewrite-seq f term))
        (seq?    term)    (if (seq term)
                            (seq (rewrite-seq f term))
                            term)
        :else             (or (f term) term)))

(defn rewrite-walk-1
  "Rewrites term using rewrite-fn f recursively, in one pass."
  [f term]
  ;(prn :walk term)
  ;(pprint term)
  (postwalk (partial rewrite-term f) term))

(defn rewrite-walk
  "Rewrite-walk repeatedly until converged."
  [term f]
  (fixed-point (partial rewrite-walk-1 f) term))

(defn single-rule
  "To match non-sequential things, provide an expression with a guard, symbol,
  and body expression, and generates a function that replaces things that match
  `guard` with `body`, having `name` bound:

    '[(guard? term) body]

    (fn [term]
      (when (guard? term)
        body))"
  [[[guard term] body]]
  `(fn ~'rule [~term]
     (when (~guard ~term)
       ~body)))

(defn seq-rule
  "You can pattern match sequences using (guard, sym) binding pairs, and
  provide an explicit more pattern to capture the rest of the seq.

    [[fx x, fy y, & more] body]

    (fn [term]
      (when (seqable? term)
        (let [[x y & more] term]
          (when (and (fx x) (fy y))
            body))).

  Or, without & more, prepends whatever seq body returns onto the rest of the
  term. Something like:

    [[fx x, :fy y] body]

    (fn [term]
      (when (seqable? term)
        (let [[x y & more] term]
          (when (and (fx x) (fy y))
            (concat body more))))"
  [[bindings body]]
  (let [[bindings [_ more]] (split-with (complement #{'&}) bindings)
        more-sym            (or more (gensym 'more))
        pairs               (partition 2 bindings)
        term                (gensym 'term)
        guards              (map first pairs)
        names               (map second pairs)
        ; TODO: eval guard exprs once, so you can (fn-returning-pred-fn)
        ; efficiently
        guard-exprs         (map-indexed (fn [i guard]
                                           `(~guard (nth ~term ~i)))
                                         guards)]
    `(fn ~'rule [~term]
       (try
         (when (and (sequential? ~term)
                    (<= ~(count guards) (count ~term))
                    ~@guard-exprs)
           ; Bind names
           (let [[~@names ~'& ~more-sym] ~term]
             ; Return body
             ~(if more
                ; Explicit more form
                body
                ; Tack on the rest after whatever body they give us
                `(concat ~body ~more-sym))))
         (catch RuntimeException e#
           (throw (RuntimeException.
                    (str "Rewrite rule " (pr-str '~bindings)
                         " threw on term " (pr-str ~term))
                    e#)))))))
(defn rule
  "Takes a rule spec (see single-rule and seq-rule) and generates the
  appropriate rule fn."
  [rule]
  (if (vector? (first rule))
    (seq-rule rule)
    (single-rule rule)))

(defmacro rewrite
  "Takes a term and a series of rewrite rules, and applies those rules to the
  term in order."
  [expr & rules]
  (let [rules   (partition 2 rules)
        matches (map rule rules)]
    `(let [rules# [~@matches]]
       (reduce rewrite-walk ~expr rules#))))