本当はこの記事は,これまでのCLOS で学ぶ集合論の一環なんですが,ちょっと内容がCLOS の話だけで集合論は出てきそうもないので,こういう内容にふさわしいタイトルにしました.

前のブログで,CLOS はLisp の型システムに統合されているという話をして,(find-class 't) とか(find-class 'integer) でCLOS の組込みクラスである built-in クラスの話をしました.正当なCLOSクラスではないそのほかのクラスとして構造体クラス(structure class) があります.Lisp の構造体はユーザが定義できますが,構造体を定義するときのオプションで :include を用いると,それが型の上下関係を定義したことになり,それがCLOSの構造体クラスの上下関係にもなっています.

cg-user(3): (find-class 't)
#<built-in-class t>
cg-user(4): (find-class 'integer)
#<built-in-class integer>
cg-user(5): (class-of 1)
#<built-in-class fixnum>
cg-user(6): (defstruct foo)
foo
cg-user(7): (defstruct (bar (:include foo)))
bar
cg-user(8): (subtypep 'bar 'foo)
t
t
cg-user(9): (find-class 'foo)
#<structure-class foo>
cg-user(10): (find-class 'bar)
#<structure-class bar>
cg-user(11): (subtypep (find-class 'bar) (find-class 'foo))
t
t

なぜこんなことをしているかというと,Lisp の型システムに統合することで,CLOS のメソッドを単に普通のCLOS 実現体だけでなく,すべてのLisp オブジェクトに適応することが可能になるからです.

cg-user(12): (defmethod iam ((x integer))
               (format t "I am integer ~S." x))
#<standard-method iam (integer)>
cg-user(13): (defmethod iam ((x foo))
               (format t "I am a foo: ~S" x))
#<standard-method iam (foo)>
cg-user(14): (iam 1)
I am integer 1.
nil
cg-user(15): (iam (make-foo))
I am a foo: #S(foo )
nil

ここでクラスとしての integer やクラスとしての構造体クラスも,通常のdefclass で定義されるクラスと同じく一種のオブジェクトです.ですからこれをメタオブジェクトともいいます.これは普通のオブジェクト指向言語と違うところですね.最近ではC#やJavaもリフレクションとか言って,クラス情報をプログラム中に取り込んでその情報で仕事を変えることができるようになりましたが,CLOSほどオブジェクトとして徹底されているわけではありません.それでは,ここからが問題です.メタオブジェクトのクラスは一体何でしょうか.実はCLOSではこれもオブジェクトとして実現されています.それがcl:standard-class という名前のクラスです.クラスオブジェクト(メタオブジェクト)のクラスですから,これをメタクラスと言います.

cg-user(16): (class-of (find-class 'integer))
#<standard-class built-in-class>
cg-user(17): (class-of (find-class 'foo))
#<standard-class structure-class>
cg-user(18): (defclass myclass () ())
#<standard-class myclass>

さらにこれからが問題です.それではcl:standard-class のクラスは一体何でしょうか?実はそれはcl:standard-class 自身なのです.

cg-user(19): (find-class 'standard-class)
#<standard-class standard-class>
cg-user(20): (class-of (find-class 'standard-class))
#<standard-class standard-class>

自分が自分自身の実現体だなんて,落語の頭山のようにありえない,という話になるのですが,これを集合論的に理解しようというのが,このブログシリーズの本当の目的なのですが,その解決はあとまわしにして,話を型階層に戻します.きっちりと区別してもらいたいのは,型を集合として捉えたとき,クラス/インスタンス関係は集合とその要素(元とも言います)の関係であり,上位クラス/下位クラス関係は,集合の包含関係である,ということです.これをごっちゃにしてほしくないし,集合がその要素としてその集合を含むということも絶対にないことなのです.本当に多くの人がこれを曖昧に捉えていますが,地上にあるものを一つのオブジェクトと考えたとき(これを個物という),個物の集合は人の頭で考える普遍物であり,これがクラスです.それはあたかも地上から1階上に上がった2階(first floor)の話です.で,この普遍物についてまた集合を考えれば,これは3階(second floor)の話になります.1階を2階とごちゃごちゃにすることはないし,2階と3階をごちゃごちゃにすることもありません.ただし,cl:standard-class だけは階の上昇がループしているし,あとで出てきますが,cl:standard-object だけはすべてのオブジェクトを呑み込んでしまうブラックホールみたいなものなのです.ですからcl:standard-class とcl:standard-object だけは特別に考えてください.

ここまでは,すべての処理系で共通の話です.さて,cl:standard-object の上位クラスは普通は 組込みクラスの t です.SBCLでは sb-pcl::slot-object なるものが一枚噛んでいます.それでは,組込みクラス t の上位クラスは?

cg-user(22): (mop:class-direct-superclasses (find-class 'standard-object))
(#<built-in-class t>)
cg-user(23): (mop:class-direct-superclasses (find-class 't))
nil

ありませんでした.それでは,cl:standard-class の上位クラスは何でしょうか?これは実に処理系によって様々なのですが,各自ご自分の処理系で確かめてほしい.SBCL では sb-mop:class-direct-superclasses を使います.

cg-user(25): (mop:class-direct-superclasses (find-class 'standard-class))
(#<standard-class excl::std-class>)
cg-user(26): (mop:class-direct-superclasses (find-class 'excl::std-class))
(#<standard-class excl::clos-class>)
cg-user(27): (mop:class-direct-superclasses (find-class 'excl::clos-class))
(#<standard-class class>)
cg-user(28): (mop:class-direct-superclasses (find-class 'class))
(#<standard-class excl::documentation-mixin> #<standard-class excl::dependee-mixin>
 #<standard-class aclmop:specializer>)
cg-user(29): (mop:class-direct-superclasses (find-class 'aclmop:specializer))
(#<standard-class aclmop:metaobject>)
cg-user(30): (mop:class-direct-superclasses (find-class 'aclmop:metaobject))
(#<standard-class standard-object>)

いずれにしても,どこかでcl:standard-object が出てくることになっています.

では,せっかくですから,ここで型の階層関係を見せてくれるプログラムを作ってみましょう.このコードはSchank らのMemory Organization Package にあるプログラムをちょっと CLOS 用に修正したものです.

(defun dah (cls)
  "dah <cls>
   prints all the specalizations under <cls>. The name is short for
   'display abstraction hierarchy'"
  (pprint (tree->list cls #'specs->list nil)))

(defun tree->list (cls fn visited)
  "tree->list <cls> <function> <cls-list>
   returns a list starting with <cls>, followed by the elements of
   the list returned by calling <function> with <cls> and <cls-list>
   updated to include <cls>. If <cls> is already in <cls-list>, just
   a list with <cls> is returned."
  (cond ((member cls visited) (list (class-name cls)))
        (t
         (push cls visited)
         `(,(class-name cls) ,@(funcall fn cls visited)))))

(defun specs->list (cls visited)
  "SPECS->LIST <cls> <cls-list>
   returns a list starting with <cls>, followed by the specialization
   tree under each specializations of <cls>."
  (loop for spec in (mop:class-direct-subclasses cls)
      when (tree->list spec #'specs->list visited)
      collect it))

(dah (find-class 'standard-object)) とか (dah (find-class 't)) とかすれば,型階層をツリーで見ることができますよ.ちなみに,SBCL では mop:class-direct-subclasses はsb-mop:class-direct-subclasses となります.