The Common Lisp Cookbook – CLOS の基礎

Table of Contents

The Common Lisp Cookbook – CLOS の基礎

📢 🎓 ⭐ Learn Common Lisp efficiently in videos, by the Cookbook's main contributor. Learn more.

🖊️ Discover a new Common Lisp and Coalton editor for beginners: mine and a new VSCode extension for Common Lisp: OLIVE.

CLOS は “Common Lisp Object System” の略で、どの言語でも利用できるオブジェクトシステムの中でも、おそらく最も強力なものの 1 つです。

その機能には次のようなものがあります。

この名前に属する機能は、1984 年の Steele による “Common Lisp, the Language” 初版の出版から、その 10 年後に ANSI 標準として言語が正式化されるまでの間に Common Lisp 言語へ追加されました。

このページは CLOS の使い方を十分に理解できるようにすることを目指しますが、MOP については簡単な導入にとどめます。

これらの主題を深く学ぶには、次の 2 冊が必要です。

あわせて次も参照してください。

クラスとインスタンス

まず試す

クラス定義、オブジェクト作成、スロットアクセス、特定クラスに特殊化したメソッド、継承を示す例から始めましょう。

(defclass person ()
  ((name
    :initarg :name
    :accessor name)
   (lisper
    :initform nil
    :accessor lisper)))

;; => #<STANDARD-CLASS PERSON>

