error handling

scratch.clj

(defprotocol Handler
  (setSelector [h s])
  (setModTime [h t])
  (getModTime [h])
  (addFn [h case fn]))

(deftype AHandler [fns
                   ^:volatile-mutable modtime
                   ^:volatile-mutable selector]
  Handler
  (addFn [h case fn]
    (.put fns case fn)
    nil)
  (getModTime [h] modtime)
  (setSelector [h s]
    (set! selector s)
    nil)
  (setModTime [h t]
    (set! modtime t)
    nil))

(defn handler []
  (->AHandler (java.util.concurrent.ConcurrentHashMap.)
              (System/currentTimeMillis)
              nil))

(defmacro defhandler [name selector]
  (let [modtime (System/currentTimeMillis)]
    (if-let [h (resolve 'foo)]
      `(do
         (setModTime ~name ~modtime)
         (setSelector ~name ~selector)
         ~name)
      `(let [h# (handler)]
         (setModTime h# ~modtime)
         (setSelector h# ~selector)
         (def ~name h#)))))

(defmacro defhandler-case [name case args & body]
  `(do
     (addFn ~name ~case
            (with-meta (fn ~args ~@body)
              {:inline-selector
               (fn [arg#]
                 `(isa? ~arg# ~~case))
               :inline-body
               (fn [e#]
                 `(let [~~(first args) ~e#]
                    ~~@body))}))
     nil))

(defhandler-case foo :bar [x] (inc x))

(defmacro defhandler [name selector]
  `(let [sel# ~selector
         v# (defmulti ~name (comp sel# first list))]
     (alter-meta! v# update-in [:version] (fnil inc 0))
     (alter-meta! v# assoc-in [:selector] sel#)
     (defmethod ~name :default [e# & args#]
       (throw e#))
     ~name))

(defmacro defhandler-case [name case args & body]
  `(do
     (defmethod ~name ~case [& ~args] ~@body)
     (alter-meta! (var ~name) assoc-in [:inline ~case] ['~args '~body])
     (alter-meta! (var ~name) update-in [:version] inc)
     (var ~name)))

(defmacro recover-error [handler bindings & body]
  (let [ver (:version (meta (resolve handler)))
        throwable (gensym 'throwable)
        dispatch-value (gensym 'dispatch-value)]
    `(try
       ~@body
       (catch Throwable ~throwable
         (if (>= ~ver (:version (meta (var ~handler))))
           (let [~dispatch-value ((:selector (meta (var ~handler))) ~throwable)]
             (cond
              ~@(for [[case [args body]] (:inline (meta (resolve handler)))
                      x [`(isa? ~dispatch-value ~case)
                         `(let ~(vec (apply concat
                                            (zipmap args
                                                    (cons throwable bindings))))
                            ~@body)]]
                  x)
              :else (throw ~throwable)))
           ~(list* handler throwable (seq bindings)))))))

;; user> (defhandler foo type)
;; #<MultiFn clojure.lang.MultiFn@13e4318d>
;; user> (defhandler-case foo java.lang.Exception [e] (println e))
;; #'user/foo
;; user> (recover-error foo [+] (/ 1 0))
;; #<ArithmeticException java.lang.ArithmeticException: Divide by zero>
;; nil
;; user> (defhandler-case foo java.lang.Exception [e a] (println a))
;; #'user/foo
;; user> (recover-error foo [+] (/ 1 0))
;; #<core$_PLUS_ clojure.core$_PLUS_@25b217f6>
;; nil
;; user>