多重継承
最近では目にすることは少なくなりましたが、単一継承がよいか多重継承がよいかという議論が一昔前にはありました。多重継承も継承しているクラス定義が重複していたときにどちらを優先させるかという話で例外をもちだすと話が混乱してくるだけで、原則の簡単なルールに乗っていさえすれば複雑なことにはなりません。
今回作ろうとしているオブジェクト指向の枠組みも CLOS と同じ優先順位で多重継承をサポートします。多重継承を行いたい場合、継承元をリストで並べて記述します。この際左側に書いたものが、優先順位が高くなります。下図のような場合、まず継承リストの左側の ClassB の継承ルートがたどられ、その後に右側の ClassC が来ます。
これだけならば単純な話ですが、確認しておきたいのが同じ親を持つもの同士を継承した場合です。この場合は、共通する部分の優先順位はより後ろに回されます。下図のようになっている場合、最初に継承リストの左側の ClassB が参照されることに変わりませんが、ClassA は ClassB と ClassC のルートで共通する部分なので後に回され、ClassC の優先順位が高くなります。
このルールに則って、継承の優先順位リストを前回のクラス定義から作成する inheritance-rank 関数を作ります。delete-duplicates 関数はリストの中から重複したものを削除する関数ですが、後ろにあるものを残して重複を削除します。
(defun delete-duplicates (alist)
(if alist
(if (member (car alist) (cdr alist))
(delete-duplicates (cdr alist))
(cons (car alist) (delete-duplicates (cdr alist)))
)
)
)
(defun inheritance-rank:sub (className)
(if className
(cons
className
(apply 'append
(mapcar 'inheritance-rank:sub
(nth 1 ;|parents|; (vl-symbol-value className))
)
)
)
)
)
(defun inheritance-rank (className)
(delete-duplicates (inheritance-rank:sub className))
)
前回でも示した例で次のような場合は、soops:bats → soops:mammals → soops:birds → soops:animal という優先順位となります。
(class 'soops:birds '(soops:animal) nil)
(class 'soops:mammals '(soops:animal) nil)
(class 'soops:bats '(soops:mammals soops:birds) '((type . "BATS")))
_$ (inheritance-rank 'soops:bats)⏎
(SOOPS:BATS SOOPS:MAMMALS SOOPS:BIRDS SOOPS:ANIMAL)
この優先順位リストを参照しながら、多重継承をサポートしたインスタンスの作成とメソッドの呼び出しを実現します。
オブジェクトハンドル
インスタンスを生成した場合これを適当な変数に代入して扱うわけですが、以降のプロパティアクセスやメソッド呼び出しでオブジェクトの状態が変化する場合があります。むしろオブジェクトとしては変化するのが普通です。Lisp の関数の引数は元の変数のコピーでしたので、状態が変化するオブジェクトの操作を行うにはリストを保持するシンボル名を渡す必要があります。しかしシンボル名を渡すようにいちいち変数名をクォートしたりするのは煩雑で間違いが起きやすくなります。そのため、自動的に生成した *SOOPS:HND-2* などといったシンボル名にインスタンスを代入しておき、そのシンボル名を適当な変数、下の例では abat に代入しておけば、その変数を通常のオブジェクトのような操作感で扱うことができます。
この *SOOPS:HND-2* といったシンボル名を自動的に生成して与えられたデータを代入してから返す関数を次のように用意しておきます。
(setq *soops:handleCount* 0)
(defun soops:getHandle (data / handle)
(while (boundp
(setq
handle (read
(strcat "*soops:HND-" (itoa *soops:handleCount*) "*")
)
)
)
(setq *soops:handleCount* (1+ *soops:handleCount*))
)
(set handle data)
handle
)
インスタンス生成と解放
インスタンスのデータは、次のようなリストの構造で表すこととします。
インスタンスを生成する関数 instance は次のようになります。優先順位に沿ってクラス定義を見ていきながら、プロパティの初期値が与えられていればその値に、初期値が無ければデフォルトの値でインスタンスを初期化します。
(defun instance:collect-property (className / cell property)
(foreach cell (nth 2 ;|layout|; (vl-symbol-value className))
(cond ((assoc (car cell) collection))
((setq property (assoc (car cell) initial-values))
(setq collection (cons property collection)
initial-values (vl-remove property initial-values)
)
)
(T
(setq collection
(cons (cons (car cell) (eval (cdr cell)))
collection
)
)
)
)
)
)
(defun instance (className initial-values / aclass collection)
(foreach aclass (inheritance-rank className)
(instance:collect-property aclass)
)
(soops:getHandle (cons className collection))
)
instance 関数の戻り値は、 *SOOPS:HND-2* といったオブジェクトハンドルです。
関数の使用例は以下の通りです。
_$ (setq adog (instance 'soops:mammals '((type . "DOGS"))))⏎
*SOOPS:HND-0*
_$ (setq ahawk (instance 'soops:birds '((type . "HAWKS"))))⏎
*SOOPS:HND-1*
_$ (setq abat (instance 'soops:bats nil))⏎
*SOOPS:HND-2*
なお、*SOOPS:HND-2* といったオブジェクトハンドルはグローバル変数として実行環境に存在しています。そのため、オブジェクトが不要になっても*SOOPS:HND-2* というシンボルとその値のリストは存続し続けますので、オブジェクトを解放するにあたる操作を行わなければなりません。次の関数は、与えられたオブジェクトを解放します。ハンドルのシンボルに nil を代入しているだけですが、nil を代入されたシンボルは未定義の状態に戻ります。
(defun free (handle) (set handle nil))
プロパティアクセス
プロパティアクセスについては、インスタンスのプロパティ値の連想リストを読んだり書き換えたりするだけですので、やらなければならないことは単純です。しかし、オブジェクトとして与えられたものは先の *SOOPS:HND-2* といったシンボル名になりますので、具体的な値を示すリストを得るには vl-symbol-value 関数 または eval 関数を使用して「評価」させます。また、プロパティを変更したら元の *SOOPS:HND-2* といったシンボルに代入すれば呼び出し側からは意識することなくオブジェクトの状態を変更することができます。
(defun property (handle propertyName)
(cdr (assoc propertyName (cdr (vl-symbol-value handle))))
)
(defun set-property (handle propertyName value / cell record)
(if (and (setq record (vl-symbol-value handle))
(setq cell (assoc propertyName (cdr record)))
)
(set handle
(cons (car record)
(subst (cons propertyName value) cell (cdr record))
)
)
)
handle
)
プロパティアクセスの具体例は次の通りです。
_$ (property ahawk 'type)⏎
"HAWKS"
_$ (set-property ahawk 'type "falcon")⏎
*SOOPS:HND-1*
_$ (property ahawk 'type)⏎
"falcon"
また、クラスの型を調べる関数、クラスを継承しているか調べる関数も用意しておくと便利です。
(defun class-p (handle className)
(= (car (vl-symbol-value handle)) className)
)
(defun progeny-p (handle parentName)
(and
(member parentName
(inheritance-rank (car (vl-symbol-value handle)))
)
)
)
使用例は次の通りです。
_$ (class-p adog 'soops:mammals)⏎
T
_$ (class-p adog 'soops:birds)⏎
nil
_$ (progeny-p adog 'soops:animal)⏎
T
_$ (progeny-p adog 'soops:birds)⏎
nil
_$ (progeny-p abat 'soops:mammals)⏎
T
_$ (progeny-p abat 'soops:birds)⏎
T
メソッド呼び出し
メソッド呼び出しの関数名は、invoke（呼び出す）を使うこととします。
invoke 関数は、先の inheritance-rank 関数から得られる優先リストに従ってクラス定義をさかのぼりながらメソッド定義を探して実行します。invoke 関数の使用法は次のようになります。定義したときと同じように methodName 引数はメソッド名をシンボル名で渡しますからクォートしておきます。arglist は apply 関数のようにメソッドで使用する引数をリストに格納して渡します。引数がなければ nil を渡します。
invoke 関数の実装において、メソッドとして登録される関数の引数は、最初にオブジェクト、その後に引数が並ぶ形式となっている必要があります。そして、その中ではプロパティの場合と同じようにメソッドに与えられるオブジェクトの実体は *SOOPS:HND-2* といったシンボル名なので「評価」を行って具体的なインスタンスの状態を得ることができます。
一般の関数定義のように書くと次のような引数の構造をもつ関数です。
もう一つ考慮しなければならないのが、一度メソッドが見つかって呼び出したから終わりではなく、オブジェクト指向の差し分プログラミングの醍醐味であるメソッドの中からさらに継承元をさかのぼってメソッドを呼び出せる仕組みを用意しなければならない点です。next-funcall 関数が継承元のメソッドを呼び出す関数になりますが、これは invoke 関数内のローカル関数として定義されます。
これらを考慮した invoke 関数は次のようなものです。invoke 関数のローカル変数 $_search-pass に継承の優先リストが保持されます。invoke:search-method 関数では優先リストからメソッドを探索するとともに、探索済みのクラス定義は $_search-pass から除いていきます。ローカル関数 next-funcall が具体的に invoke:search-method 関数を使用して $_search-pass からメソッドを探し実行するというものになっていますが、invoke 関数の実体も担っています。
(defun invoke:search-method (/ classinfo method)
(if $_search-pass
(if (setq classinfo (vl-symbol-value (car $_search-pass))
$_search-pass (cdr $_search-pass)
method (assoc $_methodName (nth 3 ;|method|; classinfo))
)
(cdr method)
(invoke:search-method)
)
)
)
(defun invoke ($_handle $_methodName $_arglist
/ $_search-pass next-funcall
)
(if (and $_handle (vl-symbol-value $_handle))
(progn (setq $_search-pass (inheritance-rank
(car (vl-symbol-value $_handle))
)
next-funcall (lambda (/ $_func)
(if (setq $_func (invoke:search-method))
(apply $_func (cons $_handle $_arglist))
)
)
)
(next-funcall)
)
)
)
メソッド呼び出しの具体例は次の通りです。メソッド定義は前回の例で示した walk と fly を使用しています。
_$ (invoke adog 'walk '((20.0 0.0 50.0)))⏎
DOGS walk.
*SOOPS:HND-0*
_$ (property adog 'position)⏎
(20.0 0.0 0.0)
_$ (invoke ahawk 'walk '((20.0 0.0 50.0)))⏎
falcon walk.
*SOOPS:HND-1*
_$ (property ahawk 'position)⏎
(20.0 0.0 0.0)
_$ (invoke ahawk 'fly '((20.0 0.0 50.0)))⏎
falcon fly.
*SOOPS:HND-1*
_$ (property ahawk 'position)⏎
(40.0 0.0 50.0)
_$ (invoke abat 'fly '((20.0 0.0 50.0)))⏎
BATS fly.
*SOOPS:HND-2*
_$ (property abat 'position)⏎
(20.0 0.0 50.0)
多重継承と next-funcall の使用例として次のようなメソッドを定義します。
_$ (append-method
'soops:animal
'sayFeature
(function (lambda (handle) (princ "We are organisms that move.\n") handle)
)
)⏎
(CLASSINFO nil ((TYPE . "unknown") (POSITION QUOTE (0.0 0.0 0.0))) ((SAYFEATURE QUOTE #<USUBR @0000000037c9c9f8 -lambda->) (WALK QUOTE #<USUBR @00000000386dca98 SOOPS:ANIMAL:WALK>)))
_$ (append-method
'soops:mammals
'sayFeature
(function (lambda (handle) (princ "We breastfeed.\n") (next-funcall)))
)⏎
(CLASSINFO (SOOPS:ANIMAL) nil ((SAYFEATURE QUOTE #<USUBR @00000000386436d8 -lambda->)))
_$ (append-method
'soops:birds
'sayFeature
(function (lambda (handle)
(princ "Most of us can fly in the sky.\n")
(next-funcall)
)
)
)⏎
(CLASSINFO (SOOPS:ANIMAL) nil ((SAYFEATURE QUOTE #<USUBR @0000000038643a70 -lambda->) (FLY QUOTE #<USUBR @0000000038643778 -lambda->)))
実行すると次のようになります。
_$ (invoke adog 'sayFeature nil)⏎
We breastfeed.
We are organisms that move.
*SOOPS:HND-0*
_$ (invoke ahawk 'sayFeature nil)⏎
Most of us can fly in the sky.
We are organisms that move.
*SOOPS:HND-1*
_$ (invoke abat 'sayFeature nil)⏎
We breastfeed.
Most of us can fly in the sky.
We are organisms that move.
*SOOPS:HND-2*
オブジェクトが不要になったら最後に解放を忘れないでください。
_$ (free adog)
nil
_$ (free ahawk)
nil
_$ (free abat)
nil
以上のようにいくつかの関数を用意することで AutoLISP 上でオブジェクト指向プログラミングを行える枠組みが整いました。
こういったオブジェクト指向の枠組みを作ることは C 言語のようなオブジェクト指向以前の言語でも可能なように決して Lisp の特別な面ではありませんが、それでも関数を普通のデータのように扱える関数型言語の側面のおかげて、すいぶんと簡単に書くことができました。また余談にはなりますが、前回述べたとおりメソッド定義をクラス定義から独立させることで「総称関数」としてメソッドを定義することも可能です。その際は引数がどのクラスに属するかという情報を含めてメソッドを定義することになります。整数や実数、文字列といった基本的な型もクラスとみなして定義します。「総称関数」を使えば、既存の普通の関数をこれで定義し直していくことによって引数によって動作が変わる「演算子のオーバーロード」的なことを行うことも理論的に可能です。