(defvar p1 (make-instance 'person :name "me" ))
;;                                 ^^^^ initarg
;; => #<PERSON {1006234593}>

(name p1)
;;^^^ accessor
;; => "me"

(lisper p1)
;; => nil
;;    ^^ initform (slot unbound by default)

(setf (lisper p1) t)


(defclass child (person)
  ())

(defclass child (person)
  ((can-walk-p
     :accessor can-walk-p
     :initform t)))
;; #<STANDARD-CLASS CHILD>

(can-walk-p (make-instance 'child))
;; T

クラスの定義 (defclass)

CLOS で新しいデータ型を定義するために使うマクロは defclass です。

先ほどは次のように使いました。

(defclass person ()
  ((name
    :initarg :name
    :accessor name)
   (lisper
    :initform nil
    :accessor lisper)))

これにより、person という CLOS 型 (またはクラス) と、name および lisper という 2 つのスロットが得られます。

(class-of p1)
#<STANDARD-CLASS PERSON>

(type-of p1)
PERSON

defclass の一般形は次のとおりです。

(defclass <class-name> (list of super classes)
  ((slot-1
     :slot-option slot-argument)
   (slot-2, etc))
  (:optional-class-option
   :another-optional-class-option))

つまり、私たちの person クラスは別のクラスを明示的には継承していません (空の括弧 () を受け取っています)。 しかし、それでもデフォルトでクラス t と standard-object から継承しています。 下の「継承」を参照してください。

スロットオプションなしの最小限のクラス定義は次のように書けます。

(defclass point ()
  (x y z))

あるいはスロット指定子すらなく、(defclass point () ()) と書くこともできます。

オブジェクトの作成 (make-instance)

クラスのインスタンスは make-instance で作成します。

(defvar p1 (make-instance 'person :name "me" ))

一般に、コンストラクタを定義するのはよい習慣です。

(defun make-person (name &key lisper)
  (make-instance 'person :name name :lisper lisper))

これには、必要な引数を制御できるという直接的な利点があります。 この時点では、クラス自体ではなく、コンストラクタをパッケージから export すべきです。

スロット

常に使える関数 (slot-value)

任意のスロットへいつでもアクセスするための関数は (slot-value <object> <slot-name>) です。

上の point クラスはスロットアクセサを定義していませんでした。

(defvar pt (make-instance 'point))

(inspect pt)
The object is a STANDARD-OBJECT of type POINT.
0. X: "unbound"
1. Y: "unbound"
2. Z: "unbound"

型 POINT のオブジェクトは得られましたが、スロットはデフォルトでは unbound です。 アクセスしようとすると UNBOUND-SLOT condition が発生します。

(slot-value pt 'x) ;; => condition: the slot is unbound

slot-value は setf できます。

(setf (slot-value pt 'x) 1)
(slot-value pt 'x) ;; => 1

初期値とデフォルト値 (initarg, initform)

(make-instance 'person :name "me")

(繰り返しますが、スロットはデフォルトでは unbound です)

スロットを明確に必須にするため、次のようなテクニックを見ることがあります。

(defclass foo ()
    ((a
      :initarg :a
      :initform (error "you didn't supply an initial value for slot a"))))
;; #<STANDARD-CLASS FOO>

(make-instance 'foo) ;; => enters the debugger.

getter と setter (accessor, reader, writer)

(name p1) ;; => "me"

(type-of #'name)
STANDARD-GENERIC-FUNCTION

これらのどれも指定しなくても、slot-value は使えます。

1 つのスロットに複数の :accessor、:reader、:initarg を与えることもできます。

状況によってスロットへのアクセスを短く書くため、2 つのマクロを紹介します。

1- with-slots は、複数の slot-value 呼び出しを短く書けるようにします。 第 1 引数はスロット名のリストです。 第 2 引数は CLOS インスタンスへ評価されます。 その後に省略可能な宣言と暗黙の progn が続きます。 本体の評価中、レキシカルには、これらの名前を変数として参照することは、対応するインスタンスのスロットを slot-value で参照することと同じです。

(with-slots (name lisper)
    c1
  (format t "got ~a, ~a~&" name lisper))

または

(with-slots ((n name)
             (l lisper))
    c1
  (format t "got ~a, ~a~&" n l))

2- with-accessors も同様ですが、スロットのリストではなく accessor 関数のリストを取ります。 マクロ内で変数を参照すると、accessor 関数の呼び出しと同じになります。

(with-accessors ((name        name)
                  ^^variable  ^^accessor
                 (lisper lisper))
            p1
          (format t "name: ~a, lisper: ~a" name lisper))

クラススロットとインスタンススロット

:allocation は、このスロットが local か shared かを指定します。

次の例では、p2 のクラススロット species の値を変更すると、そのクラスのすべてのインスタンス (それらがすでに存在しているかどうかにかかわらず) に影響することに注目してください。

(defclass person ()
  ((name :initarg :name :accessor name)
   (species
      :initform 'homo-sapiens
      :accessor species
      :allocation :class)))

;; 既存のインスタンスからスロット "lisper" が削除されたことに注意。
(inspect p1)
;; The object is a STANDARD-OBJECT of type PERSON.
;; 0. NAME: "me"
;; 1. SPECIES: HOMO-SAPIENS
;; > q

(defvar p2 (make-instance 'person))

(species p1)
(species p2)
;; HOMO-SAPIENS

(setf (species p2) 'homo-numericus)
;; HOMO-NUMERICUS

(species p1)
;; HOMO-NUMERICUS

(species (make-instance 'person))
;; HOMO-NUMERICUS

(let ((temp (make-instance 'person)))
    (setf (species temp) 'homo-lisper))
;; HOMO-LISPER
(species (make-instance 'person))
;; HOMO-LISPER

スロットのドキュメント

各スロットは :documentation オプションを 1 つ受け取れます。 documentation でそのドキュメントを取得するには、スロットオブジェクトを取得する必要があります。 これは closer-mop のようなライブラリを使うと移植性のある形で行えます。例:

(closer-mop:class-direct-slots (find-class 'my-class))
;; => スロット (オブジェクト) のリスト
(find 'my-slot * :key #'closer-mop:slot-definition-name)
;; => 目的のスロットを名前で探す
(documentation * t) ; そのドキュメントを取得する

ただし一般には、スロットではなくスロット accessor をドキュメント化するほうがよいかもしれません。 スロットは実装詳細であり、公開インターフェイスの一部ではない、という見方が広くあります。

スロット型

:type スロットオプションは、期待どおりの仕事をしないかもしれません。 CLOS に慣れていないなら、このセクションは飛ばし、自分のコンストラクタで手動でスロット型をチェックすることをおすすめします。

実際、スロット型がチェックされるかどうかは未定義です。Hyperspec を参照してください。

これを行う実装は少数です。Clozure CL は行います。SBCL はバージョン 1.5.9 (2019 年 11 月) 以降、または safety が高い場合 ((declaim (optimise safety))) に行います。

別の方法で行うには、this Stack-Overflow answer を参照してください。また、契約プログラミングライブラリ quid-pro-quo も参照してください。

find-class, class-name, class-of

(find-class 'point)
;; #<STANDARD-CLASS POINT 275B78DC>

(class-name (find-class 'point))
;; POINT

(class-of my-point)
;; #<STANDARD-CLASS POINT 275B78DC>

(typep my-point (class-of my-point))
;; T

CLOS クラスもまた CLOS クラスのインスタンスであり、下の例のように、そのクラスが何かを調べられます。

(class-of (class-of my-point))
;; #<STANDARD-CLASS STANDARD-CLASS 20306534>

Note: これは MOP への最初の導入です。始めるだけなら必要ありません!

オブジェクト my-point は point という名前のクラスのインスタンスであり、point という名前のクラス自体は standard-class という名前のクラスのインスタンスです。 standard-class という名前のクラスは、my-point の metaclass (つまりクラスのクラス) であると言います。 後で見るように、metaclass はうまく活用できます。

サブクラスと継承

上で示したように、child は person のサブクラスです。

すべてのオブジェクトはクラス standard-object と t から継承します。

すべての child インスタンスは person のインスタンスでもあります。

(type-of c1)
;; CHILD

(subtypep (type-of c1) 'person)
;; T

(ql:quickload "closer-mop")
;; ...

(closer-mop:subclassp (class-of c1) 'person)
;; T

closer-mop ライブラリは、CLOS/MOP 操作を行うための移植性のある定番の方法です。

サブクラスは親のすべてのスロットを継承し、そのスロットオプションを上書きできます。 Common Lisp はこのプロセスを動的にしており、REPL セッションに適しています。 さらに、その一部を制御することもできます (特定のスロットが削除、更新、追加されたときに何かをする、など)。

したがって、child の class precedence list は次のようになります。

child <- person <-- standard-object <- t

これは次で取得できます。

(closer-mop:class-precedence-list (class-of c1))
;; (#<standard-class child>
;;  #<standard-class person>
;;  #<standard-class standard-object>
;;  #<sb-pcl::slot-class sb-pcl::slot-object>
;;  #<sb-pcl:system-class t>)

しかし、child の direct superclass は次だけです。

(closer-mop:class-direct-superclasses (class-of c1))
;; (#<standard-class person>)

さらに class-direct-[subclasses, slots, default-initargs] や多くの関数でクラスを調べられます。

スロットの結合にはいくつかの規則があります。

最後に重要な注意として、継承はかなり誤用しやすく、多重継承ではその危険がさらに増えます。少し注意してください。 foo が本当に bar を継承したいのか、それとも foo のインスタンスが bar を含むスロットを持ちたいのかを自問してください。 一般的な指針として、foo と bar が「同じ種類のもの」なら継承で混ぜるのは正しいですが、本当に別々の概念なら、スロットを使って分けておくべきです。

多重継承

CLOS は多重継承をサポートします。

(defclass baby (child person)
  ())

親クラスのリストで最初にあるクラスが最も特定的です。 child のスロットは person のスロットより優先されます。 この例では、baby を定義する前に child と person の両方が定義されている必要があることに注意してください。

クラスの再定義と変更

このセクションでは 2 つの話題を簡単に扱います。

詳細は軽く流します。MOP が公開するメソッドを実装することで、すべて設定可能だと言えば十分です。

クラスを再定義するには、新しい defclass フォームを評価するだけです。 それが古い定義の代わりになり、既存のクラスオブジェクトが更新され、そのクラスのすべてのインスタンス (および再帰的にそのサブクラス) は 新しい定義を反映するよう遅延更新されます。 新しい defclass 以外を再コンパイルする必要も、オブジェクトを無効化する必要もありません。少し考えてみてください。これはすごいことです!

たとえば、私たちの person クラスでは:

(defclass person ()
  ((name
    :initarg :name
    :accessor name)
   (lisper
    :initform nil
    :accessor lisper)))

(setf p1 (make-instance 'person :name "me" ))

スロットの変更、追加、削除…

(lisper p1)
;; NIL

(defclass person ()
  ((name
    :initarg :name
    :accessor name)
   (lisper
    :initform t        ;; <-- from nil to t
    :accessor lisper)))

(lisper p1)
;; NIL (of course!)

(lisper (make-instance 'person :name "You"))
;; T

(defclass person ()
  ((name
    :initarg :name
    :accessor name)
   (lisper
    :initform nil
    :accessor lisper)
   (age               ;; <-- new slot
    :initarg :arg
    :initform 18      ;; <-- default value
    :accessor age)))

(age p1)
;; => 18。正しい。この新しいスロットのデフォルト initform。

(slot-value p1 'bwarf)
;; => "the slot bwarf is missing from the object #<person…>"

(setf (age p1) 30)
(age p1) ;; => 30

(defclass person ()
  ((name
    :initarg :name
    :accessor name)))

(slot-value p1 'lisper) ;; => slot lisper is missing.
(lisper p1) ;; => there is no applicable method for the generic function lisper when called with arguments #(lisper).

インスタンスのクラスを変更するには change-class を使います。

(change-class p1 'child)
;; 新しいクラスのスロットも設定できる:
(change-class p1 'child :can-walk-p nil)

(class-of p1)
;; #<STANDARD-CLASS CHILD>

(can-walk-p p1)
;; T

上の例では、私は child になり、デフォルトで true である can-walk-p スロットを継承しました。

Pretty printing

ここまでオブジェクトを表示するたびに、次のような出力が得られました。

#<PERSON {1006234593}>

これでは多くを語っていません。

もっと情報を表示したい場合はどうでしょうか。たとえば:

#<PERSON me lisper: t>

Pretty printing は、このクラス向けに generic print-object method を特殊化することで行います。

(defmethod print-object ((obj person) stream)
      (print-unreadable-object (obj stream :type t)
        (with-accessors ((name name)
                         (lisper lisper))
            obj
          (format stream "~a, lisper: ~a" name lisper))))

これは次を返します。

p1
;; #<PERSON me, lisper: T>

print-unreadable-object は #<...> を出力します。これは、このオブジェクトを reader が読み戻せないことを示します。 :type t 引数は、オブジェクト型のプレフィックス、つまり PERSON を出力するよう求めます。 これがないと #<me, lisper: T> になります。

ここでは with-accessors マクロを使いましたが、単純な場合はもちろん次で十分です。

(defmethod print-object ((obj person) stream)
  (print-unreadable-object (obj stream :type t)
    (format stream "~a, lisper: ~a" (name obj) (lisper obj))))

注意: デフォルトで束縛されていないスロットにアクセスしようとするとエラーになります。slot-boundp を使ってください。

参考までに、次はデフォルトの挙動を再現します。

(defmethod print-object ((obj person) stream)
  (print-unreadable-object (obj stream :type t :identity t)))

ここで :identity を t にすると {1006234593} というアドレスが出力されます。

伝統的な Lisp 型のクラス

ここでは、CLOS を使うために CLOS オブジェクトが必要なわけではない、という点に近づきます。

ありがたいことに、前のセクションで紹介した関数は、CLOS インスタンスではない Lisp オブジェクトにも使えます。

(find-class 'symbol)
;; #<BUILT-IN-CLASS SYMBOL>
(class-name *)
;; SYMBOL
(eq ** (class-of 'symbol))
;; T
(class-of ***)
;; #<STANDARD-CLASS BUILT-IN-CLASS>

ここで、シンボルはシステムクラス symbol のインスタンスであることがわかります。 これは、対応する Lisp 型と同じ名前のクラスが存在することを言語が要求する 75 個のケースの 1 つです。 これらの多くは CLOS 自体 (たとえば型 standard-class と同名の CLOS クラスの対応) または condition system (実装によって CLOS クラスで構築されているかもしれないし、そうでないかもしれないもの) に関係しています。 しかし、「伝統的な」Lisp 型に関係する対応が 33 個残っています。

array hash-table readtable
bit-vector integer real
broadcast-stream list sequence
character logical-pathname stream
complex null string
concatenated-stream number string-stream
cons package symbol
echo-stream pathname synonym-stream
file-stream random-state t
float ratio two-way-stream
function rational vector


すべての「伝統的な」Lisp 型がこのリストに含まれるわけではないことに注意してください。 (atom、fixnum、short-float、およびシンボルで表されない型を考えてみてください。)

t が存在するのは興味深いことです。 すべての Lisp オブジェクトが型 t であるのと同じように、すべての Lisp オブジェクトは t という名前のクラスのメンバーでもあります。 これは同時に複数のクラスに属する単純な例であり、後である程度詳しく考える inheritance の問題を持ち出します。

(find-class t)
;; #<BUILT-IN-CLASS T 20305AEC>

Lisp 型に対応するクラスに加えて、定義したすべての structure 型にも CLOS クラスがあります。

(defstruct foo)
FOO

(class-of (make-foo))
;; #<STRUCTURE-CLASS FOO 21DE8714>

structure-object の metaclass はクラス structure-class です。 「伝統的な」Lisp オブジェクトの metaclass が standard-class、structure-class、built-in-class のどれであるかは実装依存です。 制約:

built-in-class: make-instance を使えず、slot-value を使えず、defclass で変更できず、サブクラスを作成できません。

structure-class: make-instance は使えません。slot-value は動くかもしれません (実装依存)。アプリケーションの structure 型をサブクラス化するには defstruct を使います。既存の structure-class を変更した結果は未定義です。完全な再コンパイルが必要になるかもしれません。

standard-class: これらの制約はありません。

イントロスペクション

いくつかのイントロスペクション関数はすでに見ました。

最善の選択肢は、closer-mop ライブラリを知り、CLOS & MOP specifications を手元に置いておくことです。

さらに多くの関数:

closer-mop:class-default-initargs
closer-mop:class-direct-default-initargs
closer-mop:class-direct-slots
closer-mop:class-direct-subclasses
closer-mop:class-direct-superclasses
closer-mop:class-precedence-list
closer-mop:class-slots
closer-mop:classp
closer-mop:extract-lambda-list
closer-mop:extract-specializer-names
closer-mop:generic-function-argument-precedence-order
closer-mop:generic-function-declarations
closer-mop:generic-function-lambda-list
closer-mop:generic-function-method-class
closer-mop:generic-function-method-combination
closer-mop:generic-function-methods
closer-mop:generic-function-name
closer-mop:method-combination
closer-mop:method-function
closer-mop:method-generic-function
closer-mop:method-lambda-list
closer-mop:method-specializers
closer-mop:slot-definition
closer-mop:slot-definition-allocation
closer-mop:slot-definition-initargs
closer-mop:slot-definition-initform
closer-mop:slot-definition-initfunction
closer-mop:slot-definition-location
closer-mop:slot-definition-name
closer-mop:slot-definition-readers
closer-mop:slot-definition-type
closer-mop:slot-definition-writers
closer-mop:specializer-direct-generic-functions
closer-mop:specializer-direct-methods
closer-mop:standard-accessor-method

参考

Slime によるクラスシンボルの export

コマンド M-x slime-export-class は、クラスシンボルをパッケージ定義の “:export” 節に追加します。 これにより、多数のシンボルを一度に export できます。

次のクラスがあるとします。

(defclass test ()
  ((foo :accessor foo)
   (bar :reader bar)))

“M-x slime-export-class RET test RET” を使うと、”test”、”foot”、”bar” が export されます。

残念ながら、クラス定義からスロットを削除しても export 節からは削除されません。

これは structure でも動作します (SBCL と Clozure CL のみ)。

defclass/std: クラスを短く書く

defclass/std ライブラリは、より短い defclass フォームを書くためのマクロを提供します。

デフォルトでは、スロット定義に accessor、initarg、nil への initform を追加します。

これは:

(defclass/std example ()
  ((slot1 slot2 slot3)))

次へ展開されます。

(defclass example ()
  ((slot1
    :accessor slot1
    :initarg :slot1
    :initform nil)
   (slot2
     :accessor slot2
     :initarg :slot2
     :initform nil)
   (slot3
     :accessor slot3
     :initarg :slot3
     :initform nil)))

これはもっと多くのことができ、非常に柔軟です。 ただし Common Lisp コミュニティではあまり使われていません。自己責任で使ってください。

メソッド

まず試す

冒頭の person クラスと child クラスを思い出してください。

(defclass person ()
  ((name
    :initarg :name
    :accessor name)))
;; => #<STANDARD-CLASS PERSON>

(defclass child (person)
  ())
;; #<STANDARD-CLASS CHILD>

(setf p1 (make-instance 'person :name "me"))
(setf c1 (make-instance 'child :name "Alice"))

以下ではメソッドを作成し、特殊化し、method combination (before, after, around) と qualifier を使います。

(defmethod greet (obj)
  (format t "Are you a person ? You are a ~a.~&" (type-of obj)))
;; style-warning: Implicitly creating new generic function common-lisp-user::greet.
;; #<STANDARD-METHOD GREET (t) {1008EE4603}>

(greet :anything)
;; Are you a person ? You are a KEYWORD.
;; NIL
(greet p1)
;; Are you a person ? You are a PERSON.

(defgeneric greet (obj)
  (:documentation "say hello"))
;; STYLE-WARNING: redefining COMMON-LISP-USER::GREET in DEFGENERIC
;; #<STANDARD-GENERIC-FUNCTION GREET (2)>

(defmethod greet ((obj person))
  (format t "Hello ~a !~&" (name obj)))
;; #<STANDARD-METHOD GREET (PERSON) {1007C26743}>

(greet p1) ;; => "Hello me !"
(greet c1) ;; => "Hello Alice !"

(defmethod greet ((obj child))
  (format t "ur so cute~&"))
;; #<STANDARD-METHOD GREET (CHILD) {1008F3C1C3}>

(greet p1) ;; => "Hello me !"
(greet c1) ;; => "ur so cute"

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Method combination: before, after, around.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmethod greet :before ((obj person))
  (format t "-- before person~&"))
#<STANDARD-METHOD GREET :BEFORE (PERSON) {100C94A013}>

(greet p1)
;; -- before person
;; Hello me

(defmethod greet :before ((obj child))
  (format t "-- before child~&"))
;; #<STANDARD-METHOD GREET :BEFORE (CHILD) {100AD32A43}>
(greet c1)
;; -- before child
;; -- before person
;; ur so cute

(defmethod greet :after ((obj person))
  (format t "-- after person~&"))
;; #<STANDARD-METHOD GREET :AFTER (PERSON) {100CA2E1A3}>
(greet p1)
;; -- before person
;; Hello me
;; -- after person

(defmethod greet :after ((obj child))
  (format t "-- after child~&"))
;; #<STANDARD-METHOD GREET :AFTER (CHILD) {10075B71F3}>
(greet c1)
;; -- before child
;; -- before person
;; ur so cute
;; -- after person
;; -- after child

(defmethod greet :around ((obj child))
  (format t "Hello my dear~&"))
;; #<STANDARD-METHOD GREET :AROUND (CHILD) {10076658E3}>
(greet c1) ;; Hello my dear


;; call-next-method

(defmethod greet :around ((obj child))
  (format t "Hello my dear~&")
  (when (next-method-p)
    (call-next-method)))
;; #<standard-method greet :around (child) {100AF76863}>

(greet c1)
;; Hello my dear
;; -- before child
;; -- before person
;; ur so cute
;; -- after person
;; -- after child

;;;;;;;;;;;;;;;;;
;; &key の追加
;;;;;;;;;;;;;;;;;

;; generic method に "&key" を追加するには、まずその定義を削除する必要がある。
(fmakunbound 'greet)  ;; Slime では: C-c C-u (slime-undefine-function)
(defmethod greet ((obj person) &key talkative)
  (format t "Hello ~a~&" (name obj))
  (when talkative
    (format t "blah")))

(defgeneric greet (obj &key &allow-other-keys)
  (:documentation "say hi"))

(defmethod greet (obj &key &allow-other-keys)
  (format t "Are you a person ? You are a ~a.~&" (type-of obj)))

(defmethod greet ((obj person) &key talkative &allow-other-keys)
  (format t "Hello ~a !~&" (name obj))
  (when talkative
    (format t "blah")))

(greet p1 :talkative t) ;; ok
(greet p1 :foo t) ;; これも ok


;;;;;;;;;;;;;;;;;;;;;;;

(defgeneric greet (obj)
  (:documentation "say hello")
  (:method (obj)
    (format t "Are you a person ? You are a ~a~&." (type-of obj)))
  (:method ((obj person))
    (format t "Hello ~a !~&" (name obj)))
  (:method ((obj child))
    (format t "ur so cute~&")))

;;;;;;;;;;;;;;;;
;;; Specializers
;;;;;;;;;;;;;;;;

(defgeneric feed (obj meal-type)
  (:method (obj meal-type)
    (declare (ignorable meal-type))
    (format t "eating~&")))

(defmethod feed (obj (meal-type (eql :dessert)))
    (declare (ignorable meal-type))
    (format t "mmh, dessert !~&"))

(feed c1 :dessert)
;; mmh, dessert !

(defmethod feed ((obj child) (meal-type (eql :soup)))
    (declare (ignorable meal-type))
    (format t "bwark~&"))

(feed p1 :soup)
;; eating
(feed c1 :soup)
;; bwark

Generic function (defgeneric, defmethod)

generic function は、一連のメソッドと関連付けられ、呼び出されたときにそれらを dispatch する Lisp 関数です。 同じ関数名を持つすべてのメソッドは、同じ generic function に属します。

defmethod フォームは defun に似ています。 コード本体を関数名に関連付けますが、その本体は、引数の型がラムダリストで宣言されたパターンに一致する場合にだけ実行されます。

optional、keyword、&rest 引数を持てます。

defgeneric フォームは generic function を定義します。 対応する defgeneric なしで defmethod を書くと、generic function が自動的に作成されます (例を参照)。

一般に defgeneric を書くのはよい考えです。 デフォルト実装やドキュメントを追加できます。

(defgeneric greet (obj)
  (:documentation "says hi")
  (:method (obj)
    (format t "Hi")))

メソッドのラムダリストの必須パラメータは、次の 3 つの形式のいずれかを取れます。

1- 単純な変数:

(defmethod greet (foo)
  ...)

このメソッドは任意の引数を取れ、常に applicable です。

変数 foo は通常どおり対応する引数値に束縛されます。

2- 変数と specializer。例:

(defmethod greet ((foo person))
  ...)

この場合、変数 foo は、その引数が specializer class person またはそのサブクラス (child など) である場合にのみ、対応する引数に束縛されます (実際、”child” も “person” です)。

いずれかの引数がその specializer に一致しない場合、そのメソッドは applicable ではなく、それらの引数では実行できません。 “there is no applicable method for the generic function xxx when called with arguments yyy” のようなエラーメッセージが出ます。

特殊化できるのは必須パラメータだけです。optional な &key 引数では特殊化できません。

3- 変数と eql specializer

(defmethod feed ((obj child) (meal-type (eql :soup)))
    (declare (ignorable meal-type))
    (format t "bwark~&"))

(feed c1 :soup)
;; "bwark"

単純なシンボル (:soup) の代わりに、eql specializer には任意の Lisp フォームを使えます。 これは defmethod と同じタイミングで評価されます。

ラムダリストの形式が generic function の形と congruent である限り、同じ関数名で specializer の異なるメソッドをいくつでも定義できます。 システムは最も specific な applicable method を選び、その本体を実行します。 最も specific なメソッドとは、specializer が引数の class-precedence-list の先頭に最も近いものです (ラムダリストの左側にあるクラスほど specific です)。 specializer を持つメソッドは、何も持たないメソッドより specific です。

注意:

attempt to add the method
  #<STANDARD-METHOD NIL (#<STANDARD-CLASS CHILD>) {1009504233}>
to the generic function
  #<STANDARD-GENERIC-FUNCTION GREET (2)>;
but the method and generic function differ in whether they accept
&REST or &KEY arguments.

defmethod on the CLHS も参照してください。

Multimethod

Multimethod は、generic function の必須パラメータを複数明示的に特殊化します。

それらは特定のクラスに属しません。 つまり、他の言語で必要になるかもしれないように、このメソッドを置くのに最適なクラスを決める必要はありません。

(defgeneric hug (a b)
   (:documentation "Hug between two persons."))
;; #<STANDARD-GENERIC-FUNCTION HUG (0)>

(defmethod hug ((a person) (b person))
  :person-person-hug)

(defmethod hug ((a person) (b child))
  :person-child-hug)

詳しくは Practical Common Lisp を読んでください。

setter の制御 (setf-ing methods)

Lisp では、関数やメソッドに対応する setf 版を定義できます。 これは、オブジェクトの更新方法をより細かく制御したい場合に使えます。

(defmethod (setf name) (new-val (obj person))
  (if (equalp new-val "james bond")
    (format t "Dude that's not possible.~&")
    (setf (slot-value obj 'name) new-val)))

(setf (name p1) "james bond") ;; -> no rename

Python を知っているなら、この挙動は @property デコレータで提供されるものです。

Dispatch 機構と next method

generic function が呼び出されたとき、アプリケーションがメソッドを直接呼び出すことはできません。 dispatch 機構は次のように進みます。

  1. applicable method のリストを計算する
  2. applicable なメソッドがなければエラーを signal する
  3. applicable method を specificity の順にソートする
  4. 最も specific なメソッドを呼び出す

私たちの greet generic function には 3 つの applicable method があります。

(closer-mop:generic-function-methods #'greet)
(#<STANDARD-METHOD GREET (CHILD) {10098406A3}>
 #<STANDARD-METHOD GREET (PERSON) {1009008EC3}>
 #<STANDARD-METHOD GREET (T) {1008E6EBB3}>)

メソッドの実行中、残りの applicable method には local function call-next-method を介してアクセスできます。 この関数はメソッド本体内でレキシカルスコープを持ちますが、indefinite extent を持ちます。 次に specific なメソッドを呼び出し、そのメソッドが返した値をそのまま返します。 次のいずれかで呼び出せます。

例:

(defmethod greet ((obj child))
  (format t "ur so cute~&")
  (when (next-method-p)
    (call-next-method)))
;; STYLE-WARNING: REDEFINING GREET (#<STANDARD-CLASS CHILD>) in DEFMETHOD
;; #<STANDARD-METHOD GREET (child) {1003D3DB43}>

(greet c1)
;; ur so cute
;; Hello Alice !

next method がないときに call-next-method を呼び出すとエラーが signal されます。 next method が存在するかどうかは、local function next-method-p を呼び出して調べられます (これもレキシカルスコープと indefinite extent を持ちます)。

最後に、すべてのメソッド本体は、そのメソッドの generic function と同じ名前の block を確立することに注意してください。 その名前に対して return-from すると、囲んでいる generic function の呼び出しではなく、現在のメソッドから抜けます。

Method qualifier (before, after, around)

「まず試す」の例で、:before、:after、:around qualifier の使い方をいくつか見ました。

CLOS が提供する standard method combination フレームワークでは、デフォルトでこれら 3 つの qualifier のどれか 1 つだけを使えます。 制御の流れは次のとおりです。

generic function は primary method の値を返します。 before method や after method の値は無視されます。 それらは副作用のために使われます。

そして around-method があります。 これは今説明した中核機構を包む wrapper です。 返り値を捕まえたり、primary method の周囲に環境を用意したりするのに便利です (catch、lock、実行時間計測など)。

dispatch 機構が around-method を見つけると、それを呼び出して結果を返します。 around-method に call-next-method があれば、次に applicable な around-method を呼び出します。 primary method に到達して初めて、before-method と after-method の呼び出しを始めます。

したがって、generic function の完全な dispatch 機構は次のようになります。

  1. applicable method を計算し、qualifier に従って別々のリストへ分ける。
  2. applicable な primary method がなければエラーを signal する。
  3. 各リストを specificity の順にソートする。
  4. 最も specific な :around method を実行し、それが返すものを返す。
  5. :around method が call-next-method を呼び出した場合、次に specific な :around method を実行する。

  6. 最初から :around method がなかった場合、または :around method が call-next-method を呼び出したが、呼び出すべき後続の :around method がない場合、次のように進む。

    a. すべての :before method を順に実行する。返り値は無視し、call-next-method や next-method-p の呼び出しは許可しない。

    b. 最も specific な primary method を実行し、それが返すものを返す。

    c. primary method が call-next-method を呼び出した場合、次に specific な primary method を実行する。

    d. primary method が call-next-method を呼び出したが、呼び出すべき後続の primary method がない場合はエラーを signal する。

    e. primary method の完了後、すべての :after method を 逆 順で実行する。返り値は無視し、call-next-method や next-method-p の呼び出しは許可しない。

玉ねぎのように考えるとよいでしょう。最も外側の層にすべての :around method があり、中間層に :before と :after method があり、内側に primary method があります。

その他の method combination

先ほど見たデフォルトの method combination type は standard という名前ですが、他の method combination type も利用でき、もちろん自分で定義することもできます。

組み込み型は次のとおりです。

progn + list nconc and max or append min

これらの型は Lisp operator にちなんで名付けられていることに気づくでしょう。 実際、それらが行うのは、その名前の Lisp operator 呼び出しの内側で applicable な primary method を結合するフレームワークを定義することです。 たとえば、progn combination type を使うことは、すべての primary method を順に呼び出すことと同等です。

(progn
  (method-1 args)
  (method-2 args)
  (method-3 args))

ここでは standard 機構と異なり、与えられたオブジェクトに applicable なすべての primary method が、最も specific なものから呼び出されます。

combination type を変更するには、defgeneric の :method-combination オプションを設定し、それをメソッドの qualifier として使います。

(defgeneric foo (obj)
  (:method-combination progn))

(defmethod foo progn ((obj obj))
   (...))

progn の例:

(defgeneric dishes (obj)
   (:method-combination progn)
   (:method progn (obj)
     (format t "- clean and dry.~&"))
   (:method progn ((obj person))
     (format t "- bring a person's dishes~&"))
   (:method progn ((obj child))
     (format t "- bring the baby dishes~&")))
;; #<STANDARD-GENERIC-FUNCTION DISHES (3)>

(dishes c1)
;; - bring the baby dishes
;; - bring a person's dishes
;; - clean and dry.

(greet c1)
;; ur so cute  --> 最も applicable なメソッドだけが呼ばれた。

同様に、list 型を使うことは、メソッドの値のリストを返すことと同等です。

(list
  (method-1 args)
  (method-2 args)
  (method-3 args))

(defgeneric tidy (obj)
  (:method-combination list)
  (:method list (obj)
    :foo)
  (:method list ((obj person))
    :books)
  (:method list ((obj child))
    :toys))
;; #<STANDARD-GENERIC-FUNCTION TIDY (3)>

(tidy c1)
;; (:toys :books :foo)

Around method は受け付けられます。

(defmethod tidy :around (obj)
   (let ((res (call-next-method)))
     (format t "I'm going to clean up ~a~&" res)
     (when (> (length res)
              1)
       (format t "that's too much !~&"))))

(tidy c1)
;; I'm going to clean up (toys book foo)
;; that's too much !

これらの operator は before、after、around method をサポートしないことに注意してください (実際、それらを入れる余地がもうありません)。 around method はサポートされ、そこでは call-next-method が許可されますが、primary method 内で call-next-method を呼び出すことはサポートされません。 すべての primary method が呼ばれるため、それは冗長ですし、あるものを 呼ばない ほうがぎこちなくなります。

CLOS では、Lisp 関数、マクロ、special form のいずれであっても、新しい operator を method combination type として定義できます。 必要を感じたら、書籍を参照してください。

デバッグ: method combination の trace

method combination を trace することは可能ですが、これは実装依存です。

SBCL では (trace foo :methods t) を使えます。this post by an SBCL core developer を参照してください。

たとえば、次の generic があるとします。

(defgeneric foo (x)
  (:method (x) 3))
(defmethod foo :around ((x fixnum))
  (1+ (call-next-method)))
(defmethod foo ((x integer))
  (* 2 (call-next-method)))
(defmethod foo ((x float))
  (* 3 (call-next-method)))
(defmethod foo :before ((x single-float))
  'single)
(defmethod foo :after ((x double-float))
 'double)

これを trace します。

(trace foo :methods t)

(foo 2.0d0)
  0: (FOO 2.0d0)
    1: ((SB-PCL::COMBINED-METHOD FOO) 2.0d0)
      2: ((METHOD FOO (FLOAT)) 2.0d0)
        3: ((METHOD FOO (T)) 2.0d0)
        3: (METHOD FOO (T)) returned 3
      2: (METHOD FOO (FLOAT)) returned 9
      2: ((METHOD FOO :AFTER (DOUBLE-FLOAT)) 2.0d0)
      2: (METHOD FOO :AFTER (DOUBLE-FLOAT)) returned DOUBLE
    1: (SB-PCL::COMBINED-METHOD FOO) returned 9
  0: FOO returned 9
9

defgeneric と defmethod の違い: 再定義

defgeneric 本体の中でメソッドを宣言する場合と、複数の defmethod を書く場合には違いがあります。 この 2 つの方法は、メソッドの再定義を異なる形で扱います。 defgeneric は、本体内にもう存在しないメソッドを削除します。

以下では、person と child に特殊化した 2 つの defmethod を使って、新しい generic function を定義します。

(defmethod goodbye ((p person))
  (format t "goodbye ~a.~&" (name p)))

(defmethod goodbye ((c child))
  (format t "love you lil' one <3~&"))

(goodbye (make-instance 'person :name "you")) で試せます。

さて、作業セッションの後半で、child に特殊化したものはもう不要だと判断したとします。 そのソースコードを削除します。 しかし、そのメソッドはまだ image 内に存在します。 下で見るように、プログラム的にメソッドを削除する必要があります。

defgeneric を使っていれば、すべてのメソッドは更新、追加、削除されていたでしょう。 すでに 3 つのメソッドを持つ tidy generic function を定義しました。

(defgeneric tidy (obj)
  (:method-combination list)
  (:method list (obj)
    :foo)
  (:method list ((obj person))
    :books)
  (:method list ((obj child))
    :toys))

これは person や child など任意のオブジェクト型で動作します。 文字列で試してください: (tidy "tidy what?")。動作します。

次に、この宣言を defgeneric から削除します。

(defgeneric tidy (obj)
  (:method-combination list)
  ;;(:method list (obj)  ;; <--- commented out
  ;;  :foo)
  (:method list ((obj person))
    :books)
  (:method list ((obj child))
    :toys))

もう一度呼び出してみると、”no applicable method” エラーが出ます。

There is no applicable method for the generic function
  #<STANDARD-GENERIC-FUNCTION TRADESIGNAL::TIDY (2)>
when called with arguments
  ("tidy what?").

開発中にこれが重要かどうかは場合によりますが、知っておくと Lisp image をソースコードと同期した状態に保つ助けになります。 そうでなければ、古いメソッドが邪魔になったときに削除できます。

メソッドの削除

まず、メソッドオブジェクトを探す必要があります。

(find-method #'goodbye nil (list (find-class 'child)))
;; => #<STANDARD-METHOD GOODBYE (CHILD) {10073EFD73}>

find-method は引数として、関数参照、qualifier (before、after、around など)、class specializer のリストを取ります。

メソッドが見つかったら、remove-method を使います。

(fmakunbound 'goodbye) を使うこともできますが、これは すべての メソッドを unbound にします。

MOP

ここでは、meta-object protocol が提供するフレームワークを使う例をいくつか集めます。 これは Lisp のオブジェクトシステムを支配する、設定可能なオブジェクトシステムです。 高度な概念に触れるので、初めて読む人も心配しないでください。 Common Lisp Object System を使い始めるために、このセクションを理解する必要はありません。

ここでは MOP について多くは説明しませんが、その可能性が見えたり、一部の CL ライブラリがどのように作られているかを理解する助けになる程度には説明できればと思います。 導入部で参照した書籍を読むことをおすすめします。

Metaclass

metaclass は他のクラスの挙動を制御するために必要です。

予告したとおり、ここでは多くを語りません。metaclasses や CLOS については Wikipedia も参照してください。

標準の metaclass は standard-class です。

(class-of p1) ;; #<STANDARD-CLASS PERSON>

しかし、これを自分たちのものに変更し、インスタンスの作成を数えられる ようにします。 同じ仕組みは、データベースシステムの主キーを自動インクリメントするため (Postmodern や Mito ライブラリはこのようにしています)、オブジェクト作成をログに記録するため、などに使えます。

私たちの metaclass は standard-class を継承します。

(defclass counted-class (standard-class)
  ((counter :initform 0)))
#<STANDARD-CLASS COUNTED-CLASS>

(unintern 'person)
;; person の metaclass を変更するために必要。
;; または (setf (find-class 'person) nil)
;; https://stackoverflow.com/questions/38811931/how-to-change-classs-metaclass#38812140

(defclass person ()
  ((name
    :initarg :name
    :accessor name))
  (:metaclass counted-class)) ;; <- metaclass
;; #<COUNTED-CLASS PERSON>
;;   ^^^ もう standard-class ではない。

:metaclass クラスオプションは 1 回だけ現れます。

実際には、validate-superclass を実装するよう求めるメッセージが出たはずです。 そこで、引き続き closer-mop ライブラリを使います。

(defmethod closer-mop:validate-superclass ((class counted-class)
                                           (superclass standard-class))
  t)

これで新しい person インスタンスの作成を制御できます。

(defmethod make-instance :after ((class counted-class) &key)
  (incf (slot-value class 'counter)))
;; #<STANDARD-METHOD MAKE-INSTANCE :AFTER (COUNTED-CLASS) {1007718473}>

:after qualifier が最も安全な選択であることに注目してください。 標準メソッドを通常どおり実行させ、新しいインスタンスを返させます。

&key は必要です。make-instance には initarg が渡されることを思い出してください。

ではテストします。

(defvar p3 (make-instance 'person :name "adam"))
#<PERSON {1007A8F5B3}>

(slot-value p3 'counter)
;; => error。新しいスロットは person クラス上にはない。
(slot-value (find-class 'person) 'counter)
;; 1

(make-instance 'person :name "eve")
;; #<PERSON {1007AD5773}>
(slot-value (find-class 'person) 'counter)
;; 2

動作しています。

インスタンス初期化の制御 (initialize-instance)

オブジェクトインスタンスの作成をさらに制御するには、initialize-instance メソッドを特殊化できます。 これは make-instance によって、新しいインスタンスが作成された直後、ただしデフォルトの initarg と initform でまだ初期化されていない時点で呼び出されます。

primary method を作るとスロットの初期化を妨げるため、after method を作ることが推奨されています (Keene)。

(defmethod initialize-instance :after ((obj person) &key)
;; arglist の &key に注意:                    ^^^^
  (do something with obj))

典型的な例は初期値の検証です。 ここでは person の名前が 3 文字より長いことをチェックします。

(defmethod initialize-instance :after ((obj person) &key)
  (with-slots (name) obj
    (assert (>= (length name) 3))))

そのため、この呼び出しはもう動きません。

(make-instance 'person :name "me")
;; The assertion (>= #1=(LENGTH NAME) 3) failed with #1# = 2.
;;   [Condition of type SIMPLE-ERROR]

interactive debugger に入り、restart (continue、retry、abort) の選択肢が提示されます。

ついでに、debugger 機能を使って “name” を変更する選択肢を提供する assertion を示します。 debugger から変更できる place のリストを assert に渡します。

(defmethod INITIALIZE-INSTANCE :after ((obj person) &key)
  (with-slots (name) obj
    (assert (>= (length name) 3)
            (name)  ;; <-- place のリスト
            "The value of name is ~a. It should be longer than 3 characters." name)))

次のようになります。

The value of name is me. It should be longer than 3 characters.
   [Condition of type SIMPLE-ERROR]

Restarts:
 0: [CONTINUE] Retry assertion with new value for NAME.
                               ^^^^^^^^^^^^ 新しい restart
 1: [RETRY] Retry SLIME REPL evaluation request.
 2: [*ABORT] Return to SLIME's top level.

別の説明です。CLOS の make-instance 実装は 2 段階です。 新しいオブジェクトを割り当て、それからそのオブジェクトとすべての make-instance キーワード引数を generic function initialize-instance に渡します。 実装者やアプリケーション作者は、インスタンスのスロットを初期化するために initialize-instance 上に :after method を定義します。 システムが提供する primary method は、(a) クラス定義時に与えられた :initform と :initarg の値、および (b) make-instance から渡されたキーワードに関してこれを行います。 他のメソッドは必要に応じてこの挙動を拡張できます。 たとえば、特定のスロットを埋めるためのデータベースアクセスを呼び出す追加キーワードを受け付けるかもしれません。 initialize-instance のラムダリストは次のとおりです。

initialize-instance instance &rest initargs &key &allow-other-keys

インスタンス更新の制御 (update-instance-for-redefined-class)

座標と直径を持つ “circle” クラスを作ったとします。 後で、直径を半径に置き換えることにしました。 既存のすべてのオブジェクトを賢く更新したいとします。 半径は直径の値を 2 で割った値になるべきです。 update-instance-for-redefined-class を使います。

そのパラメータは次のとおりです。

そしてオブジェクトを返します。

実際にはこのメソッドを直接呼ぶのではなく、:before method を使います。

(defmethod update-instance-for-redefined-class
    :before ((obj circle) added deleted plist-values &key)
  (format t "plist values: ~a~&" plist-values)
  (let ((diameter (getf plist-values 'diameter)))
    (setf (radius obj) (/ diameter 2))))

試し方は次のとおりです。circle クラスから始めます。

(defclass circle ()
  ((diameter :accessor diameter :initform 9)))

そして circle オブジェクトを作成します。

(make-instance 'circle)

それを inspect するか、diameter の値を確認します。

次に新しいクラス定義を書いてコンパイルします。

(defclass circle ()
  ((radius :accessor radius)))

まだ何も起こらず、”plist values” の print 出力は見えません。

そのオブジェクトを inspect するか describe してください。そこで更新され、radius スロットが見つかります。

既存オブジェクトは遅延更新されます。

詳しくは HyperSpec または Community Spec を参照してください。

新しいクラスへのインスタンス更新の制御 (update-instance-for-different-class)

今度は circle クラスで作業しているが、必要なのは surface 種のオブジェクトだけだと気づいたとします。 circle クラスを完全に捨てる一方で、既存オブジェクトをこの新しいクラスへ更新し、新しいスロットを賢く計算したいとします。 update-instance-for-different-class を使います。

詳しくは HyperSpec または Community Spec を参照してください。

qualifier と型に一致するメソッドを探す

指定した qualifier の集合 (:around method など) と、より重要な specializer (そのメソッドが dispatch する型) を持つメソッドが存在するかを確認したいとします。

たとえば、この章では person オブジェクト向けに print-object メソッドを特殊化しました。

(defmethod print-object ((obj person) stream)

今、イントロスペクションを使うプログラムで、そのような関数が存在するかを確認し、その参照を取得したいとします。

find-method を使います。

(find-method #'print-object nil '(person t))
;;          ^^^ シンボルだけでなく関数オブジェクト
;; => <STANDARD-METHOD COMMON-LISP:PRINT-OBJECT (PERSON T) {1204FA0B83}>

第 1 引数 nil は qualifier のリストです。 :around、:before、:after method には関心がないので nil のままにします。 リストとして '(:around) を使うこともできます。

第 2 引数はメソッド引数の型のリストです。 print-object は person と stream の 2 つの引数を取ります。 generic function への参照を得るには '(t t) を使えます。 person と任意の stream に特殊化したメソッドへの参照を得るには '(person t) を使います。

そのようなメソッドが存在しない場合、find-method はエラーを signal します。

There is no method on
#<STANDARD-GENERIC-FUNCTION COMMON-LISP::PRINT-OBJECT (1)> with no
qualifiers and specializers
(… …)
condition of type simple-error

最後の optional 引数 errorp を nil に設定しない限り、そうなります。

最後に

さらに多くのことは書籍を参照してください!

Page source: ja/clos.md

T
O
C