CLでClojure風関数ディスパッチメソッド

プログラムを書いているときに、Clojure風のメソッドのディスパッチに引数にたいして関数を適応した
結果を利用して実行するメソッドをディスパッチする機構がほしいなぁとおもいました。
そこで、MOPをつかってちょっとした実装をしてみました。

(ql:quickload :closer-mop)
(defclass <multi-method> ()
  ((dispatch-fn :initform #'identity :initarg :dispatch-fn :accessor dispatch-fn)
   (function-table :initform (make-hash-table :test 'equal) :accessor function-table))
  (:metaclass c2mop:funcallable-standard-class))

(defmethod initialize-instance :after ((multi-method <multi-method>) &rest args)
  (declare (ignore args))
  (c2mop:set-funcallable-instance-function
   multi-method
   #'(lambda (&rest args)
       (let* ((disp-fn (slot-value multi-method 'dispatch-fn))
	      (res (apply disp-fn args))
	      (fn  (gethash res (slot-value multi-method 'function-table))))
	 (apply fn args)))))

(defmacro <defmulti> (name dispatch-fn)
  `(setf (symbol-function ',name)
	 (make-instance '<multi-method>
                       :dispatch-fn ,dispatch-fn)))

(defmacro <defmethod> (name dispatch-value args &body body)
  `(setf (gethash ,dispatch-value (function-table ,(symbol-function name)))
	 (lambda ,args
	   ,@body)))

funcallableなインスタンスにしています。

(<defmulti> hoge (lambda (x) (= x 1)))

(<defmethod> hoge t (x) "One")
(<defmethod> hoge nil (x) "Otherwise")

(hoge 1)
=> "One"
(hoge 2)
=> "Otherwise"
(hoge 34)
=> "Otherwise"