CLOS Grand Tour
Table of Contents
1 はじめに
Common Lisp Object System (CLOS) は、當初 Common Lisp の擴張仕樣として提案され、其の後 ANSI Standard に組み入れられました。
CLOSは他のオブジェクト指向言語と同じやうに、クラス、總稱函數、メソッド、多重繼承の概念に基いたものですが、CLOSを他と際立たせてゐるものは、これら、クラス、メソッド、總稱函數、メソッド結合など全てが、そのインスタンスと同樣に、 first-class object として、programmer が參照操作できる點にあります。
しかし、ではこのことが日日の我が身にとってどんな御利益があるのか、については、あまり明確なイメージを持てないでゐる人も少なくないのではないでせうか。
Linda G.DeMichiel による An Introduction to CLOS では、上を簡潔に、且要點を外すことなく解説くれてゐるのですが、生憎この論文が掲載されてゐる本 Object Oriented Programming the CLOS Perspective は今ではなかなか入手が難しいやうです。
ここでは、An Introduction to CLOS に沿って、CLOSを概觀しつつ、より具體的なイメージが持てるやうCLOSの舞臺裏をも覗いてみようと思ひます。舞臺裏を覗く道具としては主に Meta Object Protocol (MOP) を活用します。
2 クラス
クラス (class) はCLOSの根幹をなすものです。CLOSのオブジェクトは全て、あるクラスのインスタンス (instance) です。1
あるクラスには、繼承 (inherit) 元となる祖クラス2 (superclasses) が存在します。祖クラスを繼承したクラスを、その祖から見たサブクラス (subclass) と呼びます。繼承關係は推移的で、有向な非循環グラフをなします。全てのクラスの祖となるクラスが t です。
クラスのインスタンスには、スロット (slot) と呼ばれるものが割り當てられ、そこに値が保存されます。スロットにはインスタンスに固有 (local) なものとクラス間で共有 (share) されるものがあります。
クラスは first-class object であり、それ自身がクラスのインスタンスでもあります。クラスのクラスをメタクラス (metaclass) と呼び、インスタンスの物理的表現 (physical representation) は、メタクラスにより決まります。從って、メタクラスレベルでの操作を行へば、インスタンスの物理表現を變更することが可能となります。3
2.1 クラスの定義
2.2 クラス定義の例
(defclass person () ((name :accessor name :initarg :name))) (defclass employee (person) ((dept :accessor department :initarg :department) (salary :accessor salary :initarg :salary) (id :reader employee-id :initform (gensym))))
クラスはdefclassマクロを使って定義します。
defclass の記述では、クラス名に續いて直屬の親クラス (direct superclasses) の列が置かれます。 その次にスロット記述 (slot specifier) の列がきて、最後にクラスオプション (class option) を置くことができます。
クラスオプションではメタクラス (metaclass) の指定ができますが、上例では、メタクラスは明示されてゐません。明示の無い場合には、メタクラスにstandard-classを指定したのと同じことになります。また、メタクラスが standard-class である場合、親クラスに空を記載しておけば、standard-objectを指定したのと同じことになります。
つまり、上は、下に書き直した形の省略形だと云へます。
(defclass person (standard-object) ((name :accessor name :initarg :name)) (:metaclass standard-class)) (defclass employee (person) ((dept :accessor department :initarg :department) (salary :accessor salary :initarg :salary) (id :reader employee-id :initform (gensym))) (:metaclass standard-class))
このことは次のやうにも確かめられます。
CL-USER(8): #+allegro (in-case-mode :common) CL-USER(9): #+sbcl (defpackage "SB-MOP" (:nicknames "MOP")) CL-USER(10): #+ccl (defpackage "CCL" (:nicknames "MOP")) CL-USER(11): (mop:class-direct-superclasses (find-class 'person)) (#<STANDARD-CLASS STANDARD-OBJECT>) CL-USER(12): (class-of (find-class 'person)) #<STANDARD-CLASS STANDARD-CLASS>
slot specifierはスロットを定義するもので、名前とオプション (slot options) からなります。
:reader :writer :accessor の指定により accessor メソッドの定義が自動的に行はれます。
:initarg は make-instance に於ける引數名を指定するもので、
:initform はスロットの初期値を決めるものです。
2.3 インスタンス生成
インスタンスは一般に make-instance を使って生成されます。
CL-USER(12): (defvar Harry
(make-instance 'employee
:name "Harry Smith"
:department 'sales
:salary 50000))
#<EMPLOYEE @ #x100f39402>
インスタンスに對しては accessor 函數を使ってスロット値の參照と變更ができます。
CL-USER(22): (employee-id Harry) #:G21 CL-USER(23): (name Harry) "Harry Smith" CL-USER(24): (setf (name Harry) "Harry H. Smith") "Harry H. Smith" CL-USER(25): (name Harry) "Harry H. Smith"
3 繼承
CLOSは多重継承 (multiple inheritance) を許します。複數ある祖クラスの中から、どのスロットを受け繼ぐかなど、繼承にかかはることは、クラス優先順リスト (class precedence list) を使って判斷します。
3.1 クラス優先順位
あるクラスが何をどこから繼承するかを決めるのがクラス優先順リストです。 クラス優先順リストは、あるクラスが與へられたときに、より近い關係にある (more-specific) クラスから、より遠い關係にある (less-specific) クラスを順番に竝べたもので、これは topological sorting と呼ばれるアルゴリズムによって算出されます。
例として以下を考へます。
(defclass window () ()) (defclass colored-object () ()) (defclass noisy-object () ()) (defclass colored-window (window colored-object) ()) (defclass noisy-window (window noisy-object) ()) (defclass colored-noisy-window (colored-window noisy-window) ())
ここで、colored-noisy-windowは二つの親クラス、colored-windowとnoisy-windowを持ち、colored-window は window と colored-object を、noisy-window は window と noisy-object を、それぞれ親に持ちます。これを以下のやうに確かめることができます。
CL-USER(32): (mop:class-direct-superclasses (find-class 'colored-noisy-window)) (#<STANDARD-CLASS COLORED-WINDOW> #<STANDARD-CLASS NOISY-WINDOW>) CL-USER(33): (mop:class-direct-superclasses (find-class 'colored-window)) (#<STANDARD-CLASS WINDOW> #<STANDARD-CLASS COLORED-OBJECT>) CL-USER(34): (mop:class-direct-superclasses (find-class 'noisy-window)) (#<STANDARD-CLASS WINDOW> #<STANDARD-CLASS NOISY-OBJECT>)
colored-noisy-windowのクラス優先順リストは次のやうに求まります。 defclass によって定義されたクラスは、通常 standard-object と t を繼承してゐることに注意ください。
CL-USER(40): (mop:finalize-inheritance (find-class 'colored-noisy-window)) NIL CL-USER(41): (mop:class-precedence-list (find-class 'colored-noisy-window)) (#<STANDARD-CLASS COLORED-NOISY-WINDOW> #<STANDARD-CLASS COLORED-WINDOW> #<STANDARD-CLASS NOISY-WINDOW> #<STANDARD-CLASS WINDOW> #<STANDARD-CLASS NOISY-OBJECT> #<STANDARD-CLASS COLORED-OBJECT> #<STANDARD-CLASS STANDARD-OBJECT> #<BUILT-IN-CLASS T>)
3.2 スロットの繼承
クラスの繼承關係を辿っていくと、時に祖クラス同士のスロット名や屬性が衝突することがあります。その場合には、クラス優先順リストの中から、より specific なクラスを求め、そのスロット名や屬性を繼承することが基本となります。
次の例を考へませう。
(defclass A () ((x :allocation :class :accessor x :initarg :x))) (defclass B (A) ((x :allocation :class :accessor slot-x :initform "x") (y :allocation :instance :type number :reader y :initarg :y))) (defclass C (A) ((y :initarg :slot-y :type integer :accessor slot-y) (z :allocation :class :initform 'z :accessor z))) (defclass D (B C) ((z)))
クラスDはクラス優先順リストとして(D B C A standard-object t)を持ちます。クラスDのインスタンスには三つのスロット x y z があり、スロットxはクラスB,D間で共有され、スロットy及びzはクラスDに固有となります。
CL-USER(52): (defvar D (make-instance 'D)) #<D @ #x100f710d2> CL-USER(53): (mop:class-precedence-list (class-of D)) (#<STANDARD-CLASS D> #<STANDARD-CLASS B> #<STANDARD-CLASS C> #<STANDARD-CLASS A> #<STANDARD-CLASS STANDARD-OBJECT> #<BUILT-IN-CLASS T>) CL-USER(54): (mop:class-slots (class-of D)) (#<ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION X @ #x100a6ca52> #<ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION Y @ #x100a6ca32> #<ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION Z @ #x100a6ca12>) CL-USER(55): (let ((slot-x (find 'X * :key #'mop:slot-definition-name)) (slot-y (find 'Y * :key #'mop:slot-definition-name)) (slot-z (find 'Z * :key #'mop:slot-definition-name))) (values (mop:slot-definition-allocation slot-x) (mop:slot-definition-allocation slot-y) (mop:slot-definition-allocation slot-z))) :CLASS :INSTANCE :INSTANCE
accessor メソッドは、定義された全てを使ふことが許されてをり、スロットxについて云へば、クラスAで定義された x 及び (setf x) と、クラスBで定義された slot-x 及び (setf slot-x) が利用できます。
CL-USER(60): (mop:class-direct-slots (find-class 'A))
(#<ACLMOP:STANDARD-DIRECT-SLOT-DEFINITION X @ #x100a6b252>)
CL-USER(61): (let ((slot (find 'X * :key #'mop:slot-definition-name)))
(values (mop:slot-definition-readers slot)
(mop:slot-definition-writers slot)))
(X)
((SETF X))
CL-USER(62): (mop:class-direct-slots (find-class 'B))
(#<ACLMOP:STANDARD-DIRECT-SLOT-DEFINITION X @ #x100a6f202>
#<ACLMOP:STANDARD-DIRECT-SLOT-DEFINITION Y @ #x100a6fe42>)
CL-USER(63): (let ((slot (find 'X * :key #'mop:slot-definition-name)))
(values (mop:slot-definition-readers slot)
(mop:slot-definition-writers slot)))
(SLOT-X)
((SETF SLOT-X))
クラスDはまた、初期化引數にクラスAから:xを繼承し、初期値にはクラスBから"x"を繼承します。
CL-USER(66): (let* ((slots (mop:class-slots (class-of D)))
(slot (find 'X slots :key #'mop:slot-definition-name)))
(values (mop:slot-definition-initargs slot)
(mop:slot-definition-initform slot)))
(:X)
"x"
スロットyについては、初期化引數と型がそれぞれ繼承されます。
CL-USER(70): (let* ((slots (mop:class-slots (class-of D)))
(slot (find 'Y slots :key #'mop:slot-definition-name)))
(values (mop:slot-definition-initargs slot)
(mop:slot-definition-type slot)))
(:Y :SLOT-Y)
INTEGER
スロットzは、クラスC定義に於いて :allocation :class とあるにもかかはらず、 クラスDでの :allocation は :instance となります。これは、Dの most-specific なクラスがD自身であることからの歸結です4。 初期値と accessor (readerとwriter) はCから繼承されます。
CL-USER(72): (let* ((slots (mop:class-slots (class-of D)))
(slot (find 'Z slots :key #'mop:slot-definition-name)))
(values (mop:slot-definition-allocation slot)
(mop:slot-definition-initform slot)))
:INSTANCE
'Z
CL-USER(73): (mop:class-direct-slots (find-class 'C))
(#<ACLMOP:STANDARD-DIRECT-SLOT-DEFINITION Y @ #x100a6f1a2>
#<ACLMOP:STANDARD-DIRECT-SLOT-DEFINITION Z @ #x100a6f142>)
CL-USER(74): (let ((slot (find 'Z * :key #'mop:slot-definition-name)))
(values (mop:slot-definition-readers slot)
(mop:slot-definition-writers slot)))
(Z)
((SETF Z))
4 總稱函數とメソッド
CLOSでは、クラスに特化した操作は、總稱函數 (generic function) とメソッド (method) によって與へられます。
總稱函數は零以上のメソッドから成り、總稱函數が呼ばれると、一つ或は複數のメソッドが選擇され實行されます。
CLOSに於けるメソッドは、 multi-method と呼ばれるもので、よくあるオブジェクト指向言語とは違ひ、クラスの構成要素ではありません。 メソッドは總稱函數の構成要素であり、總稱函數が呼ばれた際の引數の型の順序集合によって、どのメソッドが選擇されるかが判斷されます。
4.1 總稱函數とメソッドの定義
例を見ます。
總稱函數の定義には defgeneric を、
メソッドの定義には defmethod マクロを利用します。5
(defclass food () ()) (defclass ice-cream-cone (food) ()) (defclass cookie (food) ()) (defclass adult (person) ()) (defclass child (person) ()) (defgeneric eat (food person)) (defmethod eat ((food ice-cream-cone) (person adult)) "Eat top down, starting with ice cream.") (defmethod eat ((food ice-cream-cone) (person child)) "Eat bottom first.") (defmethod eat ((food cookie) (person adult)) "Bite into edge.") (defmethod eat ((food cookie) (person child)) "If there is filling, eat it first. Eat wafers the adult way.") (defmethod eat ((food food) (person person)) "Nonsense method.") (defmethod eat ((food t) (person t)) "Default method.")
總稱函數とメソッドは、どちらもCLOSに於ける first-class object です。
- lambda list: 總稱函數が要求する引數のリスト。
- argument precedence order: メソッド選擇の際にどの順序で引數をチェックしていくかのリスト。 通常は lambda list に現れる引數順序と同じです。
- method combination: 後で述べるメソッド結合 (method combination) を規定するオブジェクト。
CL-USER(163): #'eat #<STANDARD-GENERIC-FUNCTION EAT> CL-USER(164): (mop:generic-function-methods #'eat) (#<STANDARD-METHOD EAT (T T)> #<STANDARD-METHOD EAT (FOOD PERSON)> #<STANDARD-METHOD EAT (COOKIE CHILD)> #<STANDARD-METHOD EAT (COOKIE ADULT)> #<STANDARD-METHOD EAT (ICE-CREAM-CONE CHILD)> #<STANDARD-METHOD EAT (ICE-CREAM-CONE ADULT)>) CL-USER(165): (mop:generic-function-lambda-list #'eat) (FOOD PERSON) CL-USER(166): (mop:generic-function-argument-precedence-order #'eat) (FOOD PERSON) CL-USER(167): (mop:generic-function-method-combination #'eat) #<EXCL::STANDARD-METHOD-COMBINATION @ #x100201fb2>
メソッドは、以下を構成要素に持ちます。
- method function: メソッドが呼ばれた際に實行されるコード。
- method lambda list: ordinary function lambda list6
- method qualifiers: メソッド修飾子 −− 後で述べるメソッド結合の際にメソッドの役割を決める指標。
- parameter specializers: メソッド選擇を決定するための引數の型の竝び。7
CL-USER(200): (let ((method (find-method #'eat nil `(,(find-class 'cookie) ,(find-class 'adult))))) (values (mop:method-function method) (mop:method-lambda-list method) (method-qualifiers method) (mop:method-specializers method))) #<Interpreted Function (METHOD EAT (COOKIE ADULT))> ((FOOD COOKIE) (PERSON ADULT)) NIL (#<STANDARD-CLASS COOKIE> #<STANDARD-CLASS ADULT>)
4.2 メソッド選擇
メソッドは、與へられた引數の組が、そのメソッドが持つ parameter specializers との對應を充たしたときに applicable だと判斷されます。このやうなメソッドを、引數の組に對する applicable methods と呼びます。
全ての parameter specializers が t であるところのメソッドは default method と呼ばれます。
compute-applicable-methods は、precedence order に sort された applicable methods を返します。
總稱函數が呼ばれると、一般には、 most specific applicable method が適用されます。8
CL-USER(265): (mapcar #'mop:method-specializers (mop:generic-function-methods #'eat)) ((#<BUILT-IN-CLASS T> #<BUILT-IN-CLASS T>) (#<STANDARD-CLASS FOOD> #<STANDARD-CLASS PERSON>) (#<STANDARD-CLASS ICE-CREAM-CONE> #<STANDARD-CLASS ADULT>) (#<STANDARD-CLASS COOKIE> #<STANDARD-CLASS CHILD>) (#<STANDARD-CLASS COOKIE> #<STANDARD-CLASS ADULT>) (#<STANDARD-CLASS ICE-CREAM-CONE> #<STANDARD-CLASS CHILD>)) CL-USER(266): (defvar cookie (make-instance 'cookie)) CL-USER(267): (defvar adult (make-instance 'adult)) CL-USER(270): (compute-applicable-methods #'eat `(,cookie ,adult)) (#<STANDARD-METHOD EAT (COOKIE ADULT)> #<STANDARD-METHOD EAT (FOOD PERSON)> #<STANDARD-METHOD EAT (T T)>) CL-USER(271): (eat cookie adult) "Bite into edge."
4.3 メソッド結合
總稱函數が呼ばれると、applicable methods のうちの、一つ或は幾つか組み合はさったコードが實行される。これを effective method と呼びます。
effective method は次のやうに算出されます。 1) 與へられた引數から applicable methods を決定し、 2) それらを優先順に竝べ、 3) メソッド結合を適用して effective method を導く。effective method の適用結果が、即ち總稱函數の呼び出し結果となる。前章までに最初の二つは見ましたが、以下ではメソッド結合について述べます。
4.4 標準メソッド結合
CLOSがdefaultで提供してゐるメソッド結合が、標準メソッド結合 (standard method combination) です。標準メソッド結合には四つの役割があり、これらはメソッド修飾子 (method qualifier) で區別されます。
primary method は effective method の中心をなすものでメソッド修飾子を持たない。
auxiliary method は primary method 或は他の auxiliary method を補助するもので、 before, after, around の三つがあり、其其、 :before, :after, :around のメソッド修飾子を持つ。名前からわかるやうに、 before メソッドは primary method の前處理目的のもので、 after メソッドは後處理目的のものである。 around メソッドは、他のメソッドの前後を取り卷くやうに走り、メソッド呼出しの制御をとり行なふ。
標準メソッド結合の下では applicable methods は以下のやうに呼ばれる。
もし、 around メソッドが存在してゐれば、先づ most specific な around メソッドが呼ばれる。其の around メソッドの中で、 call-next-method が使はれてゐれば次のメソッドが呼び出されるが、もし call-next-method がなければ、他の一切のメソッドは呼出しを受けない。 around メソッドの中の call-next-method は、next most specific な around メソッドがあれば其れを呼ぶが、呼出すべき around メソッドが無ければ、 before, primary, after メソッドを次のルールで呼出す。
- 全ての before メソッドが most specific から始まって least specific への順番で呼ばれる。
- most specific な primary メソッドが呼ばれる。この中で、
call-next-methodが使はれてゐれば、next most specific な primary メソッドが呼出される。 - 全ての after メソッドが least specific から始まって most specific への順番で呼ばれる。
もし around メソッドが存在すれば、most specific な around メソッドの返り値が總稱函數の返り値となる。 around メソッドが無い場合には most specific な primary メソッドの返り値が總稱函數の返り値となる。 before, after メソッドの返り値は無視される。
4.5 標準メソッド結合の例
以下、標準メソッド結合をAn Introduction to CLOSからの例を使って見てみます。
先づ、簡單な幾何學オブジェクトとして、 point, line, polygon を定義します。
(defclass point () ((x :accessor x-coord :initarg :x) (y :accessor y-coord :initarg :y))) (defclass line () ((point1 :type point :accessor p1 :initarg :p1) (point2 :type point :accessor p2 :initarg :p2))) (defclass polygon () ((number-of-sides :type integer :accessor number-of-sides :initarg :number-of-sides) (sides :type list :accessor sides :initarg :sides :documentation "set of line segments")))
次にutilityを幾つか定義しておきます。
(defmethod same-point-p ((p1 point) (p2 point))
(and (= (x-coord p1) (x-coord p2))
(= (y-coord p1) (y-coord p2))))
(defmethod same-line-p ((l1 line) (l2 line))
(or (and (same-point-p (p1 l1) (p1 l2))
(same-point-p (p2 l1) (p2 l2)))
(and (same-point-p (p1 l1) (p2 l2))
(same-point-p (p2 l1) (p1 l2)))))
(defmethod line-length ((l line))
(let ((delta-x (- (x-coord (p1 l)) (x-coord (p2 l))))
(delta-y (- (y-coord (p1 l)) (y-coord (p2 l)))))
(sqrt (+ (* delta-x delta-x) (* delta-y delta-y)))))
(defmethod slope ((l line))
(let ((delta-y (- (y-coord (p1 l)) (y-coord (p2 l))))
(delta-x (- (x-coord (p1 l)) (x-coord (p2 l)))))
(if (= delta-x 0)
most-positive-single-float
(/ delta-y delta-x))))
(defmethod point-on-line-p ((p point) (l line))
(or (same-point-p (p1 l) p)
(same-point-p (p2 l) p)
(and (or (<= (x-coord (p1 l)) (x-coord p) (x-coord (p2 l)))
(<= (x-coord (p2 l)) (x-coord p) (x-coord (p1 l))))
(= (slope l) (slope (make-instance 'line :p1 (p1 l) :p2 p))))))
次に多角形を操作するためのメソッドを定義していきます。9
最初は多角形に頂點を加へる primary メソッドです。primaryメソッドでは本質的な操作にのみ集中します。
(defmethod add-vertex ((poly polygon) (new-vertex point) (old-side line))
"不要となる邊を取り去り、新たな頂點が作る二邊を加へる"
(setf (sides poly)
(cons (make-instance 'line :p1 new-vertex :p2 (p1 old-side))
(cons (make-instance 'line :p1 new-vertex :p2 (p2 old-side))
(remove-if #'(lambda (x)
(same-line-p x old-side))
(sides poly))))))
しかし、上記操作を行ふためには、新たに加へられる頂點が確かに新たな邊を生成するか否かのチェックが必要となります。次の around メソッドでは、チェックが通ったとき、始めて、 call-next-method が呼ばれる仕掛になってゐます。
(defmethod add-vertex :around
((poly polygon) (new-point point) (old-side line))
(loop for s in (sides poly)
if (point-on-line-p new-point s) return
(format t "Point on polygon: no change ~%")
finally (call-next-method)))
豫備的操作は before と after メソッドが受け持ちます。
(defmethod add-vertex :before
((poly polygon) (new-point point) (old-side line))
(incf (number-of-sides poly)))
(defmethod add-vertex :after
((poly polygon) (new-point point) (old-side line))
(format t "Polygon now has ~D sides.~%" (number-of-sides poly)))
次は頂點を取り去る操作です。ここでも primary メソッドは本質的な操作にのみ集中し、 around メソッドで、はたして有效な操作であるか否かの判斷をした上で、 前處理、後處理を before と after にまかせます。
(defmethod remove-vertex ((poly polygon) (p point))
"取り去るべき頂點から伸びる二本の邊を除き、新たにできた邊を加へる"
(let ((vertices '()))
(dolist (e (sides poly))
(when (same-point-p p (p1 e))
(setf (sides poly) (remove e (sides poly))
vertices (cons (p2 e) vertices)))
(when (same-point-p p (p2 e))
(setf (sides poly) (remove e (sides poly))
vertices (cons (p1 e) vertices))))
(setf (sides poly)
(cons (make-instance 'line :p1 (first vertices) :p2 (second vertices))
(sides poly)))))
(defmethod remove-vertex :around ((poly polygon) (p point))
(labels ((end-point-p (point line)
(or (same-point-p point (p1 line))
(same-point-p point (p2 line))))
(vertex-p (poly point)
(dolist (line (sides poly) nil)
(if (end-point-p point line) (return t)))))
(if (= (number-of-sides poly) 3)
(format t "Polygon has only 3 sides. Cannot remove vertex.")
(if (not (vertex-p poly p))
(format t "Not a vertex.")
(call-next-method)))))
(defmethod remove-vertex :before ((poly polygon) (p point))
(decf (number-of-sides poly)))
(defmethod remove-vertex :after ((poly polygon) (p point))
(format t "Polygon now has ~D sides.~%" (number-of-sides poly)))
メソッド結合は、新たなクラスが追加された際にも有用です。
今 polygon の subclass として triangle を考へます。
(defclass triangle (polygon)
((number-of-sides :allocation :class :initform 3)))
triangle に對しても、これまでの add-vertex と remove-vertex メソッドは變更することなく適用できます。ただし、triangleに頂點が加へられると、それは既にtriangleではなくなりpolygonとなりますので、そのことへの對應をaroundメソッドで記述したのが以下です。
最初にcall-next-methodで必要な操作を終へた後、
chage-classを使ってインスタンスのクラスを變更してゐます。
また、afterメソッドでは、渡された引數が既にtriangleではなくなった旨をメッセージ表示させます。
(defmethod add-vertex :around ((tri triangle) (new-vertex point) (old-side line)) (call-next-method) ;; If the change was legal, the figure now has 4 sides. (when (= (number-of-sides tri) 4) (change-class tri 'polygon))) (defmethod add-vertex :after ((tri triangle) (new-vertex point) (old-side line)) (format t "It is no longer a triangle~%"))
さて、ここで、前節で述べた effective method が具體的にどうprogrammerに見えるのかの例を示しておきます。
總稱函數を add-vertex、引數を各々polygon, point, line のインスタンスとして、先づ applicable-methodsを計算する。結果は most specific 順にsortされたメソッドのリストとなる。次にeffective-method を計算する。結果は call-method form となってゐて、最初が(polygon point line) を specializers に持つ around メソッドであり、next-method として、beforeメソッド、primaryメソッドとafterメソッドが控へてをり、返り値は primary method のそれになることが見てとれます。
CL-USER(339): (let* ((function #'add-vertex)
(args (list (make-instance 'polygon)
(make-instance 'point)
(make-instance 'line)))
(applicable-methods (compute-applicable-methods function args))
(method-combination (mop:generic-function-method-combination function))
(effective-method
(mop:compute-effective-method function method-combination applicable-methods)))
(values function
args
applicable-methods
method-combination
effective-method))
#<STANDARD-GENERIC-FUNCTION ADD-VERTEX>
(#<POLYGON @ #x100ca8272> #<POINT @ #x100ca82d2> #<LINE @ #x100ca8332>)
(#<STANDARD-METHOD ADD-VERTEX :BEFORE (POLYGON POINT LINE)>
#<STANDARD-METHOD ADD-VERTEX :AFTER (POLYGON POINT LINE)>
#<STANDARD-METHOD ADD-VERTEX :AROUND (POLYGON POINT LINE)>
#<STANDARD-METHOD ADD-VERTEX (POLYGON POINT LINE)>)
#<EXCL::STANDARD-METHOD-COMBINATION @ #x100201fb2>
(CALL-METHOD
#<STANDARD-METHOD ADD-VERTEX :AROUND (POLYGON POINT LINE)>
((MAKE-METHOD
(MULTIPLE-VALUE-PROG1
(PROGN (CALL-METHOD #<STANDARD-METHOD ADD-VERTEX :BEFORE (POLYGON POINT LINE)> NIL)
(CALL-METHOD #<STANDARD-METHOD ADD-VERTEX (POLYGON POINT LINE)> NIL))
(CALL-METHOD
#<STANDARD-METHOD ADD-VERTEX :AFTER (POLYGON POINT LINE)> NIL)))))
次に、 add-vertex への引數に triangle のインスタンスを渡したときの effective method を見てみます。
總稱函數はadd-vertex、今度はtriangle にspecializeさせます。compute-applicable-methodsの結果はこの通り。effective-methodの結果はやはり call-method formとなってゐますが、最初がtriangle にspecializeされたaroundメソッド。next-methodには、polygon にspecializeされたaroundメソッド、さらにそこからの next-method が polygonにspecializeされた、before、primary、afterときて、最後がtrianleにspecializeされたafterメソッドであり、返り値は primary method のそれになることが見てとれます。
CL-USER(348): (let* ((function #'add-vertex) (args (list (make-instance 'triangle) (make-instance 'point) (make-instance 'line))) (applicable-methods (compute-applicable-methods function args)) (method-combination (mop:generic-function-method-combination function)) (effective-method (mop:compute-effective-method function method-combination applicable-methods))) (values function args applicable-methods method-combination effective-method)) #<STANDARD-GENERIC-FUNCTION ADD-VERTEX> (#<TRIANGLE @ #x100bb82b2> #<POINT @ #x100bb8312> #<LINE @ #x100bb8372>) (#<STANDARD-METHOD ADD-VERTEX :AFTER (TRIANGLE POINT LINE)> #<STANDARD-METHOD ADD-VERTEX :AROUND (TRIANGLE POINT LINE)> #<STANDARD-METHOD ADD-VERTEX :BEFORE (POLYGON POINT LINE)> #<STANDARD-METHOD ADD-VERTEX :AFTER (POLYGON POINT LINE)> #<STANDARD-METHOD ADD-VERTEX :AROUND (POLYGON POINT LINE)> #<STANDARD-METHOD ADD-VERTEX (POLYGON POINT LINE)>) #<EXCL::STANDARD-METHOD-COMBINATION @ #x100201fb2> (CALL-METHOD #<STANDARD-METHOD ADD-VERTEX :AROUND (TRIANGLE POINT LINE)> (#<STANDARD-METHOD ADD-VERTEX :AROUND (POLYGON POINT LINE)> (MAKE-METHOD (MULTIPLE-VALUE-PROG1 (PROGN (CALL-METHOD #<STANDARD-METHOD ADD-VERTEX :BEFORE (POLYGON POINT LINE)> NIL) (CALL-METHOD #<STANDARD-METHOD ADD-VERTEX (POLYGON POINT LINE)> NIL)) (CALL-METHOD #<STANDARD-METHOD ADD-VERTEX :AFTER (POLYGON POINT LINE)> NIL) (CALL-METHOD #<STANDARD-METHOD ADD-VERTEX :AFTER (TRIANGLE POINT LINE)> NIL)))))
4.6 他のメソッド結合
CLOSには standard method combination の他にも幾つかの method combination type が豫め用意されてゐて、それらは、 +, and, append, list, max, min, nconc, or, progn となります。
以下に + と list の例を示しておきます。
最初に sales, technical, consulting の三つの mixin クラスと、それらを纏めた company クラスを定義します。
(defclass sales () ((sales-profit :initarg :sales-profit :accessor sales-profit) (sales-manager :initarg :sales-manager :accessor sales-manager))) (defclass technical () ((technical-profit :initarg :technical-profit :accessor technical-profit) (technical-manager :initarg :technical-manager :accessor technical-manager))) (defclass consulting () ((consulting-profit :initarg :consulting-profit :accessor consulting-profit) (consulting-manager :initarg :consulting-manager :accessor consulting-manager))) (defclass company (sales technical consulting) ())
次に以下のやうにインスタンスを生成します。
CL-USER(384): (defparameter company
(make-instance 'company
:sales-profit 10000 :technical-profit 20000 :consulting-profit 30000
:sales-manager "John" :technical-manager "Marc" :consulting-manager "Luke"))
COMPANY
profits は sales, technical, consulting 部門の總合利益を算出するメソッドとして以下のやうに + method combination を使ひ定義します。
(defgeneric profits (x) (:method-combination +)) (defmethod profits + ((x sales)) (sales-profit x)) (defmethod profits + ((x technical)) (technical-profit x)) (defmethod profits + ((x consulting)) (consulting-profit x))
managers は sales, technical, consulting 部門の管理者一覽を算出するメソッドとして以下のやうに list method combination を使ひ定義します。
(defgeneric managers (x) (:method-combination list)) (defmethod managers list ((x sales)) (sales-manager x)) (defmethod managers list ((x technical)) (technical-manager x)) (defmethod managers list ((x consulting)) (consulting-manager x))
profits と managers の實行結果は以下のやうになります。
CL-USER(385): (profits company)
60000
CL-USER(386): (managers company)
("John" "Marc" "Luke")
5 オブジェクトの生成とその初期化
CLOSのオブジェクト生成と初期化プロトコルは、インスタンス生成のための柔軟なメカニズムを與へくれてゐます。生成の個々のステップは一つ一つが總稱函數により與へられてゐますので、これら總稱函數そのものをカスタマイズするか、或は初期化引數をうまく工夫することによる制御が可能になります。
5.1 インスタンス生成
インスタンスは一般に總稱函數make-instanceにより生成されます。
make-instanceは次の手順を踏みます。 1) 初期化引數の有效チェックをし、 2) インスタンス領域確保のためのallocate-instanceが呼ばれ、 3) 初期化のためのinitialize-instanceとshared-initializeが呼ばれます。 make-instance に渡された引數は、上記各ステップにも渡っていきますので、以下でその役割を見ていくことにします。
5.2 初期化引數
初期化引數は、 defclass スロット記述の :initarg で指定されるか、或は、
allocate-instance, initialize-instance, shared-initialize に於いてkeyword名指定されたsymbolである場合に、有效とされます。
make-instance では、明示的に與へられた初期化引數と値の組を元に、 defaulted initialization argument list を組み立て、それを initialize-instance と shared-initialize に引き渡します。
initialize-instance と shared-initialize では、defaulted initialization argument list を元にスロットの初期化を行ひますが、初期値が明示的に與へられてゐないスロットについては、 :initform に從って、その値を埋めます。
なほ、スロットの初期値は、クラスオプションを使ってdefaultの値を指示しておくこともできます。先に出た point を以下のやうに定義しておけば、 make-instance 時に明示的に引數を渡してやらなくても、x と y には其其、零が初期値として入ります。
(defclass point () ((x :accessor x-coord :initarg :x) (y :accessor y-coord :initarg :y)) (:default-initargs :x 0 :y 0))
5.3 オブジェクトの生成とその初期化をカスタマイズする
オブジェクトの生成と初期化は、そのプロトコルを形成する總稱函數 make-instance, allocate-instance, initialize-instance, shared-initialize に、新たなメソッドを追加することで、カスタマイズすることができます。
例へば、次の initialize-instance メソッドは、pointの初期化を極座標を使って行ふことを可能にします。
(defmethod initialize-instance :after ((p point)
&key ((:rho rho) 0.0 rho-supplied)
((:theta theta) 0.0 theta-supplied))
(when (and rho-supplied theta-supplied)
(setf (x-coord p) (* rho (cos theta))
(y-coord p) (* rho (sin theta)))))
次のやうにmake-instanceを呼ぶことができるやうになりました。
traceをかけて make-instance, allocate-instance, initialize-instance, initialize-instance after, shared-initialize が各々どのやうに呼ばれてゐるかを觀察しててみます。
CL-USER(421): (prog2 (trace make-instance allocate-instance initialize-instance shared-initialize) (make-instance 'point :rho 2 :theta (/ pi 2)) (untrace)) 0[5]: (MAKE-INSTANCE POINT :RHO 2 :THETA 1.5707963267948966d0) 0* #<STANDARD-METHOD MAKE-INSTANCE (SYMBOL)> 1[5]: (MAKE-INSTANCE #<STANDARD-CLASS POINT> :RHO 2 :THETA 1.5707963267948966d0) 1* #<STANDARD-METHOD MAKE-INSTANCE (CLASS)> 2[5]: (ALLOCATE-INSTANCE #<STANDARD-CLASS POINT> :RHO 2 :THETA 1.5707963267948966d0) 2* #<STANDARD-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS)> 2[5]: returned #<POINT @ #x1046bb3b2> 2[5]: (INITIALIZE-INSTANCE #<POINT @ #x1046bb3b2> :RHO 2 :THETA 1.5707963267948966d0) 2* (MULTIPLE-VALUE-PROG1 #<STANDARD-METHOD INITIALIZE-INSTANCE (STANDARD-OBJECT)> #<STANDARD-METHOD INITIALIZE-INSTANCE :AFTER (POINT)>) 3[5]: (SHARED-INITIALIZE #<POINT @ #x1046bb3b2> T :RHO 2 :THETA 1.5707963267948966d0) 3* #<STANDARD-METHOD SHARED-INITIALIZE (STANDARD-OBJECT T)> 3[5]: returned #<POINT @ #x1046bb3b2> 2[5]: returned #<POINT @ #x1046bb3b2> 1[5]: returned #<POINT @ #x1046bb3b2> 0[5]: returned #<POINT @ #x1046bb3b2> #<POINT @ #x1053b5be2> CL-USER(422): (describe *) #<POINT @ #x1053b5be2> is an instance of #<STANDARD-CLASS POINT>: The following slots have :INSTANCE allocation: X 1.2246467991473532d-16 Y 2.0d0
6 クラス再定義
CLOSの柔軟性を現す最後の例として、クラスの再定義を考へてみます。
defclass form が評價されたときに、既に同じ名前のクラスが存在すれば、そのクラスは動的に再定義されることになります。クラスの再定義は、既にあるクラスメタオブジェクトを書き換へると同時に、そのクラス及びサブクラスのインスタンスにも變更が及びます。この一連の變更操作に於いて、クラスメタオブジェクトとインスタンスの一意性は確保され、新たなインスタンスが生成されるといったことは置こりません。
クラス再定義もまた、定められた總稱函數 — update-instance-for-redefined-classとshared-initialize — にメソッドを追加してやることで、カスタマイズ可能となるやう設計されてゐます。
或るクラスが再定義される際には、そのインスタンスに變更を傳播するために、update-instance-for-redefined-classが呼ばれることになってゐます。update-instance-for-redefined-classは、變更されたインスタンスの初期化の目的で、shared-initializeを呼出します。
次の例を見てみませう。
(defclass employee () ((name :accessor name :initarg :name) (dept :accessor department :initarg :department) (salary :accessor salary :initarg :salary) (id :reader employee-id :initform (gensym)))) (defclass department () ((name :accessor name :initarg :name) (manager :accessor manager :type employee :initarg :manager) (expenses :accessor expenses) (budget :accessor budget)))
それぞれ employee と department のインスタンスを生成し、 *employees* と departments* に保持します。
CL-USER(514): (defvar john (make-instance 'employee :name "John")) JOHN CL-USER(515): (defvar luke (make-instance 'employee :name "Luke")) LUKE CL-USER(516): (defvar sales (make-instance 'department :name "Sales")) SALES CL-USER(517): (defvar *employees* (list john luke)) *EMPLOYEES* CL-USER(518): (defvar *departments* (list sales)) *DEPARTMENTS*
employee の manager を指定すれば、自動的に dept スロットが埋まるやうにメソッドを整へます。
(defmethod manager ((e employee))
(manager (department e)))
(defmethod (setf manager) (new-manager (e employee))
(flet ((department-managed-by (m)
(dolist (d *departments* nil)
(if (eq (manager d) m) (return d)))))
(setf (department e)
(department-managed-by new-manager))))
以下動作確認。
CL-USER(529): (setf (manager sales) luke) CL-USER(533): (setf (manager john) luke) #<DEPARTMENT @ #x104099522> CL-USER(534): (name (department john)) "Sales"
扨、ここで、會社が思ってゐたよりもずっと屬人的な會社であったと假定します。 employee は department よりも、その manager に引っ付いて部署を渡り歩くやうな會社を想像してみて下さい。
そこで、次のやうに employee の定義を變へたとします。
(defclass employee () ((name :accessor name :initarg :name) (manager :accessor manager :initarg :manager) (salary :accessor salary :initarg :salary) (id :reader employee-id :initform (gensym))))
このやうに既存のクラスが書き換へられたとき、このクラスのインスタンスには、次の參照までの或タイミングにおいて、クラスの變更が傳播されることになってゐますが、この際、消えたり加へられたりしたスロットを齟齬の無いやうに整へておくことができると非常に具合がよろしい。
上例に於いては、employee に元々あった dept スロットが消え、新たに manager スロットが追加されてゐますので、消えたスロットを救濟して新たなスロット値を設定しておくことが求められます。
これを update-instance-for-redefined-class にメソッド追加をすることで行ひます。
update-instance-for-redefined-class には、1) インスタンス、2) 新たに追加されるスロット、3) 消されるスロット、4) 消されるスロットが持ってゐた値のプロパティリスト、5) 初期化引數、が渡って來ることになってゐますので、ここでは、以下のやうな :after メソッドを定義します。
(defmethod update-instance-for-redefined-class :after
((emp employee) added deleted plist &rest initargs)
(declare (ignore added deleted initargs))
(let ((dept (getf plist 'dept)))
(when (not (null dept))
(setf (manager emp) (manager dept)))))
John の manager が Luke となってゐる事を確認すると同時に、
traceを使って、 update-instance-for-redefined-class が呼ばれる樣子を見てみます。
CL-USER(611): (prog2 #+allegro (trace ((method update-instance-for-redefined-class
:after (employee t t t))))
#-allegro (trace update-instance-for-redefined-class)
(name (manager john))
(untrace))
0[5]: ((METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS :AFTER (EMPLOYEE T T T))
#<EMPLOYEE @ #x1009ca2b2> ; 一つ目のインスタンス (=john)
(MANAGER) ; added slots
(DEPT) ; deleted slots
(DEPT #<DEPARTMENT @ #x1009d61c2>)) ; property list
1[5]: ((METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS :AFTER (EMPLOYEE T T T))
#<EMPLOYEE @ #x1009d5772> ; 二つ目のインスタンス (=luke)
(MANAGER) ; added slots
(DEPT) ; deleted slots
NIL) ; property list
1[5]: returned NIL
0[5]: returned #<EMPLOYEE @ #x1009d5772>
"Luke"
7 結論
本稿では、CLOSの概要を、An Introduction to CLOSに沿って見てきました。
CLOSは、クラス、總稱函數、メソッド、多重繼承の概念に基いたものですが、同時に、 CLOSでは、クラス、メソッド、總稱函數、メソッド結合など全てが、そのインスタンスと同樣に、 first-class object として、參照でき、また動的に操作できる事を、 meta object protocol によって定められた總稱函數を使って 概觀してみました。
CLOSに特有のこの性質は、學術的興味に留まらず、日日のプログラミング作業においても、試驗や運用の場面でとても重寶なものです。
Footnotes:
全てのクラスがインスタンスを持たないといけないといふことではありません。 mixin クラスのやうに補助的役割を擔ふだけのクラスもあります。
本稿では superclasses を祖クラス、 direct superclasses を親クラスと呼ぶことにします。讀みはどちらも「おやくらす」です。
例へば persistent object system などへの應用が擧げられます
スロット定義に於いて :allocation が省略されると :instance 指定とみなされます。
總稱函數を規定するmetaobject全てにdefaultを期待する場合には defgeneric は省略することができます。
eql specializer についての解説は、本稿では割愛します。
メソッド結合が指定されてゐなければ、の條件附き。
凸面の多角形のみ考慮。
Comments
Post a Comment