Lisp メソッドコンビネーション Advent Calendar 2018の3日目の記事です。

任意のメソッドコンビネーションを自作するマクロであるdefine-method-combinationのリファレンス(CLHS)を眺めていたのですが、中々理解するのに苦労しました。次のような所に難しさがある気がします。

どの部分が任意に決めて良いもので、どの部分が決まった文法なのか分かりにくい
どの部分がいつ利用・評価されるのか分かりにくい
- defgeneric時なのか、defmethod時なのか、コンパイル時なのか、実行時なのか…
（そもそも用語が多い上に動きもイメージし辛いので、↑の辺りが飲み込めてこないと説明を見ても頭に入ってこない）

この辺りを念頭に置きつつ、例を見ながら理解した内容を整理したいと思います。

段階的で良い感じだったので、例としてはCLHS内のorの例を中心に見ていきます。

前置き：メソッドコンビネーション or の動作
Short Form
Long Form
- 短めのLong Form
- 長めのLong Form
落ち穂拾い
- :arguments
- :generic-function
おまけ: standardの実装
おわりに

前置き：メソッドコンビネーション `or` の動作

メソッドコンビネーション or の動作について1例を。or という名称から想像が付くように、非nilが返る（か最後に到達する）まで適用可能なメソッドを順に呼んでいきます。

;; ※def系の出力略
CL-USER> (defgeneric test-or (a) (:method-combination or))
CL-USER> (defmethod test-or or ((a fixnum)) ; 結果がnilなので次も呼ぶ
           (print "fixnum type returns nil")
           nil)
CL-USER> (defmethod test-or or ((a number)) ; 結果がtrueなのでここで終わり
           (print "number type returns t")
           t)
CL-USER> (defmethod test-or or (a) ; 下の例では呼ばれない
           (print "any type returns nil")
           nil)
CL-USER> (test-or 1)

"fixnum type returns nil"
"number type returns t"
T

なお、"7.6.6.4 Built-in Method Combination Types"にあるようにビルトインのメソッドコンビネーションとして存在します。

Short Form

define-method-combination には、Short FormとLong Formの2つの形態があります。この記事ではLong Formの説明を中心に行いたいので、Short Formについては下のようにすれば or を定義できますという程度に留めます。

(define-method-combination or :identity-with-one-argument t)

なお、:identity-with-one-argumentはちょっとした最適化のためのオプションで、or や progn, +, max のように、1引数で呼び出した場合にその引数の結果がそのまま全体の結果となる（Ex. (or x) -> x）ようなオペレータに対して指定できます。

Long Form

本題のLong Formです。

CLHSのdefine-method-combinationの項より、定義のうち後ろの説明で出てくるあたりを抜粋しておきます。

define-method-combination name lambda-list (method-group-specifier*) form*

method-group-specifier::= (name {qualifier-pattern+ | predicate} [[long-form-option]])

短めのLong Form

orの実装例として3つのLong Formが示されていますが、まずはその中でもShortなLong Formの例です。後述のLongなLong Formと見比べるとかなり短いですが、こちらがじっくり理解できれば、Longな方もすんなり入ってくると思います。

(define-method-combination or ()
  ((methods (or)))
  `(or ,@(mapcar #'(lambda (method)
                     `(call-method ,method))
                 methods)))

前の方から順番に見ていきます。

まずは定義の name に当たる or ですが、これはもちろん (defgeneric method (:method-combination or)) で指定する名前です。Long Formにおいては名前以上の意味を持たないので任意につけて問題ありません。

次にlambda-formに当たる部分ですが…今の例では空（()）なので後ろで見ます。ここで定義したものもdefgenericで利用するという部分だけ抑えておきます。

肝となるのが、次の(method-group-specifier*)に当たる((methods (or)))です。これはletのように(変数名束縛対象)の組み合わせが並んだものです。ここでは、(methods (or))の一組だけが定義されています。

まずはmethodsです。この部分、他の例も合わせて見るとbeforeやらafterやらprimaryやら、いかにも意味ありげな名前がついているため、何か決まりがあるようにも見えます。が、define-method-combination内部（後に続くform内）だけで利用する変数名なので、letの要領で好きに名前をつければ良いです。ここには、defmethodで定義されるメソッドのリストが（よりspecificなものが前に来る順序で）束縛されます。例えば、下のような定義がある場合、(test-or 100)という呼び出しに対してはA, B, Cの3つのメソッドが、(test-or :hoge)という呼び出しに対してはCのメソッドのみが、リストの要素になってmethodsに束縛されます。

;; ※冒頭の例を再掲
CL-USER> (defgeneric test-or (a) (:method-combination or))
CL-USER> (defmethod test-or or ((a fixnum)) ; --- A
           (print "fixnum type returns nil")
           nil)
