Mathematicaのオブジェクト指向的機能をCommon Lispで真似てみた。
背景
先日、7月30日の Lisp Meet Up presented by Shibuya.lisp #42 - connpass において、「Mathematicaとオブジェクト指向について」という発表がありました。 そこでは、 Mathematica の機能を利用した、オブジェクト指向的な機能が提示されており、私はそれに興味を覚えました。
私は Mathematica は全然分からないのですが、発表を聞いていて、なんとなく概念はつかみ取ることができ（たような気分になり）、おそらく Common Lisp でその実装を真似ることが出来る（んじゃないかな）、と思ったので、早速適当にコードを書いてみることにしました。
着想
Mathematica のオブジェクト指向機能において、重要な役割を果たしていたのが、 ^:= というオペレータによる定義でした。
うろ覚えですが、以下のような機能と記憶しています。
これを使って、以下のように関数が定義できます：
hoge[func[x]] ^:= x fuga[func[x]] ^:= x + 1
普通の := オペレータによる関数定義と違う点は、外側のシンボル（上記の例の場合、hoge と fuga）に関数が関連づけられるのではなく、内側のシンボル（上記の例の場合、func）に関数が関連づけられることです（おそらく）。
この場合、func というシンボルが、 「hoge に囲まれて呼ばれたらどうなるのか？ fuga に囲まれて呼ばれたらどうなるのか」ということを知っていて、それによって呼び分けがなされる（らしい）です。
この話を聞いて、私は、「なるほど、とにかくシンボルに『シンボル⇄関数対応表』を持たせれば、 Common Lisp で実装できるんじゃないかな」と考えました。
上記の例では、func というシンボルが、 「 hogeで呼ばれたときの処理」と「fugaで呼ばれたときの処理」を知っていればよさそうな気がします。そして、 Common Lisp には、 symbol-plist があるのですから、そのような対応表を持たせるのは簡単そうではないか、と思われたのです。
メソッド的なものの呼び出しまでを実装してみる。
オブジェクトの生成
というわけで、実装を行ってみます。
まず大前提として、今回オブジェクトと称するものの実体は、 Common Lisp の symbol である ということにします。 以下では、オブジェクトという単語を使用しますが、 symbol と読み替えても結構です。 また、 Common Lisp で単にオブジェクトというと、あらゆるLispデータを指すのですが、この記事ではそちらを「Lispオブジェクト」と呼称することにします。
それでは最初に、オブジェクトを生成してみます：
'test-obj ;; test-obj という名のオブジェクトが出来た
'(quote) を付けるだけでオブジェクトが生成されました *1 。
'を付ける場合、どうしても名前が必要になりますが、無名のオブジェクトが欲しければ、 gensym を使うことが出来ます。
(gensym) ;; 無名のオブジェクトが出来る。
とはいえ以下では、説明の都合上、 'test-obj 等の名前のオブジェクトを使用することにします。
メソッドを持たせてみる
それでは、この 'test-obj に、 "Hello, World!" 的なものを返すメソッド、 test-funcを持たせ、それを呼び出してみます。
(defun add-symbolic-object-method (name s-object function) (setf (get s-object name) function))
ここで定義した add-symbolic-object-method では、渡されたオブジェクト(s-object引数）の持つプロパティリスト *2 を操作し、 name から function を引けるようにします。
以下の呼び出しで、'test-obj は、 'test-func とラムダ関数との関連を知ることが出来ます。
(add-symbolic-object-method 'test-func 'test-obj (lambda () (format t "Hello symbolic-method!~%")))
次は呼び出しです。
(defun call-symbolic-object-method (name s-object &rest args) (apply (get s-object name) args))
ここで定義した call-symbolic-object-method は、先ほどのadd-symbolic-object-methodで設定した関数を探し、それを呼び出(apply)します。
それでは呼び出してみます：
CL-USER> (call-symbolic-object-method 'test-func 'test-obj) Hello symbolic-method! NIL
関連づけられたメソッドを呼びだすことが出来ました。
メソッドを呼び分けてみる
オブジェクト指向といえば、「同じメッセージを呼び出しても、受け取るオブジェクトが違っていれば、呼び出される処理が違って・・云々」ですから、そういう呼び分けも試します。
'test-obj-2というオブジェクトを用意し、同名で別の処理を足してみます：
(add-symbolic-object-method 'test-func 'test-obj-2 (lambda () (format t "My name is test-obj-2~%")))
呼び出してみましょう：
CL-USER> (call-symbolic-object-method 'test-func 'test-obj)
Hello symbolic-method!
NIL
CL-USER> (call-symbolic-object-method 'test-func 'test-obj-2)
My name is test-obj-2
NIL
同じ 'test-func というメソッドを呼んでいるのに、オブジェクトが'test-objである場合と'test-obj-2である場合とで、違う結果になる・・という雰囲気になりました。
また、ここでは、あくまでオブジェクト側の持っている情報に基づいて、関数の呼び分けが行われています。 それぞれのオブジェクトを調べてみましょう：
CL-USER> (describe 'test-func) TEST-FUNC is a TENURED SYMBOL. It is unbound. It is INTERNAL in the COMMON-LISP-USER package. ; No value CL-USER> (describe 'test-obj) TEST-OBJ is a TENURED SYMBOL. It is unbound. It is INTERNAL in the COMMON-LISP-USER package. Its property list has these indicator/value pairs: TEST-FUNC #<Interpreted Function (unnamed) @ #x10001139ba2> ; No value CL-USER> (describe 'test-obj-2) TEST-OBJ-2 is a NEW SYMBOL. It is unbound. It is INTERNAL in the COMMON-LISP-USER package. Its property list has these indicator/value pairs: TEST-FUNC #<Interpreted Function (unnamed) @ #x10001131c92> ; No value
これを見ると、以下の事が分かります：
'test-funcは、何も知らない。'test-objと'test-obj-2は、それぞれ'test-funcと関連づけられた関数を知っている。
このように、情報をオブジェクトの側に持たせることが出来ており、 Mathematica の例と似た感じになっています。
見た目を変えてみる
以上で、簡易で安易なオブジェクト機構のようなものは出来ました。 しかし、色々と不格好なので、少し見た目をいじります。
通常関数のようにメソッドを呼び出す
毎回 call-symbolic-object-method を使うのは、どうも長ったらしいです。
なので、 通常の関数のような雰囲気で書けるようにしてみます。
(defun add-global-function-for-symbolic-object-method (defun-name &optional (method-name defun-name)) (setf (fdefinition defun-name) (lambda (obj &rest args) (apply #'call-symbolic-object-method method-name obj args))))
この add-global-function-for-symbolic-object-method は、メソッドに call-symbolic-object-method の呼び出しを橋渡しするLisp関数を与えます。
例えば、以下のように使用します。
CL-USER> (progn (add-global-function-for-symbolic-object-method 'test-func) (test-func 'test-obj)) Hello symbolic-method! NIL
'test-func を呼び出すと、渡された引数（この場合は 'test-obj一つ）と自身の名前（この場合は'test-func）を使用して、 call-symbolic-object-methodを呼び出します。これにより、上で定義した 'test-objの'test-funcメソッドを呼び出しています。
簡単な変更ですが、見た目の記述量を少し減らせています。
通常関数のようにメソッドを定義する
add-symbolic-object-method を毎回直に呼び出すのは、どうも長ったらしいです。
なので、 defun のような雰囲気で書けるようにしてみます。
(defmacro define-symbolic-object-method (name s-object lambda-list &body body) `(progn (add-global-function-for-symbolic-object-method ',name) (add-symbolic-object-method ',name ,s-object (lambda (,@lambda-list) ,@body))))
define-symbolic-object-methodというマクロを定義しました。
以下のように使います。
(define-symbolic-object-method test-hello 'test-obj () (format t "Hello symbolic-method with define-symbolic-object-method!~%"))
'test-hello というメソッドを 'test-objというオブジェクトに定義しています。
ただ、add-symbolic-object-methodの呼び出しに皮を被せただけですが、なんとなく見た目が改善します。
上記 add-global-function-for-symbolic-object-methodの呼び出しも含んでいるので、これだけで以下のような呼び出しが可能になります：
CL-USER> (test-hello 'test-obj) Hello symbolic-method with define-symbolic-object-method! NIL
さらに、追加の引数を渡す関数を書く時に、より直感的に書く事ができます：
(define-symbolic-object-method test-hello-to 'test-obj (name) (format t "Hello ~A!~%" name))
呼び出してみましょう：
CL-USER> (test-hello-to 'test-obj "hogehoge") Hello hogehoge! NIL
クラスのようなものを定義する
Mathematica オブジェクト機能でのクラス
Mathematica でのオブジェクト指向機能では、 Moduleという関数（？）を使用して、いわゆるクラスフィールドの機能が実現されていました。
これもうろ覚えですが、以下のようなものだった気がします：
- オブジェクトに対してクラスフィールドを生成する度に、新たなシンボル群が生成される。
- オブジェクトごとにシンボルは一意であり、重なることはない。
- 生成されたシンボルの名前を得ることが出来れば、クラスフィールドの値を覗いたり、書き換えたりできる。
また、 Mathematica のオブジェクト指向機能では、オブジェクトの生成と別に、「オブジェクトをクラスに所属させる」ということを陽に書いていたように見受けられました。
Common Lisp で真似る。
これらの Mathematica 機能を Common Lisp で実現しようとすると、色々な手段があるかと思いますが、私は Common Lisp の package を使うことにしました。 つまり、以下のようにします：
- オブジェクトに対してクラスフィールドを生成する度に、新たな package を作り、クラスフィールドの数だけ symbol を作って投入する。
- オブジェクトごとに、そのオブジェクトの名前を使って package を作る。これで package と、そこに所属する symbol は一意になる。
- 生成された package と symbol は、オブジェクト名とフィールド名で辿ることが出来るので、覗き見や書き換えも出来る。
これらを実装すると、かなりコードが多くなってしまいましたので、記事の最後に載せています。
クラスを定義してみる
それでは、実際にクラスを定義してみます。
(define-symbolic-object-class test-class () ((field-a 1) (field-b nil) (field-c "string")) ((method-hello () (format t "Hello, class world! I am ~A~%" *self*)) (method-describe-test-class () (format t "~&field-a = ~A, field-b = ~A, field-c = ~A~%" field-a field-b field-c))))
ここでは、 test-class という名前にクラスを定義してみました。 field-a, field-b,field-c という３つのフィールドと、method-hello, method-describe-test-class というメソッドを持っています。
この define-symbolic-object-class を呼ぶと、以下のことをします：
- フィールドの情報を集めて、保存する。
- メソッドの情報を集め、インスタンス化するときに使う「メソッドを作るための関数」を作る。これについては後述します。
- フィールドへのアクセサ関数の入り口と、各メソッドの入り口の関数を作る。
この場合、 test-class について定義したので、 Lisp シンボルの test-classに、以下のように情報を保存します：
CL-USER> (describe 'test-class) TEST-CLASS is a TENURED SYMBOL. It is unbound. It is INTERNAL in the COMMON-LISP-USER package. Its property list has these indicator/value pairs: :SYMBOLIC-CLASS-METHOD-SPECS ((METHOD-DESCRIBE-TEST-CLASS #<Function # @ #x1000184ef32>) (METHOD-HELLO #<Function # @ #x1000184ef92>)) :SYMBOLIC-CLASS-FIELD-SPECS ((FIELD-A |FIELD-A-reader| |FIELD-A-writer| 1) (FIELD-B |FIELD-B-reader| |FIELD-B-writer| NIL) (FIELD-C |FIELD-C-reader| |FIELD-C-writer|)) ; No value
また、いくつか関数が定義されました：
CL-USER> (fboundp 'field-a) #<Interpreted Closure (:INTERNAL ADD-GLOBAL-FUNCTION-FOR-SYMBOLIC-OBJECT-METHOD) @ #x10001124752> CL-USER> (fboundp '(setf field-a)) #<Interpreted Closure (:INTERNAL ADD-GLOBAL-FUNCTION-FOR-SYMBOLIC-OBJECT-METHOD) @ #x10001124182> CL-USER> (fboundp 'method-hello) #<Interpreted Closure (:INTERNAL ADD-GLOBAL-FUNCTION-FOR-SYMBOLIC-OBJECT-METHOD) @ #x100011247e2>
これらの入り口となる関数は定義されたのですが、まだクラス定義をしただけで、そのクラスに属しているオブジェクトはいません。
例えば、先ほどの 'test-objに呼んでみても、エラーになってしまいます。
CL-USER> (field-a 'test-obj) |(setf (field-b 'test-obj) "b") ; Evaluation aborted on #<TYPE-ERROR @ #x10001213112>. |(setf (field-c 'test-obj) "c")
オブジェクトをクラスに所属させてみる
それでは、'test-obj を、 test-class に所属させてみます：
(apply-symbolic-object-class 'test-obj 'test-class)
この apply-symbolic-object-class は、以下のことをします：
- オブジェクトのフィールドを保持する package を生成し、フィールドの名前を持つ symbol を作って配置する。
- フィールドへのアクセサ関数を生成する。上で生成した symbol の内容を操作する関数を作って、
add-symbolic-object-methodを呼ぶ。 - メソッド定義に基づいて、メソッドを生成する。後述。
フィールドの生成
この例では、まず以下のように package が生成されます：
CL-USER> (find-package 'test-obj) #<The TEST-OBJ package>
フィールドへのアクセサ関数が提供され、初期値が与えられていればそれが参照出来るようになります。値を設定することも出来ます：
CL-USER> (field-a 'test-obj) 1 CL-USER> (setf (field-a 'test-obj) 99) 99 CL-USER> (field-a 'test-obj) 99
このフィールドは、当然ですがオブジェクトごとに存在します。別のオブジェクトを使用してみましょう：
CL-USER> (apply-symbolic-object-class 'test-obj-2 'test-class) TEST-OBJ-2 CL-USER> (field-a 'test-obj) 99 CL-USER> (field-a 'test-obj-2) 1
オブジェクト毎に別の package, 別の symbol を参照しているため、重なってしまうことはありません。
method の生成
次は、メソッドを呼んでみましょう：
CL-USER> (method-hello 'test-obj) Hello, class world! I am TEST-OBJ NIL CL-USER> (method-hello 'test-obj-2) Hello, class world! I am TEST-OBJ-2 NIL
おなじメソッドを呼んでいるのですが、少し違う内容を返しています。このメソッドの定義を再掲すると、以下のようなものでした：
... ((method-hello () (format t "Hello, class world! I am ~A~%" *self*)) ...
ここで登場する self という変数に、呼び出し時に使われたオブジェクトを格納しています。この変数に何を設定するかは、クラス定義の時点（define-symbolic-object-class）では分からず、クラスを適用する時点（ apply-symbolic-object-class ）で初めて分かります。このため、apply-symbolic-object-class の呼び出しの時点で、オブジェクト毎にメソッドを生成しています。
別のメソッドも呼んでみます：
CL-USER> (method-describe-test-class 'test-obj) field-a = 99, field-b = NIL, field-c = string NIL CL-USER> (method-describe-test-class 'test-obj-2) field-a = 1, field-b = NIL, field-c = string NIL
これもまた、先ほど setf した値を返しています。このメソッドの定義を見てみましょう：
... (method-describe-test-class () (format t "~&field-a = ~A, field-b = ~A, field-c = ~A~%" field-a field-b field-c)))) ...
三つのfield-a, field-b, field-cという変数を使用していますが、これらも各オブジェクトごとに違うフィールドを指すようになっています。このため、やはりクラス定義の時点ではメソッドを作れず、クラス適用の時点で初めて指す先が分かるということになります。そのため、先ほどの self変数と同様に、クラス適用の時点で symbol-macrolet を使用してさす先を置き換えたメソッドを生成することで実装しています。
継承してみる
継承も実装しています。親クラスの名前を、所定の位置に指定するだけです：
(define-symbolic-object-class test-class-2 (test-class) ((field-b 99999) (field-c "abcdefg")) ((method-hello () (format t "I am a subclass, my name is ~A~%" *self*))))
いくつかのフィールドとメソッドを上書きしてみました。
'test-obj-2 のクラスをこっちに変えて、メソッドを呼んでみましょう：
CL-USER> (progn (apply-symbolic-object-class 'test-obj-2 'test-class-2) (method-hello 'test-obj-2)) I am a subclass, my name is TEST-OBJ-2 NIL CL-USER> (method-describe-test-class 'test-obj-2) field-a = 1, field-b = 99999, field-c = abcdefg NIL
どちらの呼び出しも、上書きした内容を参照するようになりました。
この実装は、親クラスとして指定されたクラスのフィールド定義とメソッド定義を、子クラスの定義と順序立ててくっつけてしまうことで実現しています。
まとめ
見よう見まねですが、なんとなく発表内容の Mathematica オブジェクト機能っぽいものを実現することが出来ました。 とはいえ、私は Mathematica がさっぱりなので、つっこみを手広く歓迎しています。 ちゃんと Mathematica の文書を読んで、記事を書き直すことが、私の TODO です。
また、今回の簡易オブジェクト指向機能ですが、融通の聞く key-value ペア構造があれば、何でもいけるのではないかと思います。 hash-table 的なものでもいいですし、Cでも名前（文字列とか）と関数ポインタを関連づけて持ち運べばいいので、言語によらずいけそうな気配はあります。
ソースコードは以下においてあります。何かの役に立つことはないと思いますが、とてもとても暇な時にでもご賞味くだされば・・
