オブジェクト指向Lisp

この章ではLispによるオブジェクト指向プログラミングについて論じる. Common Lispにはオブジェクト指向のプログラムを書くためのオペレータが揃っている. それらをまとめて,Common Lisp Object System,またはCLOSと呼ぶ. ここではCLOSを単にオブジェクト指向のプログラムを書く一手段としてではなく, Lispプログラムそのものとして捉える. CLOSをこの観点から眺めることがLispとオブジェクト指向プログラミングとの関係を理解する鍵となる.

Plus ça Change

オブジェクト指向プログラミングとはプログラムの構成の変化を指す. その変化はプロセッサの処理能力の分布について起こったものと似ている. 1970年,「マルチユーザのコンピュータシステム」と言えば 一つか二つの大型メインフレームが多数のダム端末に接続されたものを指していた. 今では多数のワークステーションがネットワークでそれぞれ接続されたものを指すことの方が多い. システムの処理能力は一つの巨大なコンピュータに集中してはおらず, 個々のユーザに分散している.

オブジェクト指向プログラミングは古典的なプログラムを全く同様に分割する. 不活性な大量のデータに操作を行う単一のプログラムを作るのではなく, データ自身に行うべき動作を伝えておき, プログラムはこれらの新しいデータ「オブジェクト」の相互作用によって暗黙のうちに動作する.

例えば2次元図形の面積を求めるプログラムを書きたいとしよう. やり方としては,一つの関数の中で,引数の種類を調べてそれに従って動作させるものがある.

(defun area (x)
  (cond ((rectangle-p x) (* (height x) (width x)))
           ((circle-p x) (* pi (expt (radius x) 2)))))

オブジェクト指向のアプローチは図形オブジェクトそれぞれに自分の面積を計算させるものだ. 関数areaはばらばらに分割され,各分岐節が適当なオブジェクトのクラスに分散する. 長方形のクラスのメソッドmethodは次のようなものになるだろうし,

#'(lambda (x) (* (height x) (width x)))

縁のクラスでは次のようになるだろう.

#'(lambda (x) (* pi (expt (radius x) 2)))

このモデルでは, オブジェクトにその面積がどれだけか尋ねると, そのオブジェクトが自分のクラスで定義されたメソッドに従って反応を返す.

CLOSの到来はLispがオブジェクト指向のパラダイムを取り込み始めた兆に見えるかも知れない. 実際には,Lispはオブジェクト指向のパラダイムを今も変わらず含んでいると言う方が正確だ. しかしLispの底を流れる原則には名前が無く, オブジェクト指向プログラミングには名前があるので, 現在,Lispがオブジェクト指向言語だと説く傾向がある. 「Lispは拡張可能な言語で,その内部でオブジェクト指向プログラミングが容易に行える」 と言う方が真実に近いだろう.

CLOSは規格として定義済みなので,Lispがオブジェクト指向言語だと宣伝するのは嘘ではない. しかしそれではLispを単なるオブジェクト指向言語だと見るという制限を設けてしまっている. 確かにLispはオブジェクト指向言語だが, それはオブジェクト指向モデルを採用しているからではない. むしろLispの底を流れる抽象化技法の適用例にオブジェクト指向モデルが加わったに過ぎないと分かる. その証拠に,Lispで書かれたプログラムCLOSはLispをオブジェクト指向言語に変える.

この章の狙いは,CLOSを埋め込み言語の例として考察することで Lispとオブジェクト指向プログラミングとの結び付きを提示することだ. これはCLOSそのものを理解するにもよい方法だ. 結局のところプログラミング言語の機能を一番よく説明するのはその実装の概略をおいて他にない. 第7-6節ではマクロについてそのようにして説明した. 次節ではLispの上にオブジェクト指向の抽象化層を構築することに関して似た概略を与える. そのプログラムは第25-3節から第25-6節でCLOSの説明をするためのとっかかりとなる.

素のLispによるオブジェクト

Lispは様々な種類のプログラミング言語に形を変えることができる. オブジェクト指向プログラミングの諸概念とLispの基本的抽象化技法との間には 特に直接の対応が付けられる. CLOSは大規模なのでこの事実が霞みがちだ. そこでCLOSで何ができるかを見る前に素のLispで何ができるかを見ることにしよう. オブジェクト指向プログラミングに求めたいものはほとんど既にLispの中に用意されている. 足りない分は驚く程短いコードで追加できる. この節では2ページ分のコードで 実際のアプリケーションの多くに対して十分なオブジェクトシステムを定義する. オブジェクト指向プログラミングには,最低限で以下のことが必要だ.

  1. オブジェクトには属性があり,
  2. メッセージに反応し,
  3. 親から属性とメソッドを継承する.

既にLispには属性をまとめて保持するための方法が幾つかある. 一つはオブジェクトをハッシュ表として表現し,属性をその項目として表現する方法がある. そうすると個々の属性はgethashを通じて参照できる.

