#:g1: CommonObjectsがやっと動いた

Posted 2013-01-09 13:13:00 GMT

CommonObjectsとは

 CommonObjectsとは、1985年辺りから開発されていたCommon Lisp上のOOPシステムです。CLOSに確定する前の1980年代後半までには、色々な方式で主要ベンダー等が、OOPシステムを提案/実装していました。

 それまでメジャーだったOOPシステムには、1970年代後半に現われたFlavorsがありますが、CLtL1が決まった1984年辺りから、OOPシステムをLispに載せるとしたらどういうものが良いかで各方面が鎬を削った熱い時代がありました。1986年のOOPSLA辺りで一つの頂点を迎えるようですが、この辺りの事情は、Common Lispオブジェクトシステム(井田昌之他)に詳しいです。

システムの主要な提案には4つありました
  1. CommonLoops
  2. New Flavors
  3. ObjectLisp
  4. CommonObjects

 Xeroxが提案したCommonLoopsは、それまでのFlavorsとは違い、総称関数ベースでMOPもあるというもの、SymbolicsのNew Flavorsは、これまたFlavorsを総称関数な感じにしたもの、ObjectLispは今でいうプロトタイプベースで、かなりダイナミックなもの、CommonObjectsは、総称関数ベースではなく、情報隠蔽に特長がある、とされていました。

 これらの内、CommonLoopsが有用性を実証し、ポータブルな実装である、Portable CommonLoops(PCL)を出したこともあってか、CommonLoopsを下敷きにCLOSの仕様が作られていくことになります。

 当時、PCLを中心に実装も公開されていることが多かったようで、SymbolicsのNew Flavors以外は、現在でもソースを入手することが可能なようです。PCLは、SBCLのパッケージ名にSB-PCLとあるように、いまだに下敷きとなって使われています。

 ObjectLispは、LMIのLispマシンのソースの中にひっそりとあるのですが、ちょっと直せば動きます。New Flavorsではないものの、Flavorsは、結構実装が色々あるようでソースもそれぞれ入手できますし、Allegro CLのように標準添付でサポートしている処理系もあります。CommonObjectsもCMUのレポジトリでCOOLという実装が公開されています。

CommonObjectsを動かす

 ということで、この数年、CommonObjectsのソースを拾って来て、何度も動かそうと色々やっていたのですが、全く動く気配がなく、諦めていました。まず、古いPCLが動かないのが問題だったのですが、暇だったので腰を据えて地道に書き換えてみたりしたところ、今のところSBCLのみですが動くようになりました。

 はまりポイントですが、コードウォーカーと、土台になっている古いPCLのブートストラップ問題でしょうか。ブートストラップ問題に関しては、未だに何がどうなっているのか、良く分かっておらず、手順を換えたりライブラリの再ロードで環境が簡単に壊れます…。動かないかもしれませんが、自分の手元ではSBCLで動くのを確認したものをgithubに置いています。

 さて、動くようになったので、試してみます。

 GoFのTemplate Method的なことをやってみようかなと思って書いてみましたが、継承してきた親のスロットだからといって子供が触れるかというと、触れないようで:gettableの指定をしなければ、クラスに直に付いているメソッド以外は触れないようです。

 例で言えば、open-mesgは公開されていますが、mesgは公開されていないので、abstractのメソッドでしか触れません。今の感覚からすると、継承してきたスロットをいじれないと割とやりにくいですが、隠蔽性に特長があるといえば、確かにそうかもしれません。

 また、親のスロットを触れないので、同名のスロットがあっても混ざることもなく大丈夫ということみたいです。公開されている親のスロットを触るには、(call-method (親 メソッド))という風にしないといけませんが、今回のような例では面倒です。まるで全く別個のオブジェクトを触っているような感覚もありますが、make-instanceで作成する同一のオブジェクトであり、面白いところです。■

(progn
  (define-type abstract
    (:var mesg (:init "foo bar baz"))
    (:var open-mesg (:init "foo bar baz") :gettable :settable))

(define-method (abstract :op1) () mesg)

(define-method (abstract :op2) () mesg)

(define-method (abstract :template-method) () (=> self :op1) (=> self :op2)))

(progn (define-type concrete (:inherit-from abstract))

(define-method (concrete :op1) () (call-method (abstract :set-open-mesg) (string-upcase (call-method (abstract :open-mesg)))))

(define-method (concrete :op2) () (format t "~A~%" (call-method (abstract :open-mesg)))))

(progn (define-type concrete2 (:inherit-from abstract))

(define-method (concrete2 :op1) () (call-method (abstract :set-open-mesg) (string-capitalize (call-method (abstract :open-mesg)))))

(define-method (concrete2 :op2) () (princ (call-method (abstract :open-mesg))) (terpri)))

(let ((o (make-instance 'abstract))) (prog1 (=> o :template-method) (=> o :describe))) ;>> This object of type ABSTRACT has variables: ;>> MESG: "foo bar baz" ;>> OPEN-MESG: "foo bar baz" ;>> ;=> "foo bar baz"

(let ((o (make-instance 'concrete))) (prog1 (=> o :template-method) (=> o :describe))) ;>> FOO BAR BAZ ;>> This object of type CONCRETE has variables: ;>> For parent ABSTRACT: ;>> MESG: "foo bar baz" ;>> OPEN-MESG: "FOO BAR BAZ" ;>> ;=> NIL

(let ((o (make-instance 'concrete2))) (prog1 (=> o :template-method) (=> o :describe))) ;>> Foo Bar Baz ;>> This object of type CONCRETE2 has variables: ;>> For parent ABSTRACT: ;>> MESG: "foo bar baz" ;>> OPEN-MESG: "Foo Bar Baz" ;>> ;=> NIL

comments powered by Disqus