明日使える総称関数(1)

この記事はMetaobject Protocol(MOP) Advent Calendar 2013 2日目の記事として書かれました。

実は今日が誕生日の筆者です。適当に何かを送りつけてくれたり、お祝いの言葉をもらえたりすると喜ぶかもしれません。

さて、MOPと言えばCLOSがまず浮かぶのではないでしょうか。Metaobject Protocolなのでオブジェクトのクラス定義の方をさすのかもしれないのですが、CLOSといえば総称関数が便利です。そこで今回は「明日使える総称関数」と題しまして、qualifierを便利に使いつつMOP的にも満足いくようにしてみたいと思います。

とりあえず前提としてコードは拙作Sagittarius Scheme(0.4.11)で動作確認しています。またGaucheはメソッドのqualifierをサポートしていないので移植は(現状では)不可能ですが、本稿で紹介するqualifierはCLにも同様のものがあるので、そちらへの移植は難しくないかと思います。

まずはメソッドqualifierのおさらいをしましょう。Sagittariusではデフォルトで:primary, :before, :afterそして:aroundの4つのqualifierを実装しています。特に何も指定しない場合は:primaryが暗黙のうちに使用されます。イメージをつかむために簡単な例を見てみます。

(import (rnrs) (clos user))
(define-method print :around args
  (display "around:before") (newline)
  (call-next-method)
  (display "around:after") (newline))

(define-method print :before args
  (display ":before") (display args) (newline))
(define-method print :after args
  (display ":after") (display args) (newline))

(define-method print args (call-next-method))
(print 'a 'b 'c)
#|
around:before
:before(a b c)
abc
:after(a b c)
around:after
|#

:aroundは一番外側を包み、call-next-methodが呼ばれた際のみに続くメソッドチェインを起動します。また、チェイン全体の戻り値は:aroundメソッドが返した値になります。
:beforeはメソッド本体が呼ばれる手前で呼び出されます。戻り値は捨てられます。
:primaryはメソッド本体です。:aroundが上書きしない限りこのメソッドの戻り値がメソッドチェインの全体の戻り値として使用されます。
:afterはメソッド本体が呼ばれた直後に呼ばれます。:before同様戻り値は捨てられます。
ちなみに、この動作はCLでも同様です。

では、これが使えると何が嬉しいのでしょう？

例えば、 DB接続を考えて見ます。DBの実装によってクエリ発行などは別にする必要があるけど、コネクションが生きているかチェックするのは共通でやりたい、なんてこと考えたことありませんか？素直に考えれば、以下のようになるでしょう。

;; super class method
(define-method select ((c <connection>) query)
  (check-connection c))

;; Database dependent layer
(define-method select ((c <oracle-connection) query)
  (call-next-method)
  (oracle-select c query))

DBの種類が増えた場合でもcall-next-methodを呼べば共通の処理はしてくれるという寸法です。でも毎回書くのはだるいですよね？そこでメソッドqualifierです。この場合なら事前処理に:beforeを使って以下のように書くことができます。

;; super class method
;; implementation limitation. Sagittarius needs primary method
(define-method select ((c <connection>) query))
(define-method select :before ((c <connection>) query)
  (check-connection c))

;; Database dependent layer
(define-method select ((c <oracle-connection) query)
  (oracle-select c query))

これでDBの実装が増えてもselectメソッドではコネクションが生きているかを自動で判別してくれます。(もちろん、check-connectionがエラーを投げなければ意味はありませんが・・・)

もう一例見てみましょう。JavaでAspectJを使っている方なら馴染み深いと思いますが、既存のメソッドの前後に事前と事後処理を入れたい場合というのがあるかと思います。例えばあるメソッドがエンティティの状態を変更します、ユーザーはその状態の変化を捉えて何かしらの通知を行うというのを考えて見ます。以下は簡単なコード例です。

;; pseudo method
;; This is in somewhere the library so users can't
;; change.
;; do something useful and return the new entity
(define (fire-event entity event) 'new-entity)

;; wrap it with qualifier
;; just stub to call original
(define-method fire-event args (call-next-method))

(define-method fire-event :around args
  ;; check args length and get the entity's state
  (print args)
  ;;
  (let ((r (call-next-method)))
    ;; check the result of the entity and notify
    (print r)
    r))
#|
(fire-event 'entity 'event)
;;> (entity event)
;;> new-entity
;;=> new-entity
|#

この例では:aroundが実際のメソッドを呼び出していますが、引数が不正であったりする場合は呼ばないことも可能です。Lisp:よくある正解で上げられているToo dynamicはこの機能を使えば実現できそうです*1。

次回*2はMOPを使って総称関数にユーザー定義のqualifierを足してみます。

*1コンパイラが手続きの呼び出しをインライン展開している場合等全てに対応できるわけではありません。
*2紹介部分が予定したよりかなり長くなってしまったので分割しました。