(gethash 'color obj)

関数もデータオブジェクトなので属性として保持できる. これはメソッドも実現できるということだ. オブジェクトのあるメソッドを呼び出すには,メソッドと同じ名前の属性をfuncallする.

(funcall (gethash 'move obj) obj 10)

この考えに基づき,Smalltalk風のメッセージ渡し構文が定義できる.

(defun tell (obj message &rest args)
  (apply (gethash message obj) obj args))

オブジェクトobj10だけ動くよう命じるには,こうすればよい.

(tell obj 'move 10)

実際,素のLispに欠けている概念は継承だけだが, 初歩的な継承は6行のコードで実現できる. gethashの再帰版を定義すればよい.

(defun rget (obj prop)
  (multiple-value-bind (val win) (gethash prop obj)
        (if win
              (values val win)
              (let ((par (gethash 'parent obj)))
                (and par (rget par prop))))))
(defun rget (obj prop)
  (some2 #'(lambda (a) (gethash prop a))
         (get-ancestors obj)))

(defun get-ancestors (obj)
  (labels ((getall (x)
                   (append (list x)
                           (mapcan #'getall
                                   (gethash 'parents x)))))
    (stable-sort (delete-duplicates (getall obj))
                 #'(lambda (x y)
                     (member y (gethash 'parents x))))))

(defun some2 (fn lst)
  (if (atom lst)
      nil
      (multiple-value-bind (val win) (funcall fn (car lst))
        (if (or val win)
            (values val win)
            (some2 fn (cdr lst))))))
\caption{多重継承.} \label{fig:MultipleInheritance}

gethashの所にrgetを使うだけで属性とメソッドの継承が実現できる. このときオブジェクトの親は次のように指定する.

(setf (gethash 'parent obj) obj2)

ここまでで実現できたのは単一継承のみで,オブジェクトはの持てる親は一つだけだ. しかし属性parentをリストにし, rgetを\reffig{fig:MultipleInheritance}とすることで多重継承が実現できる.

\caption{スーパークラスへの複数の経路.} \label{fig:MultiplePathsToSuperclass}

オブジェクトの属性を取得するとき, 単一継承では先祖に再帰的に遡って検索するだけでよかった. 求める属性の情報がそのオブジェクト自身にないときはその親を調べ, なければさらにその親へと繰り返していく. 多重継承でも同じような検索をしたいが, オブジェクトの先祖が単なるリストでなくグラフを形成し得るという事実が困難の元になる. そのグラフを単に深さ優先探索するだけでは駄目だ. 複数の親が許されるとき, \reffig{fig:MultiplePathsToSuperclass}のような階層構造ができることがある. aの親はbcで,それらは共にdを親に持つ. 深さ優先(と言うより高さ優先)探索はaから始めて b, d, c, dの順にオブジェクトを訪れる. 求める属性がdcとの両方にあったら, cではなくdに保持されている値が得られる. これではサブクラスは親の提供するデフォルト値をオーヴァライドするという原則が破られてしまっている.

普通の意味での継承を実装したければ,あるオブジェクトを決してその子孫より先に訪れてはならない. この場合,適切な検索順はa, b, c, dの順だ. どうすれば必ず子孫を先にして検索すると保証できるだろうか?\ 一番単純なのは,元のオブジェクトの先祖の一覧をリストにまとめ, それを適当にソートしてどのオブジェクトもその子孫より先に現れないようにし, そうしてから各要素を順に訪れる方法だ.

この戦略はget-ancestorsが使っているが, これは適切に並べ替えたオブジェクトとその先祖のリストを返す関数だ. リストをソートするとき,get-ancestorssortでなくstable-sortを呼んでいる. これは等しい高さにある先祖たちを並べ替えてしまう可能性を排除するためだ. ソートが済みのリストがあれば,rgetは求める属性を持った最初のオブジェクトを探すだけだ. (ユーティリティsome2は,someを, gethash等の検索の成功/失敗を第2返り値で示す関数と共に使うようにしたものだ.)

オブジェクトの先祖のリストは縁の近いものから遠いものへと並んでいる. orangecitrus(柑橘類)の子で,それがfruitの子のとき, リストは(orange citrus fruit)となる.

オブジェクトに複数の親があるとき,優先度は左から右の順になる. すなわち次のように書くと,

(setf (gethash 'parents x) (list y z))

継承される属性を探すとき,yzより先に調べることになる. 例えば「愛国心に溢れた(patriotic)チンピラ(scoundrel)」はあくまでもチンピラで, 「チンピラっぽい愛国者(patriot)」ではないのだとしよう. % 今どきチンピラという言葉は聞かないがscoundrel自身が「やや古」らしいんで...

> (setq scoundrel (make-hash-table)
        patriot (make-hash-table)
        patriotic-scoundrel (make-hash-table))
#<Hash-Table C4219E>
> (setf (gethash 'serves scoundrel) 'self       ; チンピラは自分自身のために生きる
        (gethash 'serves patriot) 'country      ; 愛国者は国に仕える
        (gethash 'parents patriotic-scoundrel)
          (list scoundrel patriot))
(#<Hash-Table C41C7E> #<Hash-Table C41F0E>)
> (rget patriotic-scoundrel 'serves)            ; 「愛国的チンピラ」は何に仕えるか?
SELF
T
(defun obj (&rest parents)
  (let ((obj (make-hash-table)))
    (setf (gethash 'parents obj) parents)
    (ancestors obj)
    obj))

(defun ancestors (obj)
  (or (gethash 'ancestors obj)
      (setf (gethash 'ancestors obj) (get-ancestors obj))))

(defun rget (obj prop)
  (some2 #'(lambda (a) (gethash prop a))
         (ancestors obj)))
\caption{オブジェクトを生成する関数.} \label{fig:FunctionToCreateObjects}

この骨組み段階のシステムに改善を加える. まずオブジェクトを生成する関数から始めよう. この関数はオブジェクトが生成される時点でオブジェクトの先祖のリストを作り上げる. 今はクエリが与えられた時点でリストを作るコードになっているが, それより早く作ってはいけない理由はない. \reffig{fig:FunctionToCreateObjects}では, 新しいオブジェクトを作り,その内部に先祖のリストを保持させる関数objを定義している. 先祖を内部に保持したことを活用するため,rgetも再定義した.

(defmacro defprop (name &optional meth?)
  `(progn
     (defun ,name (obj &rest args)
       ,(if meth?
            `(run-methods obj ',name args)
            `(rget obj ',name)))
     (defsetf ,name (obj) (val)
              `(setf (gethash ',',name ,obj) ,val))))

(defun run-methods (obj name args)
  (let ((meth (rget obj name)))
    (if meth
        (apply meth obj args)
        (error "No ~A method for ~A." name obj))))
\caption{関数風の構文.} \label{fig:FunctionalSyntax}

他に改善の余地があるのはメッセージ呼び出しの構文だ. tellそのものは必然性のない邪魔者で, そのせいで動詞が2番目に来るようになり,これでは普通のLispのような前置構文として読めない.

(tell (tell obj 'find-owner) 'find-owner)

tellを使う構文は, \reffig{fig:FunctionalSyntax}のように属性を同じ名前の関数として定義すれば取り除ける. オプショナル引数meth?が真のときはその属性はメソッドとして扱う. それ以外では属性はスロットとして扱われ,rgetの取ってきた値がそのまま返される. どちらの種類の属性でも,defpropに名前を与えると,

(defprop find-owner t)

その属性に関数呼び出しで参照できるようになり,再びコードがLisp風に読める.

(find-owner (find-owner obj))

こうして先程の例はいくらか読み易くなった.

> (progn
    (setq scoundrel (obj))
    (setq patriot (obj))
    (setq patriotic-scoundrel (obj scoundrel patriot))
    (defprop serves)
    (setf (serves scoundrel) 'self)
    (setf (serves patriot) 'country)
    (serves patriotic-scoundrel))
SELF
T

今の実装ではオブジェクトが持ち得るある名前のメソッドは高々一つだ. オブジェクトはそれ固有の,もしくは継承されたメソッドを持ち得る. ここで,固有のメソッドと継承されたメソッドを組み合わせられるような柔軟性を加えると便利だろう. 例えば何らかのオブジェクトのメソッドmoveについて, その親のメソッドmoveと同じものであってほしいが, その実行前や後に別のコードを実行したいことがある.

そのような可能性を許すため,プログラムを修正して beforeafteraroundの各メソッドを含めるようにする. beforeメソッドというのは「でも先にこれをやっといて」というものだ. 最も特定的なものから順に,他のメソッドの前座として実行される. afterメソッドというのは「付け足し:これもやってよ」というものだ. 最も特定的なものが最後になる順で,メソッド呼び出しのしんがりとして実行される. それらの間に,これまではメソッド本体であったものを実行する. それはこれから基本メソッドと呼ぶことにする. afterメソッドが後で呼び出されるときも,基本メソッドの返り値がメソッド全体の返り値になる.

before及びafterメソッドを使うことで基本メソッドの呼び出しを新たな動作で包める. aroundメソッドは同じことをするが,徹底したやり方になる. aroundメソッドが定義されていると基本メソッドの代わりにそちらが呼び出される. そこで判断次第ではaroundメソッド自身が基本メソッドを呼ぶこともあり得る (\reffig{fig:DefiningMethods}のcall-nextを経由する).

補助メソッドの実現のため, run-methodsrgetを\reffig{fig:AuxiliaryMethods}のように修正した. これまで,オブジェクトのメソッドを実行したときはただ一つの関数, 最も特定的な基本メソッドを実行しただけだった. つまり先祖のリストを辿って最初に見つけたメソッドを実行していた. 補助メソッドを考慮すると呼び出し手順は次のようになる.

  1. 最も特定的なaroundメソッド(どこかで定義されていれば).
  2. なければ,次の順に従う.
    1. 全てのbeforeメソッドを,最も特定的なものから順に.
    2. 最も特定的な基本メソッド(今まではこれだけを呼び出していた).
    3. 全てのafterメソッドを,最も特定的でないものから順に.

メソッドが,単一の関数でなく4つの部分に分かれた構造を持つことにも注意しよう. (基本)メソッドを定義するには,

(setf (gethash 'move obj) #'(lambda ...))

とするのではなく,次のようにする.

(setf (meth-primary (gethash 'move obj)) #'(lambda ...))

こういった理由から,次の目標はメソッドを定義するマクロの定義だ.

\reffig{fig:AuxiliaryMethods}にはそういうマクロの定義を示した. コードの大半はメソッドが他のメソッドの参照のために使う2つの関数の実装に充てられている. aroundメソッドと基本メソッドではcall-nextにより「次の」メソッドを呼び出せる. すなわちそのとき実行中のメソッドが存在しなかったときに実行されていたはずのコードだ. 例えば実行中のメソッドが唯一のaroundメソッドだったら, 「次の」メソッドはbeforeメソッド,最も特定的な基本メソッド, afterメソッドのサンドイッチだ. 最も特定的な基本メソッドの中では「次の」メソッドは2番目に特定的な基本メソッドだろう. call-nextの動作は呼ばれた場所によって異なるため, それをdefunでグローバルに定義することは決してなく, defmethで定義された各メソッドの内部でローカルに定義される.

(defstruct meth around before primary after)

(defmacro meth- (field obj)
  (let ((gobj (gensym)))
    `(let ((,gobj ,obj))
       (and (meth-p ,gobj)
            (,(symb 'meth- field) ,gobj)))))

(defun run-methods (obj name args)
  (let ((pri (rget obj name :primary)))
    (if pri
        (let ((ar (rget obj name :around)))
          (if ar
              (apply ar obj args)
              (run-core-methods obj name args pri)))
        (error "No primary ~A method for ~A." name obj))))

(defun run-core-methods (obj name args &optional pri)
  (multiple-value-prog1
    (progn (run-befores obj name args)
           (apply (or pri (rget obj name :primary))
                  obj args))
    (run-afters obj name args)))

(defun rget (obj prop &optional meth (skip 0))
  (some2 #'(lambda (a)
             (multiple-value-bind (val win) (gethash prop a)
               (if win
                   (case meth (:around (meth- around val))
                     (:primary (meth- primary val))
                     (t (values val win))))))
         (nthcdr skip (ancestors obj))))

(defun run-befores (obj prop args)
  (dolist (a (ancestors obj))
    (let ((bm (meth- before (gethash prop a))))
      (if bm (apply bm obj args)))))

(defun run-afters (obj prop args)
  (labels ((rec (lst)
                (when lst
                  (rec (cdr lst))
                  (let ((am (meth- after
                                   (gethash prop (car lst)))))
                    (if am (apply am (car lst) args))))))
    (rec (ancestors obj))))
\caption{補助メソッド.} \label{fig:AuxiliaryMethods}

aroundメソッドや基本メソッドはnext-pにより 「次の」メソッドが存在するかどうかを調べられる. 例えば親のないオブジェクトの基本メソッドを実行しているなら「次の」メソッドは存在しない. 次のメソッドがないときはcall-nextはエラーになるので, 普通は先にnext-pを呼んで調べておく必要がある. call-nextと同様,next-pは各メソッド内部でローカルに定義される.

新しいマクロdefmethは次のように使う. オブジェクトrectangle(矩形)にメソッドarea(面積)を定義したいときは次のようにする.

(setq rectangle (obj))
(defprop height)
(defprop width)
(defmeth (area) rectangle (r)
  (* (height r) (width r)))

するとインスタンスの面積は属するクラスのメソッドに従って算出される.

> (let ((myrec (obj rectangle)))
        (setf (height myrec) 2
              (width myrec) 3)
        (area myrec))
6
(defmacro defmeth ((name &optional (type :primary))
                   obj parms &body body)
  (let ((gobj (gensym)))
    `(let ((,gobj ,obj))
       (defprop ,name t)
       (unless (meth-p (gethash ',name ,gobj))
         (setf (gethash ',name ,gobj) (make-meth)))
       (setf (,(symb 'meth- type) (gethash ',name ,gobj))
             ,(build-meth name type gobj parms body)))))

(defun build-meth (name type gobj parms body)
  (let ((gargs (gensym)))
    `#'(lambda (&rest ,gargs)
         (labels
           ((call-next ()
                       ,(if (or (eq type :primary)
                                (eq type :around))
                            `(cnm ,gobj ',name (cdr ,gargs) ,type)
                            '(error "Illegal call-next.")))
            (next-p ()
                    ,(case type
                       (:around
                         `(or (rget ,gobj ',name :around 1)
                              (rget ,gobj ',name :primary)))
                       (:primary
                         `(rget ,gobj ',name :primary 1))
                       (t nil))))
           (apply #'(lambda ,parms ,@body) ,gargs)))))

(defun cnm (obj name args type)
  (case type
    (:around (let ((ar (rget obj name :around 1)))
               (if ar
                   (apply ar obj args)
                   (run-core-methods obj name args))))
    (:primary (let ((pri (rget obj name :primary 1)))
                (if pri
                    (apply pri obj args)
                    (error "No next method."))))))
\caption{メソッドの定義.} \label{fig:DefiningMethods}

さらに複雑な例として,オブジェクトfilesystemにメソッドbackupを定義したとしよう.

(setq filesystem (obj))
(defmeth (backup :before) filesystem (fs)
  (format t "Remember to mount the tape.~%"))
(defmeth (backup) filesystem (fs)
  (format t "Oops, deleted all your files.~%")
  'done)
(defmeth (backup :after) filesystem (fs)
  (format t "Well, that was easy.~%"))

普通,呼び出しは次のような順に従う.

> (backup (obj filesystem))
Remember to mount the tape.
Oops, deleted all your files.
Well, that was easy.
DONE

次にバックアップにかかる時間を計りたくなり,次のようなaroundメソッドを定義した.

(defmeth (backup :around) filesystem (fs)
  (time (call-next)))

するとfilesystemの子に対してbackupが呼ばれる度に, (さらに特定的なaroundメソッドが間に入らない限り)このaroundメソッドが呼ばれる. これが実行するコードはbackupが普通に呼び出されたときに実行するコードと同じだが, それをtimeの呼び出しの内部で実行する. timeの返り値がbackupの返り値になる.

> (backup (obj filesystem))
Remember to mount the tape.
Oops, deleted all your files.
Well, that was easy.
Elapsed Time = .01 seconds
DONE
(defmacro undefmeth ((name &optional (type :primary)) obj)
  `(setf (,(symb 'meth- type) (gethash ',name ,obj))
         nil))
\caption{メソッドの削除.} \label{fig:RemovingMethods}

ひとたび時間計測が済んでしまえばaroundメソッドは取り除きたい. それにはundefmeth(\reffig{fig:RemovingMethods})を呼ぶ. これにはdefmethの第1,第2引数と同じものを渡す.

(undefmeth (backup :around) filesystem)

他には,オブジェクトの先祖リストを変更したいときがある. しかしその変更後にはそのオブジェクトの全ての子について先祖リストを更新しなければならない. これまではオブジェクトからその子を得る方法を用意してなかったので, 属性childrenを追加しなければならない.

(defmacro children (obj)
  `(gethash 'children ,obj))

(defun parents (obj)
  (gethash 'parents obj))

(defun set-parents (obj pars)
  (dolist (p (parents obj))
    (setf (children p)
          (delete obj (children p))))
  (setf (gethash 'parents obj) pars)
  (dolist (p pars)
    (pushnew obj (children p)))
  (maphier #'(lambda (obj)
               (setf (gethash 'ancestors obj)
                     (get-ancestors obj)))
           obj)
  pars)

(defsetf parents set-parents)

(defun maphier (fn obj)
  (funcall fn obj)
  (dolist (c (children obj))
    (maphier fn c)))

(defun obj (&rest parents)
  (let ((obj (make-hash-table)))
    (setf (parents obj) parents)
    obj))
\caption{親と子へのリンクの管理.} \label{fig:MaintainingParentAndChildLinks}

\reffig{fig:MaintainingParentAndChildLinks}にはオブジェクトの親と子を操作するためのコードを示した. 親と子を求めるにはgethashでなくオペレータparentschildrenを使う. 後者はマクロなのでsetfに対して透過的だ. 前者は関数で,defsetfでそのインヴァージョンはset-parentsだと定義する. それが2重リンクの張り巡らされた世界で一貫性を保つために必要な手続きを全て行ってくれる.

部分ツリー内の全てのオブジェクトの祖先を更新するため, set-parentsmaphierを呼んでいる. これは継承の階層構造に対するmapcのようなものだ. mapcがリスト内の全ての要素について関数を呼ぶように, maphierはオブジェクトとその子孫全てについて関数を呼ぶ. それらが形成するのがツリーでない(グラフになっている)限り, 関数が同じオブジェクトについて複数回呼ばれ得る. しかしget-ancestorsは複数回呼ばれても全く同じ動作をするので, ここではそれは問題にならない.

こうしてオブジェクトの属性parentssetfを使うだけで 継承階層を変更できるようになった.

> (progn (pop (parents patriotic-scoundrel))
         (serves patriotic-scoundrel))
COUNTRY
T

階層構造に変更を加えると,影響のある子と先祖のリストが自動的に更新される. (子を直接操作するつもりはないが, set-parentsに似たset-childrenを定義するとそうなるかも知れない) \reffig{fig:MaintainingParentAndChildLinks}の最後には 新しいコードを使うよう再定義したobjも示した.

最後の改善としては,メソッド結合の新たな方法を指定できるようにする. 現在は最も特定的な基本メソッドだけが呼び出される (その中でcall-nextを使って他を呼び出せるけれど). そうではなく,オブジェクトの先祖各々の基本メソッドを組み合わせられるようにしたい. 例えばmy-orangeorangeの子で,それはcitrus(柑橘類)の子だとしよう. メソッドpropsが,citrusでは(round acidic)を, orangeでは(orange sweet)を, my-orangeでは(dented)を返すとき, (props my-orange)でそれらの値全ての合併 (dented orange sweet round acidic)を得られると便利だ.

(defmacro defcomb (name op)
  `(progn
     (defprop ,name t)
     (setf (get ',name 'mcombine)
           ,(case op
              (:standard nil)
              (:progn '#'(lambda (&rest args)
                           (car (last args))))
              (t op)))))

(defun run-core-methods (obj name args &optional pri)
  (let ((comb (get name 'mcombine)))
    (if comb
        (if (symbolp comb)
            (funcall (case comb (:and #'comb-and)
                       (:or #'comb-or))
                     obj name args (ancestors obj))
            (comb-normal comb obj name args))
        (multiple-value-prog1
          (progn (run-befores obj name args)
                 (apply (or pri (rget obj name :primary))
                        obj args))
          (run-afters obj name args)))))

(defun comb-normal (comb obj name args)
  (apply comb
         (mapcan #'(lambda (a)
                     (let* ((pm (meth- primary
                                       (gethash name a)))
                            (val (if pm
                                     (apply pm obj args))))
                       (if val (list val))))
                 (ancestors obj))))

(defun comb-and (obj name args ancs &optional (last t))
  (if (null ancs)
      last
      (let ((pm (meth- primary (gethash name (car ancs)))))
        (if pm
            (let ((new (apply pm obj args)))
              (and new
                   (comb-and obj name args (cdr ancs) new)))
            (comb-and obj name args (cdr ancs) last)))))

(defun comb-or (obj name args ancs)
  (and ancs
       (let ((pm (meth- primary (gethash name (car ancs)))))
         (or (and pm (apply pm obj args))
             (comb-or obj name args (cdr ancs))))))
\caption{メソッドの組み合わせ.} \label{fig:MethodCombination}

そうするには,メソッドが,最も特定的な基本メソッドの返り値をただ返すのではなく, 基本メソッド全ての返り値について何らかの関数を適用できるようにすればよい. \reffig{fig:MethodCombination}には,メソッド結合の方法を定義できるようにするマクロと, メソッド結合を行う新しいrun-core-methodsを示した.

あるメソッドについてのメソッド結合はdefcombで定義するが, これはメソッド名と結合方法を指定するための第2引数を取る. 普通はこの第2引数には関数を使うが, :progn, :and, :or, :standardのいずれかを与えてもよい. 最初の3つでは基本メソッドは対応するオペレータと同様に結合されるが, :standardでは基本的なメソッド結合のみが行われる.

\reffig{fig:MethodCombination}の中核は新しいrun-core-methodsだ. 呼ばれたメソッドに属性mcombineがなければ, メソッド呼び出しはこれまで通りに行われる. メソッドにmcombineがあるとき, その値は関数(+等)またはキーワード(:or)だ. 前者の場合,その関数は全ての基本メソッドの返り値から成るリストにそのまま適用される \footnote{このコードを改良するなら コンシングを避けるためにここでreduceを使ってもよい.}. 後者の場合,キーワードに関連付けられた関数で基本メソッドの返り値について反復を行う.

オペレータandorは \reffig{fig:MethodCombination}のように特別扱いする必要がある. それは単にそれらが特殊式だからというのではなく,短絡評価を行うせいだ.

> (or 1 (princ "wahoo"))
1

ここでは何も印字されない. orは非nilの引数を見つけた時点で制御を返すからだ. 同様に,or結合の対象となる基本メソッドは, それより特定的なメソッドが真値を返すときには決して呼ばれてはならない. andorでそのような短絡評価を実現するため, 関数comb-andcomb-orを別個に用意した.

上記の例を実現するには,次のようにする.

(setq citrus (obj))
(setq orange (obj citrus))

(setq my-orange (obj orange))

(defmeth (props) citrus (c) '(round acidic))
(defmeth (props) orange (o) '(orange sweet))
(defmeth (props) my-orange (m) '(dented))

(defcomb props #'(lambda (&rest args) (reduce #'union args)))

こうするとpropsは基本メソッド全ての返り値の合併を返す \footnote{propsの使うメソッド結合用関数はunionを呼ぶので, リストの要素は必ずしもこの順にはならない.}.

> (props my-orange)
(DENTED ORANGE SWEET ROUND ACIDIC)

ついでに言うと, この例はLispでオブジェクト指向プログラミングを行うときのみに生まれる選択肢を示唆している. 情報をスロットとメソッドのどちらに格納するか,ということだ.

その後でメソッドpropsに普通の動作に戻って欲しくなったら, ただメソッド結合を標準に戻せばよい.

> (defcomb props :standard)
NIL
> (props my-orange)
(DENTED)

before及びafterメソッドは標準メソッド結合でのみ実行されることに注意しよう. しかしaroundメソッドはこれまで同様に機能する.

この節で示したプログラムが意図しているのはモデルで, オブジェクト指向プログラミングの本物の基盤ではない. 効率ではなく簡潔さを求めて書かれている. そうは言っても実際に動作するモデルであり,実験やプロトタイプに使えるものだ. このプログラムをそういう目的に使うつもりが本当にあるなら, ちょっとした変更でずっと効率が上がる. 親が一つだけのオブジェクトで先祖リストを保持または算出しないことだ.

クラスとインスタンス

前節のプログラムは,あの程度の小さなプログラムでできる限りCLOSに似せて書かれた. それを理解することでCLOSの理解はすでにかなり進んだことになる. 以降の数節ではCLOS自体を取り上げる.

我々の「スケッチ」ではクラスとインスタンス,またはスロットとメソッドについて 構文上の区別を一切していなかった. CLOSではクラスの定義にはマクロdefclassを使い,スロットも同時に宣言する.

(defclass circle ()
  (radius center))

この式は,クラスcircleはスーパークラスを持たず, 2個のスロットradiuscenterを持つことを示している. クラスcircleのインスタンスを作るには次のようにする.

(make-instance 'circle)

circleのインスタンスのスロットを参照する方法を定義してないので, 寂しいことに,これから作られるインスタンスはどれもかなり不活性なものだ. スロットを参照するにはアクセサ関数を定義する.

(defclass circle ()
  ((radius :accessor circle-radius)
   (center :accessor circle-center)))

するとcircleのインスタンスを作ったとき, そのインスタンスのスロットradiuscenterは 対応するアクセサ関数にsetfを使うことで値を設定できる.

> (setf (circle-radius (make-instance 'circle)) 2)
2

このような初期化はmake-instanceを呼ぶと同時に行うこともできる. それができるようにスロットを定義すればよい.

(defclass circle ()
  ((radius :accessor circle-radius :initarg :radius)
   (center :accessor circle-center :initarg :center)))

スロット定義内のキーワード:initargは その次の引数がmake-instanceのキーワード引数になることを指定する. キーワード引数の値がスロットの初期値になる.

> (circle-radius (make-instance 'circle
                                :radius 2
                                :center '(0 . 0)))
2

:initformを定義することでスロットが自分自身を初期化するように定義できる. クラスshapeのスロットvisibleは,

(defclass shape ()
  ((color   :accessor shape-color   :initarg :color)
   (visible :accessor shape-visible :initarg :visible
            :initform t)))

既定値tを持つ.

> (shape-visible (make-instance 'shape))
T

スロットにinitarginitformが両方あるとき, initargを指定するとそちらが優先する.

> (shape-visible (make-instance 'shape :visible nil))
NIL

スロットはインスタンスとサブクラスに継承される. あるクラスが複数のスーパークラスを持つとき,それらのスロットの合併が継承される. クラスscreen-circlecircleshape両方のサブクラスとして定義すると,

(defclass screen-circle (circle shape)
  nil)

screen-circleのインスタンスは,スロットを2つずつ継承して4つ持つことになる. クラスは必ずしも新しく独自のスロットを作る必要はないことに注意しよう. クラスscreen-circlecircleshapeの両方から性質を継承したインスタンスを 提供するためだけに存在している.

アクセサとinitargsscreen-circleのインスタンスに及ぼす影響は, circleshapeのインスタンスに及ぼす影響と全く同じだ.

> (shape-color (make-instance 'screen-circle
                              :color 'red :radius 3))
RED

defclassのスロットcolorinitformを指定することで screen-circleの各インスタンスに色の初期値を持たせることができる.

(defclass screen-circle (circle shape)
  ((color :initform 'purple)))

これでscreen-circleのインスタンスは初めから紫色になる.

> (shape-color (make-instance 'screen-circle))
PURPLE

ただしinitarg:colorで陽に指定することでスロットを初期化することも 依然として可能だ.

我々の作ったオブジェクト指向プログラミングの「スケッチ」では インスタンスは値を親クラスのスロットから直接継承していた. CLOSではインスタンスの持つスロットはクラスのそれとは意味が異なる (訳注:ここではクラスも一種のオブジェクトだというのが暗黙の前提). 親クラスでinitformを定義することで,継承された初期値をインスタンスに定義する. ある意味ではこちらの方が柔軟だ. initformには,定数の他に,評価される毎に違う値を返す式を使えるからだ.

(defclass random-dot ()
  ((x :accessor dot-x :initform (random 100))
   (y :accessor dot-y :initform (random 100))))

random-dotのインスタンスを作る度にx及びy座標は0から99のランダムな整数で初期化される.

> (mapcar #'(lambda (name)
              (let ((rd (make-instance 'random-dot)))
                (list name (dot-x rd) (dot-y rd))))
          '(first second third))
((FIRST 25 8) (SECOND 26 15) (THIRD 75 59))

我々の「スケッチ」では,値がインスタンス毎に異なるスロットと クラスの全てのインスタンスで等しい値を持つスロットの区別もしていなかった (訳注:C++等で言うstaticメンバのこと). CLOSではこれこれのスロットが共有されると指定することができる. つまりその値は全てのインスタンスで等しくなる. そうするにはスロットの宣言に:allocation :classを含める. (対になるのはスロットに:allocation :instanceを指定することだが, そちらが既定値なので明示的に書く理由はない.) 例えば全てのフクロウ(owl)が夜行性(nocturnal)ならば, クラスowlのスロットnocturnalを共有スロットとして初期値tを与える.

(defclass owl ()
  ((nocturnal :accessor owl-nocturnal
              :initform t
              :allocation :class)))

こうすればクラスowlの全てのインスタンスがこのスロットを継承する.

> (owl-nocturnal (make-instance 'owl))
T

あるインスタンスのこのスロットの「ローカルな」値を変更するとき, 実際にはクラスの保持する値を変更している.

> (setf (owl-nocturnal (make-instance 'owl)) 'maybe)
MAYBE
> (owl-nocturnal (make-instance 'owl))
MAYBE

これは混乱の元になり得るので,そのようなスロットは読み取り専用にしたいことがある. スロットに対するアクセサ関数を定義するとき, スロットの値を読み取る方法と変更する方法の両方を作っていることになる. 値を読み取れるが変更不可にしたいとき, スロットには両機能を持つアクセサ関数でなくリーダ関数のみを定義すればよい.

(defclass owl ()
  ((nocturnal :reader owl-nocturnal
              :initform t
              :allocation :class)))

するとインスタンスのスロットnocturnalを変更しようとするとエラーになる.

> (setf (owl-nocturnal (make-instance 'owl)) nil)
>>Error: The function (SETF OWL-NOCTURNAL) is undefined.

メソッド

我々の「スケッチ」はレキシカル・クロージャを提供するプログラミング言語での スロットとメソッドとの類似性を強調している. 我々のプログラムでは基本メソッドはスロットの値と同様に保持され,継承されていた. スロットとメソッドの唯一の違いは,次のようにしてスロットをある名前で定義すると,

(defprop area)

単に値を求めて返す関数areaが作られることだ. しかし次のようにしてそれをメソッドとして定義すると,

(defprop area t)

値を求めた後にそれを引数に対してfuncallする関数areaが作られる. CLOSでも関数の役割をするものはやはりメソッドと呼ばれており, それら各々があるクラスの属性のように見えるように定義できる. ここではクラスcircleにメソッドareaを定義する.

(defmethod area ((c circle))
  (* pi (expt (circle-radius c) 2)))

このメソッドの仮引数リストによれば, これはクラスcircleのインスタンスに適用される1引数関数だと分かる.

このメソッドは関数のように呼び出せる. 我々の「スケッチ」と全く同様だ.

> (area (make-instance 'circle :radius 1))
3.14...

さらに引数を取るメソッドも定義できる.

(defmethod move ((c circle) dx dy)
  (incf (car (circle-center c)) dx)
  (incf (cdr (circle-center c)) dy)
  (circle-center c))

このメソッドをcircleのインスタンスに対して呼び出すと, その中心がdx, dyだけ移動する.

> (move (make-instance 'circle :center '(1 . 1)) 2 3)
(3 . 4)

このメソッドの返り値はcircleオブジェクトの新たな位置を反映している.

我々の「スケッチ」と同様に,あるインスタンスのクラスに対してメソッドが定義されており, そのクラスのスーパークラスにも定義されていたら,最も特定的なものが実行される. よってもしunit-circlecircleのサブクラスで, 次のように定義されたメソッドareaを持っていたら,

(defmethod area ((c unit-circle)) pi)

unit-circleのインスタンスに対してareaを呼ぶと, より一般的なメソッドではなくこのメソッドが実行される.

クラスに複数のスーパークラスが存在するとき,それらの優先度は左から右の順だ. クラスpatriotic-scoundrel(愛国心溢れるチンピラ)を次のように定義すると,

(defclass scoundrel nil nil)
(defclass patriot nil nil)
(defclass patriotic-scoundrel (scoundrel patriot) nil)

それは第一にチンピラなのであって,チンピラっぽい愛国者ではないと定めたことになる. 複数のスーパークラスに適用可能なメソッドが存在するとき,

(defmethod self-or-country? ((s scoundrel))
  'self)

(defmethod self-or-country? ((p patriot))
  'country)

クラスscoundrel(チンピラ)のメソッドが実行される.

> (self-or-country? (make-instance 'patriotic-scoundrel))
SELF

ここまでの例はCLOSのメソッドがあるオブジェクトの持つメソッドだと言う幻想を 壊すことはなかった. しかし実はそれらにはさらに一般性がある. メソッドmoveの引数リストで, (c circle)という部分は特定化された仮引数と呼ばれる. このメソッドは第1引数がクラスcircleのインスタンスのときに適用されることを示す. CLOSのメソッドでは複数の仮引数で特定化ができる. 次のメソッドは特定化された仮引数を2つ,オプショナルな特定化されていない仮引数を1つ持つ.

(defmethod combine ((ic ice-cream) (top topping)
                    &optional (where :here))
  (append (list (name ic) 'ice-cream)
          (list 'with (name top) 'topping)
          (list 'in 'a
                (case where
                  (:here 'glass)
                  (:to-go 'styrofoam))
                'dish)))

これは最初の2つの引数が それぞれice-creamtoppingのインスタンスのときに呼び出される. インスタンスを作るために必要な最小限のクラスを定義しておけば,

(defclass stuff () ((name :accessor name :initarg :name)))
(defclass ice-cream (stuff) nil)
(defclass topping (stuff) nil)

このメソッドを定義し,実行してみることができる.

> (combine (make-instance 'ice-cream :name 'fig)
           (make-instance 'topping :name 'olive)
           :here)
(FIG ICE-CREAM WITH OLIVE TOPPING IN A GLASS DISH)

メソッドが複数の引数を特定化しているとき, それをあるクラスの属性とみなし続けることは無理がある. 上のメソッドcombineは,クラスice-creamに属しているのだろうか, それともクラスtoppingだろうか? CLOSではメッセージに反応するオブジェクトというモデルは呆気なく消え去ってしまう. そのモデルは,メソッド呼び出しを次のようにする限りは自然に思える.

(tell obj 'move 2 3)

ここでは明らかにobjのメソッドmoveを呼び出している. しかしこの構文を捨てて関数風にしてしまうと,

(move obj 2 3)

第1引数についてディスパッチを行うようにmoveを定義しなければならない. すなわち第1引数の種類を見て適切なメソッドを呼び出すようにする.

この段階に至ると次の疑問が頭をもたげる. なぜディスパッチが行えるのは第1引数のみなのだろう? CLOSの答え:さあ,そんな理由あるんでしょうか. CLOSではメソッドは任意個の仮引数を特定化できる. そしてそれはユーザ定義のクラスのみではなく,Common Lisp組込みの型でも \footnote{正確に言えば, 「Common Lispの型階層と対応するようにCLOSで定義済みのクラスに対しても」ということだ.}, それどころか個々のオブジェクトに対しても可能だ. 次には文字列に適用されるメソッドcombineを示す.

(defmethod combine ((s1 string) (s2 string) &optional int?)
  (let ((str (concatenate 'string s1 s2)))
    (if int? (intern str) str)))

これは,もうメソッドはクラスの属性ではないというだけでなく, クラスを一切定義せずともメソッドを使えるということでもある.

> (combine "I am not a " "cook.")
"I am not a cook."

次では第2仮引数がシンボルpalindromeに対して特定化されている.

(defmethod combine ((s1 sequence) (x (eql 'palindrome))
                                  &optional (length :odd))
  (concatenate (type-of s1)
               s1
               (subseq (reverse s1)
                       (case length (:odd 1) (:even 0)))))

このメソッドは任意のシークェンスの要素を回文(palindrome)にする. \footnote{ある(このことさえなければ)優れたCommon Lispの実装では concatenateがコンスを第1引数に受け付けず,上の例は機能しない.}

> (combine '(able was i ere) 'palindrome)
(ABLE WAS I ERE I WAS ABLE)

この時点で,オブジェクト指向プログラミングではなく,より一般的なものを我々は手にしている. メソッドの下にはディスパッチという概念があり, それは複数の引数に対して行うことができ, それが基づくのは引数のクラスだけに留まらないという理解の下でCLOSは作られた. メソッドがこの一般的な概念の上に構築されたとき,個々のクラスから独立したものとなる. メソッドは概念的にクラスに密着するのでなく,同じ名前の他のメソッドに密着するようになる. CLOSではそのようなメソッドの集まりをジェネリック関数と呼ぶ. ここまで定義してきた複数のメソッドcombineは 暗黙のうちにジェネリック関数combineを定義していたのだ.

ジェネリック関数はマクロdefgenericで明示的に定義することもできる. ジェネリック関数を定義するためにはdefgenericを呼び出すことは必須ではない. しかしドキュメントやエラー対策の安全ネットを入れるのに都合のよい場所だ. ここでは両方を行ってみた.

(defgeneric combine (x y &optional z)
  (:method (x y &optional z)
    "I can't combine these arguments.")
  (:documentation "Combines things."))

combine内で定義されたメソッドはどの引数も特定化していないので, 他に適用可能なメソッドがない場合に呼ばれる.

> (combine #'expt "chocolate")
"I can't combine these arguments."

こうする前にはこのような呼び出しはエラーになっていたところだ.

ジェネリック関数は,メソッドがオブジェクトの属性だったときにはなかった制限を一つ課す. 名前が同じ全てのメソッドが一つのジェネリック関数にまとめられるとき, 引数リストが一致しなければならない. メソッドcombineのいずれにもオプショナル引数が伴っていたのはそのせいだ. 引数を3個まで取る最初のメソッドcombineを定義した後は, 引数を2個しか取らないcombineを定義しようとするとエラーになる.

CLOSは名前が同じ全てのメソッドの引数リストが合同でなければならないと要求する. 引数リストが合同なのは,同数の必須引数とオプショナル引数を持ち, さらに&rest&keyの用法に互換性がある場合だ. 異なるメソッドが受け付ける実際のキーワード引数は必ずしも同じでなくともよいが, defgenericによって 全てのメソッドが最低限受け付けるキーワード引数の集合を定めることもできる. 以下の引数リストの対はいずれも合同だ.

(x)              (a)
(x &optional y)  (a &optional b)
(x y &rest z)    (a b &rest c)
(x y &rest z)    (a b &key c d)

また,以下の対はいずれも合同でない.

(x)              (a b)
(x &optional y)  (a &optional b c)
(x &optional y)  (a &rest b)
(x &key x y)     (a)

メソッドの再定義は関数の再定義と全く同様だ. 必須引数のみが特定化できるので, 各メソッドはそれが属するジェネリック関数と必須引数の型により一意に同定される. 同じ特定化方法を持つ別のメソッドを定義すると元のメソッドが上書きされる. よって次のようにすると,

(defmethod combine ((x string) (y string)
                    &optional ignore)
  (concatenate 'string x "+"y))

第1,第2引数が文字列の場合のcombineの動作を再定義したことになる.

(defmacro undefmethod (name &rest args)
  (if (consp (car args))
      (udm name nil (car args))
      (udm name (list (car args)) (cadr args))))

(defun udm (name qual specs)
  (let ((classes (mapcar #'(lambda (s)
                             `(find-class ',s))
                         specs)))
    `(remove-method (symbol-function ',name)
                    (find-method (symbol-function ',name)
                                 ',qual
                                 (list ,@classes)))))
\caption{メソッドを削除するマクロ.} \label{fig:MacroForRemovingMethods}

メソッドを再定義するのでなく削除したいとき, 残念なことにdefmethodの逆の働きのオペレータは組込みで用意されていない. 幸運なことにこれはLispなので,自分で書くことができる. 手動でメソッドを削除する方法の詳細は\reffig{fig:MacroForRemovingMethods}の undefmethodの実装に要約されている. このマクロを使うにはdefmethodに渡すものと似た引数を渡す. ただし第2または第3引数に引数リスト全体を渡すのでなく,必須引数のクラス名のみを渡す. よって2つの文字列に対するメソッドcombineを削除するには次のようにする.

(undefmethod combine (string string))

特定化されていない引数は暗黙のうちにクラスtとなるので, 必須だが特定化されていない仮引数を持つメソッドを定義していたら,

(defmethod combine ((fn function) x &optional y)
  (funcall fn x y))

次のようにすることでそれを削除できる.

(undefmethod combine (function t))

ジェネリック関数全体を削除したいときは, どのような関数の定義を削除するときとも同じようにfmakunboundを呼ぶ.

(fmakunbound 'combine)

補助メソッドとメソッド結合

我々の「スケッチ」では補助メソッドは大体CLOSと同様に機能していた. これまで基本メソッドだけを見てきたが, beforeafteraroundの各メソッドも使える. そのような補助メソッドは, defmethodの呼び出しでメソッド名の後に限定キーワードを付けて定義する. 基本メソッドspeakをクラスspeakerに対して次のように定義したとき,

(defclass speaker nil nil)

(defmethod speak ((s speaker) string)
  (format t "~A" string))

speakspeakerのインスタンスに対して呼び出すと,第2引数が単に印字されるだけだ.

> (speak (make-instance 'speaker)
         "life is not what it used to be")
life is not what it used to be
NIL

before及びafterメソッドで基本メソッドspeakを包むような サブクラスintellectual(知的階層の人)を定義すると,

(defclass intellectual (speaker) nil)

(defmethod speak :before ((i intellectual) string)
  (princ "Perhaps "))

(defmethod speak :after ((i intellectual) string)
  (princ " in some sense"))

必ず最初と最後に言葉を付け加えるようなspeakerのサブクラスが実現できる.

> (speak (make-instance 'intellectual)
         "life is not what it used to be")
Perhaps life is not what it used to be in some sense
NIL

標準メソッド結合ではメソッドは我々の「スケッチ」で説明したのと同じように呼ばれる. beforeメソッドが最も特定的なものから順に呼ばれ, 最も特定的な基本メソッドが呼ばれ, afterメソッドが最も特定的でないものから順に呼ばれる. よってスーパークラスのspeakerbeforeまたはafterメソッドを定義すると,

(defmethod speak :before ((s speaker) string)
  (princ "I think "))

それらはサンドイッチの間で呼ばれる.

> (speak (make-instance 'intellectual)
         "life is not what it used to be")
Perhaps I think life is not what it used to be in some sense
NIL

どのbeforeまたはafterメソッドが呼ばれるかに関わらず, ジェネリック関数の返り値は最も特定的な基本メソッドの返り値だ. この場合ではformatの返したnilになる.

aroundメソッドがある場合には話が変わる. オブジェクトの先祖ツリーのうちのあるクラスにaroundメソッドがあるとき ---正確に言えばジェネリック関数の引数に対し特定化されたaroundメソッドがあるとき, aroundメソッドが最初に呼ばれ, メソッドの残りの部分はaroundメソッドで実行すると判断したときのみ実行される. 我々の「スケッチ」と同様, aroundまたは基本メソッドは関数によって次のメソッドを呼び出せる. 「スケッチ」でのcall-nextに当たるものはCLOSではcall-next-methodと呼ばれる. さらにnext-pと同様のnext-method-pもある. aroundメソッドを使うと さらにもって回った言い方をするspeakerのサブクラスが作れる.

(defclass courtier (speaker) nil)

(defmethod speak :around ((c courtier) string)
  (format t "Does the King believe that ~A? " string)
  (if (eq (read) 'yes)
      (if (next-method-p) (call-next-method))
      (format t "Indeed, it is a preposterous idea.~%"))
  'bow)

speakの第1引数がクラスcourtier(廷臣)のインスタンスのとき, その発言はaroundメソッドが担当する.

> (speak (make-instance 'courtier) "kings will last")
Does the King believe that kings will last? yes          ; 王は王制が続くとお信じだろうか
I think kings will last                                  ; 私は王制は続くと思います
BOW
> (speak (make-instance 'courtier) "the world is round")
Does the King believe that the world is round? no        ; 王は地球が丸いとお信じだろうか
Indeed, it is a preposterous idea.                       ; 実際,馬鹿げた考えですな
BOW

beforeまたはafterメソッドと異なり, aroundメソッドの返り値がジェネリック関数の返り値になる.

一般にメソッドは次のように実行される(第25-2節でも示した).

  1. 最も特定的なaroundメソッド(どこかで定義されていれば).
  2. なければ,次の順に従う.
    1. 全てのbeforeメソッドを,最も特定的なものから順に.
    2. 最も特定的な基本メソッド.
    3. 全てのafterメソッドを,最も特定的でないものから順に.

このようにメソッドを組み合わせる方法を標準メソッド結合と呼ぶ. 我々の「スケッチ」と同様, それとは別の方法で結合されるメソッドを定義することもできる. 例えばジェネリック関数が適用可能な基本メソッドの返り値全ての和を返すようにできる.

我々のプログラムではメソッドの組み合わせ方はdefcombを呼ぶことで指定した. 始めはメソッドは上記の概要に従って組み合わされるが,例えば次のようにすることで,

(defcomb price #'+)

関数priceが適用可能な全てのメソッドの和を返すようにできる.

CLOSではこれをオペレータメソッド結合と呼ぶ. 我々のプログラムと同様,そのようなメソッド結合はLispの式を評価するのだと理解できる. その式の第1要素は何らかのオペレータで, 引数は(特定的な順に並べた)適用可能な基本メソッドの呼び出しになっているのだ. 値を+で結合するようにジェネリック関数priceを定義してあり, 適用可能なaroundメソッドがなければ, その動作はちょうど次のように定義されたと思えばよい.

(defun price (&rest args)
  (+ (apply <最も特定的な基本メソッド> args)
       ...
     (apply <最も特定的でない基本メソッド> args)))

適用可能なaroundメソッドがあるときは,標準メソッド結合と同様にそちらが優先になる. オペレータメソッド結合の下では, aroundメソッドはやはり次のメソッドをcall-next-methodで呼び出せる. しかし基本メソッドはcall-next-methodを使えない. (ここには我々の「スケッチ」と違いがある. そのようなメソッドでもcall-nextは使えるままになっていた.)

CLOSではジェネリック関数の使うメソッド結合の種類を defgenericのオプショナル引数:method-combinationで指定できる.

(defgeneric price (x)
  (:method-combination +))

するとメソッドpriceはメソッド結合に+を使う. 値段を持つクラスを何か定義するとき,

(defclass jacket nil nil)
(defclass trousers nil nil)
(defclass suit (jacket trousers) nil)

(defmethod price + ((jk jacket)) 350)
(defmethod price + ((tr trousers)) 200)

suitのインスタンスの価値を求めると,適用可能なメソッドpriceの和が得られる.

> (price (make-instance 'suit))
550

以下のシンボルがdefmethodの第2引数や defgenericのオプション:method-combinationの値に使える.

+ and append list max min nconc or progn

define-method-combinationを呼ぶことでさらに別のメソッド結合が定義できる. 詳細はCLtL2の830ページを参照すること.

ジェネリック関数の従うメソッド結合を一旦指定すると, そのジェネリック関数の全てのメソッドで同じようにしなければならない. priceを定義するdefmethodの第2引数に別のオペレータ (または:before:after)を使おうとするとエラーになる. priceに使われるメソッド結合を本当に変えたいなら, fmakunboundを呼んでジェネリック関数全体を削除しなければならない.

CLOSとLisp

CLOSは埋め込み言語のよい例になっている. 普通,こういったプログラムには利点が2つある.

  1. 埋め込み言語は,その中でも変わらない概念で思考を続けることができるように, その環境と概念的に深く統合することができる.
  2. 埋め込み言語は,基盤の言語がすでに扱えることを全て活用できるので,強力になり得る.

CLOSはどちらでも成功している. Lispとは非常によく統合されており, さらにLispの元々持っていた抽象化技法をうまく活用している. 実際,LispはしばしばCLOS越しに見ることができる. オブジェクトの貌を,それを覆うシートを通して見る感じだ.

普通,マクロの層を通じてCLOSを扱うのは偶然ではない. マクロは変換を行うし, CLOSは,本質的には,オブジェクト指向の抽象化技法に従うプログラムを取って Lispの抽象化技法に従うプログラムに翻訳するプログラムだ.

25-1, 2節で示唆したように, オブジェクト指向プログラミングの抽象化技法は見事にLispのそれに対応させることができ, 前者を後者の特別な場合と呼ぶこともできそうな位だ. オブジェクト指向プログラミングのオブジェクトはLispのオブジェクトとして, またそのメソッドはクロージャとして容易に実装できる. そのような同型写像の活用により, 原始的なオブジェクト指向プログラミングをコード数行で, またCLOSのスケッチを数ページで実現できた.

CLOSは我々の「スケッチ」より遥かに巨大で強力だが, 埋め込み言語としての本性を隠す程には至らない. defmethodを例に取ろう. CLtL2では明言こそしていないが,CLOSのメソッドにはレキシカルクロージャの持つ力が全て備わっている. ある変数のスコープ内で複数のメソッドを定義すると,

(let ((transactions 0))
  (defmethod withdraw ((a account) amt)
    (incf transactions)
    (decf (balance a) amt))
  (defmethod deposit ((a account) amt)
    (incf transactions)
    (incf (balance a) amt))
  (defun transactions ()
    transactions))

実行時には変数へのアクセスがクロージャ同様に共有される. メソッドでこれができるのは,構文の裏側ではそれらはクロージャだからだ. defmethodの展開形では, その本体はシャープ・クォート付きλ式の本体内にそのまま出てくる.

第7-6節では,マクロの動作を理解する方が意味を認識するより容易だと指摘した. 同様に,CLOSを理解する鍵はそれがどのようにLispの基本的抽象化構造に対応するかを理解することだ.

いつオブジェクトを使うのか

オブジェクト指向スタイルは幾つかの異なる利点をもたらす. その利点をどの程度必要とするかはプログラム毎に異なる. 連続スペクトルの一端には,オブジェクト指向による抽象化で最も自然に表現されるプログラム ---例えばシミュレーション--- がある. もう一端には,主に拡張可能にするためにオブジェクト指向スタイルで書かれたプログラムがある.

実際,拡張性はオブジェクト指向スタイルの最大の利点の一つだ. プログラムは単一のモノリシックなコードの塊になるのではなく, 小さい部品毎に書かれ,各々に目的に従ってラベルが付く. よって後日,誰か別の人がプログラムを修正したいと思ったとき,変更の必要な部分は容易に見つかる. タイプobのオブジェクトの画面への表示方法を変更したいと思ったら, クラスobのメソッドdisplayを変更すればよい. obと似ているが幾つかの点で異なる,オブジェクトの新しいクラスを作りたいと思ったら, obのサブクラスを作ればよい. サブクラス内では望みの属性に変更ができ,残りは全てデフォルトでクラスobから継承される. またobの一つのオブジェクトだけを残りと違う挙動にしたいなら, obの子を作って子の属性を直接修正すればよい. プログラムが始めから注意して書かれていたら, コードの他の部分を見もせずにどのような修正でも行える. この観点からすると,オブジェクト指向プログラムとは表のように構成されたプログラムだ. 適切な項目を探すことで直ちに安全に変更できる.

拡張性のためにオブジェクト指向スタイルが必要になる,ということはまずない. 実際,拡張可能なプログラムはオブジェクト指向である必要は全くない. 前の章で示したのは, Lispプログラムがモノリシックなコードの塊である必然性はないということに過ぎない. Lispは拡張性のあらゆる選択肢を提供する. 例えば,正に文字通り表のように構成されたプログラムが書ける. 配列に保持したクロージャの集合から成るプログラムだ.

必要なのが拡張性なら, 「オブジェクト指向」プログラムと「伝統的」プログラムの間で選択を行う必要はない. Lispプログラムには,オブジェクト指向の技法に頼らずに, 必要としているだけの拡張性を与えることができることが多い. クラス内のスロットはグローバル変数だ. 仮引数を使えるところでグローバル変数を使うのがエレガントでないのと全く同様, 素のLispで労力をかけずに同じことができるときには, クラスとインスタンスの世界を構築するのはエレガントではない. CLOSが追加されたことで Common Lispは広く利用されているプログラミング言語のうち最も強力なオブジェクト指向言語になった. 皮肉なことに,オブジェクト指向言語の必要性が一番低い言語でもある.


←: Prolog     ↑: On Lisp     →: パッケージ

Copyright (c) 2003-2011 野田 開     NODA Kai <nodakai@gmail.com>