Let's write β

プログラミング中にできたことか、思ったこととか

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"

僕が働いているAzit.incでは一緒に働けるエンジニアを募集しています!
採用情報 — 株式会社アジット|Azit Inc.