toy multimethod implementation

multimethods-toy.clj

;;;; machinery for multimethods
(defmacro defmethod2 [fname dispatch-val signature body]
  `(swap! ~(symbol (str "multimethod-lkp-" fname)) assoc ~dispatch-val 
           (fn ~signature ~body)))

(defn make-generic-fn [fname dispatchfn]
 `(defn ~fname [& ~'args] 
   (let [dispatch-val# (apply ~(symbol (str "multimethod-dispatch-" fname)) ~'args)
         mm-table# (deref ~(symbol (str "multimethod-lkp-" fname)))
         matching-fn# (some #(get mm-table# %) [dispatch-val# :default])]
   (if matching-fn# 
     (apply matching-fn# ~'args)
      (throw (Exception. 
             (str "No multimethod implemented for " dispatch-val#)))))))

(defmacro defmulti2 [name dispatch-fn] 
  `(do 
    (def ~(symbol (str "multimethod-lkp-" name)) (atom {}))
    (def ~(symbol (str "multimethod-dispatch-" name)) ~dispatch-fn)
    ~(make-generic-fn name dispatch-fn)))

;;;; example usage
(defmulti2 area :shape)

(defmethod2 area :triangle [{:keys [shape base height]}]  
  (/ (* base height) 2))

(defmethod2 area :rectangle [{:keys [shape length width]}]  
  (* length width))

(defmethod2 area :default [polygon]  
  (* Math/PI (Math/pow (:width polygon) 2)))

(area {:shape :triangle :base 11 :height 9})
(area {:shape :rectangle :length 2 :width 8})
(area {:shape :square :length 4 :width 3})

Doesn't handle namespaces, caching, etc... just an experiment since I haven't seen what a stripped down implementation would look like.