CL-USER> (defmethod test-or or ((a number)) ; --- B
           (print "number type returns t")
           t)
CL-USER> (defmethod test-or or (a) ; --- C
           (print "any type returns nil")
           nil)

束縛時に選択されるメソッドについてさらに詳しく見ると、次の2つに共に合致するものが選ばれます。

実行時の情報を利用する動的なマッチング
- 平たく言えば型による（多重）ディスパッチのことです *1
定義時の情報を利用する静的なマッチング（以下の2つのマッチング）
- define-method-combination で指定する method-group-specifier（ここで議論している(methods (or))のこと）
- defmethod で指定する method-qualifier
  - (defmethod hoge-method :a :b :c (x y) ...) のようにメソッド名と引数リストの間に任意の数のシンボルを書くことができ、これをリストにしたもの（(:a :b :c)）をmethod-qualifierと呼びます

つまり、(methods (or))の(or)はdefmethod時に、定義されたメソッドをmethodsに束縛するべきかを静的に判断するための情報になります。(defmethod test-or or (a) ...)におけるorの指定は一見二度手間に見えますが、define-method-combinationで指定されているために必要なものということになります。逆に言うと、defmethod時に指定させたいものであればなんでも良く、メソッドコンビネーション自体の名前orと一致させているのは単にその方が分かり易いからというだけの理由です。

さて、(or)はリスト形式での指定の1例でしたが、大きくは以下3つの指定方法があります。定義上は最初の2つが qualifier-pattern にあたるもので、3つ目が predicate に相当します。

シンボル（*のみ可）: 任意の値・数のmethod-qualifierにマッチ
- 例. (methods *)
リスト: method-qualifier との equal 結果がtrueとなるものにマッチ
- 例. (methods (a b))とした場合、(defmethod hoge a b (arg) ...) のようなメソッドにマッチ
- 補足
  - ()とすると、(defmethod hoge (arg) ...)のようにmethod-qualifierの指定がないものにマッチ
  - (a . *)のようにすると、car部がaの任意のmethod-qualifierにマッチ
  - ~~要素数2つ以上のリストなんていつ使うんだろうか…~~
関数シンボル: method-qualifierを引数として渡して結果がtrueとなるものにマッチ
- 例. 次のような定義のqualifier-number-p関数を定義したとすると、(methods qualifeir-number-p)は(defmethod hoge 999 (arg) ...)のようなメソッドにマッチ

(defun qualifier-number-p (method-qualifier)
  (and (= (length method-qualifier) 1)
       (numberp (car (method-qualifier)))))

なお、複数の method-group-specifier にマッチする場合は、定義順で最初にマッチしたものに束縛される仕様です。

