Lisp とオブジェクト指向

既に AutoLISP においても ActiveX 対応関数を用いて AutoCAD にアクセスする場合はオブジェクトを操作する形式となりますので、オブジェクト思考と無縁ではありませんが、自分でクラス定義を行いオブジェクトを作成することはできません。また、AutoCAD の新しいコマンドを作る場合は昔ながらの単純なフローチャートで示せるものが多く、独自のオブジェクトを作る需要を感じることはあまりありません。しかし、計算過程で複数のデータタイプとそれに対応した関数を用意しなければならない場合は関数の使い分けが煩雑になってきますので、そのような時はデータ中心に関数を整理できればと思いますし、出来ないという枠組みの上ではプログラミングする楽しさも半減です。

Lisp という形式にオブジェクト指向を取り入れようとしたとき、二つのメソッドの呼び出し形式が考えられます。ActiveX 対応関数を使う上で AutoLISP のメソッド呼び出しにも二種類の方法がありました。

一つ目は vlax-invoke-method 関数を使用するもので、次のような形式をとります。

「メソッドの呼び出し」をする関数を呼び出し、メソッド名は第二引数で与えます。 適切なメソッド、つまり適切な関数を呼び出す仕組みを vlax-invoke-method 関数が行っています。

二つ目は、関数名がメソッド名になっているものです。

vla-<メソッド名>という関数では、例え種類が異なるオブジェクトに同名のメソッドがあっても適切な関数が呼ばれます。意識しないでも引数で与えられたオブジェクトの種類に応じて、自動的に適切な関数に振り分けられます。

Common LISP では CLOS(Common Lisp Object System) というものが当初から組み込まれており、そこでは関数型言語とオブジェクト指向が共存しています。Lisp では動詞にあたる関数名ここではメソッド名が最初に来る二番目の形式がより理想的とされ、これを CLOS では用います。このように例え同名の関数が定義されても、引数のオブジェクトに応じて実行される関数が振り分けられる仕組みの関数を「総称関数」と言います。オブジェクトのメソッドはクラスに属するのが一般的なオブジェクト指向のイメージですが、「総称関数」としてのメソッドはクラスから独立して存在するイメージです。「総称関数」は最近の C# でも「ジェネリクス」と呼んで取り入れられている考えです。

さて、これから作ろうとするオブジェクト指向プログラミングの枠組みは、理想とは異なりますが一番目の方法を目標にします。理由は、こちらの方が型宣言が無い AutoLISP では扱いが単純になり、考え方の最初のステップに適当だからです。しかしながら、今回はメソッドの情報を個々のクラス定義に含むものとして作成しますが、これを個々のクラスから独立させクラス全体を縦断してすべてのメソッドに型の情報を添えて管理するようにすれば「総称関数」の仕組みを AutoLISP 上に実現することも可能です。

クラス定義

前置きが長くなりましたが、具体的なオブジェクト指向の枠組み作りを考えて行きます。前置きでもわかるとおり、オブジェクト指向と言ってもいろいろな実現方法が考えられることから、これから示すものも一例として念頭に置いてください。それもあって、これから作る関数の名前は CLOS とは重ならないものを使用します。今回の枠組みは SOOPS(Simple Object-Orient Programming System)と呼ぶこととし、クラス名などで使用するシンボルには、名前空間を分ける意味で「soops:」という接頭辞を付けることにします。クラスは CLOS と同様に多重継承をサポートします。

クラスを定義するにあたって、次のようにクラス名のシンボルにクラス情報のリストを代入して保持することにします。リストには最初にクラス情報であることを示すシンボル、継承元のリスト、プロパティ情報の連想リスト、メソッド情報の連想リストを含みます。

プロパティ情報の連想リストは、インデックスをプロパティ名のシンボルとし、インスタンス作成時に初期値が省略された場合のデフォルトの値を保持します。これは次回にインスタンスを生成する関数で使われますが、構造体の仕組みと同じようにデフォルト値は必要になった場合に「評価」されます。

メソッド情報の連想リストは、メソッド名をインデックスとし、関数を値として保持します。

クラスを定義する関数は次のようなものになります。メソッドの定義は、個々の関数を一度にクラスに定義するのは煩雑になるので、後から独立してメソッドを加えたり除いたりすることとします。そのため、この段階では引数を所定の形式のリストに変換して、クラス名のシンボルに代入するだけの簡単なものです。メソッド定義だけは、クラスの再定義に備えて古いクラス定義があった場合は、既に登録されているものを引き継ぐようにしています。

(defun class (className parents properties / old-definition)
  (setq old-definition (vl-symbol-value className))
  (set className
       ;;(ClassInfo (parents) (properties) (method))
       (list 'ClassInfo
             parents
             properties
             (if old-definition
               (nth 3 ;|method|; old-definition)
             )
       )
  )
)

