Quick and dirty macro to extend multiple types/records at once with the same protocol implementation syntax as defrecord

extend-multi.clj

(defmacro extend-multi
  "Like extend, but takes a set of types/classes which will all be extended with 
  the given protocol and method map pairs using the same syntax as defrecord for 
  protocol function implementations."
  [atype* & proto+mmap*]
  (loop [proto+mmap* proto+mmap*
         fn-map* []
         ext-body []]
    (if (nil? (seq proto+mmap*))
        `(let ~fn-map* ~@(map (fn [a] `(extend ~a ~@ext-body)) atype*))
        (let [fst (first proto+mmap*)
              nxt (next proto+mmap*)]
          (if (list? fst)
              (let [map-var (gensym "fn-map")]
                (recur nxt
                       (conj fn-map*
                             map-var
                             {(keyword (first fst))
                              (cons 'fn (next fst))})
                       (conj ext-body map-var)))
              (recur nxt
                     fn-map*
                     (conj ext-body fst)))))))


;; Sample output:
;;
;; => (pprint (macroexpand '(extend-multi (DefCps DefSrs DefTriv)
;;    			     proto/PUnparse
;; 			     (unparse [this]
;; 			      `(def ~(proto/unparse (:sym this))
;; 			        ~(proto/unparse (:init this))))
;;  
;; 			      proto/PWalkable
;; 			      (walk-expr [this f ctor]
;; 			       (ctor (:sym this) (f (:init this)))))))
;; (let*
;;  [fn-map2195
;;   {:unparse
;;    (fn
;;     [this]
;;     (clojure.core/seq
;;      (clojure.core/concat
;;       (clojure.core/list 'def)
;;       (clojure.core/list (proto/unparse (:sym this)))
;;       (clojure.core/list (proto/unparse (:init this))))))}
;;   fn-map2196
;;   {:walk-expr (fn [this f ctor] (ctor (:sym this) (f (:init this))))}]
;;  (clojure.core/extend
;;   DefCps
;;   proto/PUnparse
;;   fn-map2195
;;   proto/PWalkable
;;   fn-map2196)
;;  (clojure.core/extend
;;   DefSrs
;;   proto/PUnparse
;;   fn-map2195
;;   proto/PWalkable
;;   fn-map2196)
;;  (clojure.core/extend
;;   DefTriv
;;   proto/PUnparse
;;   fn-map2195
;;   proto/PWalkable
;;   fn-map2196))