最後にようやく form* 部分です。formの目的は、methods に束縛されたメソッドのリストをどのように呼び出すかを決定することです。例えば、先頭のメソッドを1つ呼びたいだけであれば次のように書けます。

  `(call-method ,(first methods))

特徴的なのは call-method ですが、名前の通りメソッドの呼び出しを指示するものです。関数に対する funcall のメソッド版とイメージすると分かり易いかと思います。ただし、funcall とは異なりメソッド自体の引数は隠蔽されています。メソッドそのものとは別にoptionalな引数を1つ取りますが、これについては次の節で見ていきます。

さて、改めて実装例を見てみると、form部分ではorの中にリスト内の各メソッドに対する call-method を繋ぎ込んでいることが分かります。これにより、前から順にtrueが出るまでメソッドを呼び出すという動作を実現できたことになります。

;; ※再掲
(define-method-combination or ()
  ((methods (or)))
  `(or ,@(mapcar #'(lambda (method)
                     `(call-method ,method))
                 methods)))

長めのLong Form

CLHSには or のより長い実装例が2つありますが、一度に色々取り込んでいて説明しづらいので、少しずつ足しながら見ていきます。

aroundの実装

いわゆるaround機能を付加します。この実装から次のことを見ていきます。

call-method の第2引数について
make-method について

先にaroundの動作を簡単に確認します。下記のように、本来呼び出されるはずの{1}に先立ち、{2}でaroundとして定義したメソッドが呼び出されます。本来のメソッド{1}を呼び出すためには call-next-method を利用して明示的に呼び出す必要があります。

CL-USER> (defgeneric test-or (a) (:method-combination or))
CL-USER> (defmethod test-or or (a) (print "primary") t) ; --- {1}
CL-USER> (defmethod test-or :around (a) ; --- {2}
           (print "around")
           (call-next-method a))
CL-USER> (test-or 100)

"around"
"primary"
t

そしてその実装です。

(define-method-combination or ()
  ((around (:around))
   (primary (or))
  (let ((form `(or ,@(mapcar #'(lambda (method)
                                 `(call-method ,method))
                              primary)))))
    (if around
        `(call-method ,(first around)
                      (,@(rest around)
                          (make-method ,form)))
        form)))

まず目に付くのは、method-group-specifier が2つに増えている部分です。(defmethod hoge :around (...) ...)を引っかけるために、(around (:around)) が追加されています。なお短めの実装の方で methods となっていたものは primary となっていますが、これは束縛先の名前が変わっただけです。

次に、短めの実装では直接書き下していた本体部分を、いったん let で form という変数に束縛しています*2。続く (if around ...) のelse部分では単純にこれを置くだけなので、短めの実装と同じ動作になります。

ということで、around が存在する場合の処理を見てみます。まず、call-methodの第1引数としてaroundの最初のメソッドを渡すことで、aroundとして定義したメソッドを呼び出していることが分かります。そして第2引数としてメソッドのリストを渡しています。これは、call-next-method（とnext-method-p）で内部的に利用されるリストで、ここにあるものを前から順に呼んでいくことになります。さて、実装例を見ると2つのものを連結してリストを作成しています。1つはaroundの残りの部分です。もう1つが初登場のmake-methodの返り値です。これは、読んで字のごとくメソッドを生成する関数 *3 です。引数として form を受け取って、これをメソッド化します。

orderの実装

次にメソッドの呼び出し順序の実装です。この実装から次のことを見ていきます。

メソッドコンビネーションの引数
method-group-specifier の引数

先に呼び出し順を逆順にする例を確認します。

;; defgeneric で :most-specific-last を指定
TEMP> (defgeneric test-or-rev (a) (:method-combination or :most-specific-last))
TEMP> (defmethod test-or-rev or ((a fixnum)) ; ここは呼ばれない
        (print "fixnum type returns nil")
        nil)
TEMP> (defmethod test-or-rev or ((a number)) ; ここまで呼ばれる
        (print "number type returns t")
        t)
TEMP> (defmethod test-or-rev or (a) ; ここから呼ばれる
        (print "any type returns nil")
        nil)
TEMP> (test-or-rev 1)

"any type returns nil"
"number type returns t"
T

そしてその実装です。

(define-method-combination or
    (&optional (order ':most-specific-first)) ; ここに引数 order を追加
  ((around (:around))
   (primary (or) :order order)) ; ここで order を指定
  (let ((form `(or ,@(mapcar #'(lambda (method)
                                 `(call-method ,method))
                              primary)))))
    (if around
        `(call-method ,(first around)
                      (,@ (rest around)
                          (make-method ,form)))
        form)))

さっくり見ていきます。

メソッドコンビネーションの引数 = (&optional (order ':most-specific-first)
- defgeneric時に利用されるもので、本節最初の例で:most-specific-lastを指定していた部分に相当します
- ※短めの例では空リストとなっていた部分です
method-group-specifier の引数 = (primary (or) :order order)
- defgeneric 時に指定した引数を元に実行順序を指定しています
- この引数には :order の他に次の2つがあります
  - :description は名前の通りドキュメント用の文字列を取ります
  - :requied をtrueとすると、該当するメソッドが見つからない場合実行時にエラーとなります

long-form-option::= :description description | 
                    :order order | 
                    :required required-p

なお、method-group-specifier の引数 :order を利用せずとも、次のように自前で実行順序の実装をすることもできます。前述のように、primary にはメソッドのリストが束縛されるため、逆順にしたければ単にこれを reverse するだけです。もちろん、必要に応じて任意の順序に並び換えることもできます。

(define-method-combination or
    (&optional (order ':most-specific-first))
  ((around (:around))
   (primary (or)))
  ;; 自前での実行順序実装
  (case order
    (:most-specific-first)
    (:most-specific-last (setq primary (reverse primary)))
    (otherwise (method-combination-error "~S is an invalid order.~@
     :most-specific-first and :most-specific-last are the possible values."
                                         order)))
  (let ((form `(or ,@(mapcar #'(lambda (method)
                                 `(call-method ,method))
                             primary))))
    (if around
        `(call-method ,(first around)
                      (,@(rest around)
                         (make-method ,form)))
        form)))

requiredの実装

orderの部分で既に触れていますが、該当するメソッドが見つからない場合、実行時にエラーとする機能の実装です。

単純なので実装を並べて終わりにします。次の例では、 primary に該当するメソッドがない場合、実行時にエラーとなります。

(define-method-combination or
    (&optional (order ':most-specific-first))
  ((around (:around))
   (primary (or) :order order :required t)) ; ここに追加
  (let ((form `(or ,@(mapcar #'(lambda (method)
                                 `(call-method ,method))
                              primary)))))
    (if around
        `(call-method ,(first around)
                      (,@ (rest around)
                          (make-method ,form)))
        form)))

もちろん、自前でも実装できます。

(define-method-combination or
    (&optional (order ':most-specific-first))
  ((around (:around))
   (primary (or)))
  (case order
    (:most-specific-first)
    (:most-specific-last (setq primary (reverse primary)))
    (otherwise (method-combination-error "~S is an invalid order.~@
     :most-specific-first and :most-specific-last are the possible values."
                                         order)))
  ;; ここが required に相当する実装
  (unless primary
    (method-combination-error "A primary method is required."))
  (let ((form `(or ,@(mapcar #'(lambda (method)
                                 `(call-method ,method))
                             primary))))
    (if around
        `(call-method ,(first around)
                      (,@(rest around)
                         (make-method ,form)))
        form)))

落ち穂拾い

上記で抜粋した定義では省略していましたが、他に :arguments と :generic-function という任意オプションがありますので、それぞれ簡単に見てみます。

define-method-combination name lambda-list (method-group-specifier*) [(:arguments . args-lambda-list)] [(:generic-function generic-function-symbol)] form*

:arguments

:arguments を利用すると、メソッド実行時にメソッドの引数を拾うことができます。

(define-method-combination ex-of-arguments ()
  ((primary ()))
  (:arguments a)
  `(progn (format t "Use arguments: ~A" ,a)
          ,@(mapcar #'(lambda (method)
                        `(call-method ,method))
                    primary)))