この関数の使い方は次のようになります。第一引数にクラス名、第二引数に継承するクラスを左側優先で並べたリスト、第三引数はプロパティのデフォルト値を指定する連想リストです。継承するクラスが無い場合は第二引数は nil を指定します。また、新たにプロパティを定義する必要が無い場合は、第三引数は nil を指定します。クラス名の className はシンボル名を渡すのでクォートすることを忘れないでください。他、継承元のクラス名、プロパティ名メソッド名も同様です。

クラス定義の具体例は次のようになります。ここでは「動物」クラスを定義し、それを継承する「鳥類」と「ほ乳類」クラスが定義され、さらに「ほ乳類」と「鳥類」を多重継承した「こうもり」クラスを定義しています。

_$ (class 'soops:animal nil '((type . "unknown") (position quote (0.0 0.0 0.0))))⏎
(CLASSINFO nil ((TYPE . "unknown") (POSITION QUOTE (0.0 0.0 0.0))) nil)
_$ (class 'soops:birds '(soops:animal) nil)⏎
(CLASSINFO (SOOPS:ANIMAL) nil nil)
_$ (class 'soops:mammals '(soops:animal) nil)⏎
(CLASSINFO (SOOPS:ANIMAL) nil nil)
_$ (class 'soops:bats '(soops:mammals soops:birds) '((type . "BATS")))⏎
(CLASSINFO (SOOPS:MAMMALS SOOPS:BIRDS) ((TYPE . "BATS")) nil)

クラスに対してメソッドの登録と削除は次の関数を用います。クラス情報のリストからメソッドの情報の連想リストを変更しているだけです。

(defun append-method
       (className methodName func / ClassInfo-s method new old)
  (setq ClassInfo-s (vl-symbol-value className))
  (set className
       (list 'ClassInfo
             (nth 1 ;|parents|; ClassInfo-s)
             (nth 2 ;|layout|; ClassInfo-s)
             (if (setq method (nth 3 ;|method|; ClassInfo-s)
                       new    (cons methodName (list 'quote (eval func)))
                       old    (assoc methodName method)
                 )
               (subst new old method)
               (cons new method)
             )
       )
  )
)

(defun remove-method (className methodName / ClassInfo-s method old)
  (setq ClassInfo-s (vl-symbol-value className))
  (set className
       (list 'ClassInfo
             (nth 1 ;|parents|; ClassInfo-s)
             (nth 2 ;|layout|; ClassInfo-s)
             (if (setq method (nth 3 ;|method|; ClassInfo-s)
                       old    (assoc methodName method)
                 )
               (vl-remove old method)
               method
             )
       )
  )
)

これらの関数の使い方は次のようになります。クラス定義と同じく、引数 className と methodName はシンボル名を渡すのでクォートすることを忘れないでください。func 引数は関数をクォートして渡しますが、関数名を渡しても良いですし匿名の関数で定義することもできます。

メソッドを定義する具体例は次のようになります。walk と fly というメソッドが登録されていますが、walk メソッドは通常の関数定義を使って別途定義された関数名を渡すことでメソッドを定義しています。fly メソッドは匿名の関数を使用して定義しています。なお、二つのメソッドは移動ベクトルを与えますが walk メソッドは位置を表す Z 値が 0 になります。そして fly メソッドは与えられたベクトルに応じて 位置の Z 値も変化します。

_$ (defun soops:animal:walk (handle vector / pos)
  (princ (strcat (property handle 'type) " walk.\n"))
  (setq pos (property handle 'position))
  (set-property
    handle
    'position
    (list (+ (car pos) (car vector))
          (+ (cadr pos) (cadr vector))
          0.0
    )
  )
  handle
)⏎
SOOPS:ANIMAL:WALK

_$ (append-method 'soops:animal 'walk 'soops:animal:walk)⏎
(CLASSINFO nil ((TYPE . "unknown") (POSITION QUOTE (0.0 0.0 0.0))) ((WALK QUOTE #<USUBR @00000000386dca98 SOOPS:ANIMAL:WALK>)))

_$ (append-method
  'soops:birds
  'fly
  (function (lambda (handle vector / pos)
              (princ (strcat (property handle 'type) " fly.\n"))
              (setq pos (property handle 'position))
              (set-property
                handle
                'position
                (list (+ (car pos) (car vector))
                      (+ (cadr pos) (cadr vector))
                      (+ (caddr pos) (caddr vector))
                )
              )
              handle
            )
  )
)⏎
(CLASSINFO (SOOPS:ANIMAL) nil ((FLY QUOTE #<USUBR @0000000037c9c9f8 -lambda->)))

メソッド用の関数の形式については次回説明します。

メソッドを削除する例は次のようになります。

_$ (remove-method 'soops:birds 'fly)⏎
(CLASSINFO (SOOPS:ANIMAL) nil nil)

次は、このクラス定義から実際にインスタンスを作成してプロパティアクセスとメソッドの呼び出しを行う仕組みを作っていきます。そこでは、多重継承をサポートする仕組みを考えます。