(defgeneric arg-test (x y) (:method-combination ex-of-arguments))

(defmethod arg-test ((x fixnum) (y fixnum))
  (+ x y))

;; 実行例
CL-USER> (arg-test 1 2)
Use arguments: 1
3

何に使えるのかは良く分かりませんが、CLHSではロックに使う例を紹介しています。

 (define-method-combination progn-with-lock ()
         ((methods ()))
   (:arguments object)
   `(unwind-protect
        (progn (lock (object-lock ,object))
               ,@(mapcar #'(lambda (method)
                             `(call-method ,method))
                         methods))
      (unlock (object-lock ,object))))

:generic-function

:generic-function を利用すると、generic function自体を受け取ることができます。

(ql:quickload :closer-mop)

(define-method-combination ex-of-gen ()
  ((primary ()))
  (:generic-function gen)
  `(progn (print (closer-mop:generic-function-name ,gen))
          ,@(mapcar #'(lambda (method)
                        `(call-method ,method))
                    primary)))

(defgeneric gen-test () (:method-combination ex-of-gen))

(defmethod gen-test () :hoge)

何に使えるのかはさっぱり見当がつきません。こちらに至ってはCLHSにすら例がありません。

おまけ: standardの実装

method-qualifierを取らなかったり、:beforeや:afterがあったりと、何かと特別な感じがするデフォルトのメソッドコンビネーションですが、その気になれば自前で実装できますという例がCLHSに載せられています。

新しい要素はないため例をそのまま掲載するだけですが、これを眺めていると define-method-combination は良くできているものだなあと感心してしまいます。

 (define-method-combination standard ()
         ((around (:around))
          (before (:before))
          (primary () :required t)
          (after (:after)))
   (flet ((call-methods (methods)
            (mapcar #'(lambda (method)
                        `(call-method ,method))
                    methods)))
     (let ((form (if (or before after (rest primary))
                     `(multiple-value-prog1
                        (progn ,@(call-methods before)
                               (call-method ,(first primary)
                                            ,(rest primary)))
                        ,@(call-methods (reverse after)))
                     `(call-method ,(first primary)))))
       (if around
           `(call-method ,(first around)
                         (,@(rest around)
                          (make-method ,form)))
           form))))

おわりに

Q. それで、define-method-combination っていつ使うんですか？
A. さあ？

*1:厳密にはeqlによるディスパッチもありますが

*2:この部分、CLHSの例ではShort Formの:identity-with-one-argumentで述べたような1引数の場合の最適化が入っているのですが、見辛いので省略しました。以降同じです

*3:関数またはマクロ？CLHSを見る限り明言されていないようでした

eshamster’s diary

define-method-combinationを理解する

前置き：メソッドコンビネーション `or` の動作

Short Form

Long Form

短めのLong Form

長めのLong Form

aroundの実装

orderの実装

requiredの実装

落ち穂拾い

:arguments

:generic-function

おまけ: standardの実装

おわりに

前置き：メソッドコンビネーション or の動作

Short Form

Long Form

短めのLong Form

長めのLong Form

aroundの実装

orderの実装

requiredの実装

落ち穂拾い

:arguments

:generic-function

おまけ: standardの実装

おわりに

前置き：メソッドコンビネーション `or` の動作