CLOS 是 “Common Lisp Object System” 的缩写，是所有语言中最强大的对象系统之一。

有以下的特性：

动态（dynamic），在 Lisp 的 REPL（即解释器）中写起来很舒服。比如说，当一个类的定义改变了，之前类所创建的对象也会随之更新，这样操作对象也更直观明了;
多派生（multiple） 以及 多继承（multiple inheritance）；
内省（introspection）
元对象接口（meta-object protocol），提供 CLOS 标准接口，可以用来创建一个新的对象系统。

CLOS 最初是在 1984 年 Steele 的 “Common Lisp, the Language” 第一版中出现，十年后被正式定义为 ANSI 标准。

本章旨在讲解 CLOS 的使用，但只是简单的介绍了下 MOP。

想要深入了解的话，推荐下面两本书：

Object-Oriented Programming in Common Lisp: a Programmer’s Guide to CLOS, by Sonya Keene,
the Art of the Metaobject Protocol, by Gregor Kiczales, Jim des Rivières et al.

当然，也可以参见下面的链接。

the introduction in Practical Common Lisp (online), by Peter Seibel.
Common Lisp, the Language
and for reference, the complete CLOS-MOP specifications.

类和实例

序

首先，用个完整的例子来讲解下类的定义，对象的创建，属性的访问，方法的构造以及继承关系。

(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)

defclass 是个宏，在 CLOS 中定义新的数据类型。

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

以上代码创建了一个 person 类，有两个属性：name 和 lisper.

(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 类没有继承自其他的类（父类的名字会定义在类名字后面的括号中）。当然，person 默认是继承自 t 类和 standard-object，以为在 CLOS 中，所以的类都继承自这两个类。下面的继承的章节会提到。

可以定义一个简单的无属性的 point 类

(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))

有了构造函数，就可以更好的控制一些特定的参数，同时在使用包时，就可以不用去看类的创建，直接调用构造函数就好。

属性 (Slots)

slot-value

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-SLOT 异常：

(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)

:initarg :foo：使用 make-instance 创建是通过属性名（slots）来给属性赋值的，其中后面的 :foo 就属性名。

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

在次强调，属性默认是不会绑定属性名（slots）的。

:initform <val>：当没有定义其属性名（initarg）时，:initform 后面的值就是该属性的默认值。在 defclass 的词法作用域中，在需要时，这个表达式就会运行。

一个可以清楚的知道需要给属性赋值的技巧：

(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.

Getters and setters (accessor, reader, writer)

:accessor foo：既是 getter 也是 setter。:accessor 后面接的参数将会成为 通用函数.

(name p1) ;; => "me"
(type-of #'name)
STANDARD-GENERIC-FUNCTION

:reader and :writer：这才是你想要的，只有 :writer 可以使用 setf 进行赋值.

如果不使用以上这些的话， slot-value 也同样可以修改属性的值.

同一属性可以有多个 :accessor、 :reader、 :initarg.

下面将介绍两个宏，这两个宏在输出类的属性值时会很方便：

1- with-slots，可以同时访问多个属性值，第一个参数是个包含了属性名的列表，第二个参数是个对象实例，之后的是由 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：于 with-slots 类似，只不过第一个参数是访问属性的函数（accessor functions）

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

类 VS 实例属性

:allocation：定义属性是 本地的 还是 共享的，也就是所谓的私有属性和公有属性。

属性默认是私有的，就是说每个实例的属性值都不同。这种情况下，:allocation 等价于 :instance；
公有属性可以被该类的所有值访问，且保持一致，定义方法为：:allocation :class。

下面是个公有属性的例子：

(defclass person ()
  ((name :initarg :name :accessor name)
   (species
      :initform 'homo-sapiens
      :accessor species
      :allocation :class)))
;; Note that the slot "lisper" was removed in existing instances.
(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 的参数

属性的类型

属性类型使用 :type 来定义。如果是第一次接触 CLOS，建议你跳过这节，然后自己去构造类型检查的类。

事实上，属性的类型会不会检查并没有定义出来。详见 Hyperspec.

只有少部分解释器会对类的属性类型进行检查。其中由 Clozure CL，SBCL 是在2019年11月时发行的 1.5.9 版本才开始支持，或者是进行了高安全性的设置（(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>

注: 这是第一次介绍 MOP，不必进行深究

对象 my-point 是 point 类的一个实例，而 point 类又是 standard-class 的一个实例。因此，我们将 standard-class 称为 my-point 的 元类(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 的一些操作很湿方便。

子类会继承父类所有的属性，同时也能重写父类的属性。

以下是 child 的继承关系：

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 的直接父类只能是 person：

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

可以调用 class-direct-[subclasses, slots, default-initargs] 和其他的函数来对类进行一些确认。

以下是属性继承的规则：

:accessor 和 :reader：继承，同时会被组合起来。
:initarg：同 :accessor 和 :reader。
:initform：最详细的，就是说，和 class-precedence-list 一样。
:allocation：不继承，默认与 :instance 一致。

最后一点，在使用继承时要注意点，因为继承确实很容易被误用，而多继承有将难度以倍数增加。所以，写的时候注意点，确定是否是确实需要继承。建议是当属性相同时，可以使用继承，但是属性不同时，最好还是不要使用继承。

多继承

CLOS 同时也支持多继承。

(defclass baby (child person)
  ())

父类列表中第一个类要是最底层的那个类，而后一次递推，且这些类都是提前定义好了的。

重定义或修改类

本节将讲解以下两点：

类的重定义
将实例指向其他的类

类的重定义只需使用 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
    :initarg :arg
    :initform 18
    :accessor age)))
(age p1)
;; => slot unbound error. This is different from "slot missing":
(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)
;; we can also set slots of the new class:
(change-class p1 'child :can-walk-p nil)
(class-of p1)
;; #<STANDARD-CLASS CHILD>
(can-walk-p p1)
;; T

上面例子中，p1 由 person 变成了 child，同时也继承了 can-walk-p 的默认属性。

美化输出

每次创建对象时，总会得到个类似下面的输出：

#<PERSON {1006234593}>

没有任何意义。

如果想要看到更多的信息该怎么办呢？比如说想看到如下的格式：

#<PERSON me lisper: t>

可以通过定制这个类的通用方法 print-object 就可以美化输出了：

(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 将打印 #<...>，表明不能访问该对象内部。对象的 :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} 的地址。

普通类型的类

也有方法可以不用 CLOS 来创建对象。

通常来说，上一小节中提到的函数也适用于非 CLOS 实例对象。

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

从上面代码可以看出，symbol 就是系统类的实例。这只是对应语言中 75 种类型相对应的的类的其中一个类。许多系统类都与 CLOS 本身相关。然而，以下 33 中类型还是传统的 lisp 类型；

注意，以上表格并不包含所有的传统 lisp 类型（比如说：atom、fixnum、short-float）

t 这个类型就比较有趣了。因为每个 lisp 对象的类型都是 t，同时每个 lisp 对象也是 t 类的子类。这个个同时属于多个类的简单示例，存在继承相关问题，这个问题将在将在后面详细讨论。

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

除了与 lisp 类型对应的类之外，定义的每个结构类型都有一个 CLOS 类：

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

structure-object 的元类是 structure-class。
无论传统 lisp 对象的元类是 standard-class、structure-class 还是 built-in-class，都依赖于实现。
以下是其使用限制：

|built-in-class| May not use make-instance, may not use slot-value, may not use defclass to modify, may not create subclasses.|
|structure-class| May not use make-instance, might work with slot-value (implementation-dependent). Use defstruct to subclass application structure types. Consequences of modifying an existing structure-class are undefined: full recompilation may be necessary.|
|standard-class|None of these restrictions.|

自省（Introspection）

我们已经见过一些自省的函数了。

最好是去查看 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

defclass/std: 编写短类

defclass/std 库提供了一个比 defclass 格式更简短的宏。

默认情况下，会自动添加 accessor，initarg 并将 iniform 设为 nil：
By default, it adds an accessor, an initarg and an initform to nil to your slots definition:

(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"))

下面，我们将创建方法，定制方法，并组合使用方法（before，after，around）和使用限定词。

(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
;;;;;;;;;;;;;;;;;
;; Adding in &key
;;;;;;;;;;;;;;;;;
;; In order to add "&key" to our generic method, we need to remove its definition first.
(fmakunbound 'greet)  ;; with 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) ;; still 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

泛型函数 (defgeneric, defmethod)

泛型函数 是一个 lisp 函数，它与一组方法相关联，并在调用时分派它们。所有具有相同函数名的方法都属于相同的泛型函数。

defmethod 的格式类似于 defun。将代码体与函数名相关联，但是只有当参数的类型与 lambda 列表声明的模式相匹配时，才会执行该代码体。

参数类型有可选参数、关键字和 &rest 参数。

defgeneric 定义了泛型函数。当写了一个 defmethod 而没有相应的 defgeneric，一个泛型函数就会自动创建(参见例子)。

通常，编写 defgeneric 是个好主意。可以添加默认的实现，甚至一些文档。

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

方法中的 lambda 列表中需要的参数有以下三种形式:

1- 简单的变量:

(defmethod greet (foo)
  ...)

上面这种方法能接受任何参数，且总能适用。

变量 foo 通常绑定到相应的参数值。

2- 变量和特殊类型，如下:

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

在本例中，只有当变量 foo 是特殊类型的类 person 或其子类，比如 child(实际上，child 也是 person)时，才会绑定到相应的参数。

如果任何参数不能匹配其特殊类型，那么该方法就不适用，并且不能用那些参数执行。将得到一个错误消息，如 “当使用参数yyy调用泛型函数xxx时，没有适用的方法”。

只有必需的参数可以指定。不能指定可选的 &key 参数。

3- 变量和eql specializer

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

eql specializer 可以是任何lisp形式，而不是简单的符号(:soup)。它与 defmethod 同一时间执行。

只要 lambda 列表的形式与泛型函数的形式全等，就可以使用相同的函数名，但使用不同的 specializer 来定义任意数量的方法。系统会选择最具体的适用方法并执行其主体。最具体的方法是其 specializer 最接近参数的 class-precedence-list 的头部的方法(lambda列表左侧的类更具体)。specializers 的方法更适合没有 specializer 的方法。

注意事项：

定义与普通函数同名的方法会报错。真的想这样做的话，使用阴影机制（shadow mechanism）。
要向现有泛型方法的 lambda 列表添加或删除 keys 或 rest 参数，可以用 fmakunbound (或 C-c C-u(slime -undefine-function) 将光标放在 Slime 中的函数上删除声明，然后重新开始)。否则,你会看到：

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.

方法可以重定义(和普通函数一样).
定义方法的顺序无关紧要，但是是它们的 specializer 类必须已经定义了。
非专门化参数或多或少相当于专门化类 t。唯一的区别是所有的专门化参数都被隐式地认为是“被引用的”(在声明忽略的意义上)。
每个 defmethod 会生成（并返回）一个 CLOS 中 standard-method 的实例。
eql 专门化器不能像处理字符串那样工作。实际上，字符串是通过 equal 或 equalp 进行比较。但是，我们可以将字符串赋值给一个变量，并在 eql specializer和函数调用中使用该变量。
所有相同函数名的方法都属于相同的泛型函数。
所有 defclass 中定义的 accessor 和 reader 都是方法。它们可以重写或被相同泛型函数上的其他方法重写。

更多参见 defmethod on the CLHS.

多态

多态显式明确的制定了多个泛型函数所需的参数。

这些参数不属于特定的类。这意味着，我们不必像在其他语言中那样，必须决定调用这个方法的最佳类。

(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.

控制 setters (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 装饰器一样。

调度机制和下个方法

当调用泛型函数时，应用程序不能直接调用方法。调度机制的过程如下：

计算适用方法的列表
如果没有方法可用，则抛出异常
将适用的方法按特异性排序
调用最特定的方法

greet 泛型函数有三个可以方法：

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

在方法的执行过程中，仍然可以通过本地函数 call-next-method 访问其他可用的方法。此函数在方法体中具有词法范围，但范围不确定。调用下一个最 specific 的方法，并返回该方法返回的任何值。call-next-method 可以用以下两种方式调用：

无参数，下个方法 也将接收与该方法相同的参数，或是
显式参数，在这种情况下，要求适用于新参数的排序顺序集必须与第一次调用泛型函数的参数顺序相同。

例如:

(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 !

当没有下一个方法时调用 call-next-method 会抛出异常。可以通过调用本地函数 next-method-p (有词法作用域和不确定范围)来确定下一个方法是否存在。

最后注意，每个方法的主体都建立了一个与方法的泛型函数同名的块。如果 return-from 这个函数名，则退出当前方法，而不是对所包含的泛型函数的调用。

方法修饰符(before, after, around)

在本章序的例子中，已经知道了 :before、:after 和 :around 修饰符的用法:

(defmethod foo :before (obj) (...))
(defmethod foo :after (obj) (...))
(defmethod foo :around (obj) (...))

默认情况下，在 CLOS 提供的标准方法组合框架中，只能使用这三个限定符中的一个，控制流程如下:

调用before-method 会在主方法调用前。如果有很多 before-method，那么就调用所有的。从最后一个子类开始，然后是其父类，父类的父类(child before person)。
调用最底层的使用的 primary method ，只调用一个方法。
调用所有适用的 after-methods 。调用方法按继承顺序，显示子类，然后是父类，父类的父类……

泛型函数返回主方法的值。前置方法和后置方法返回值都会忽略。其返回值只是在对应的范围内有用。

然后是 around-methods。这就是刚才描述的核心机制的包装器。对于捕获返回值或围绕主方法设置环境(设置捕获、锁、执行计时……)非常有用。

如果分派机制找到 around 方法，它将调用该方法并返回其结果。如果 around 方法有 call-next-method，它就会调用下一个最适用的around-方法。只有当我们到达主方法时，我们才开始调用前置和后置方法。

因此，泛型函数的完整调度机制如下所示：

统计可用的方法，根据其修饰符分别放置在不同的列表中
没有找到主方法是将会抛出异常
将每个方法列表按继承关系排序
执行最底层的 :around 方法并返回该方法的返回值
当 :around 方法调用 call-next-method，执行次底层 :around 方法;
如果不存在 :around 方法，或是 :around 方法调用 call-next-method 时没有下一个 :around 方法时，将按照以下的顺序执行：
a. 按照继承顺序依次调用所有的 :before 方法，直到没有 call-next-method 或 next-method-p；
b. 执行最底层的主方法；
c. 当主方法有 call-next-method，按照继承顺序依次调用；
d. 当主方法调用 call-next-method，但是没有下一个主方法时，抛出异常;
e. 执行完主方法后，按照继承顺序依次调用所有的 :after 方法，直到没有 call-next-method 或 next-method-p。

将这个流程看作一个洋葱，所有的 :around 方法在最外层，:before 和 :after 方法在中间层，主方法在内部。

其他方法组合

刚才看到的默认方法组合类型叫 standard，但也可以使用其他组合方法，不用用多说，你可以定义自己的方法组合类型。

内建的类型有:

progn + list nconc and max or append min

注意到这些类型是以 lisp 操作符命名的。实际上，它们所做的是定义一个框架，该框架将适用的主要方法组合在对该名称的 lisp 操作符的调用中。例如，使用 progn 组合类型相当于逐个调用所有的主要方法:

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

这里，与标准机制不同，调用所有适用于给定对象的主要方法时，首先调用最详细的方法。

为了改变组合类型，设置了 defgeneric 的 :method-combination 选项，并将其用作方法的限定符:

(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  --> only the most applicable method was called.

类似地，使用 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 方法 是可以使用的:

(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 !

注意，这些操作符不支持 before、after 和 around 方法(实际上，它们已经没有空间了)。它们确实支持 around 方法，其中也可以调用 call-next-method ，但是不支持在主方法中调用 call-next-method(这确实是多余的，因为所有的主方法都被调用了，却笨拙地不调用一个主方法)。

CLOS 允许将新的操作符定义为方法组合类型，无论是 lisp 函数、宏还是特殊形式。需要是可以查询文中所提到的一些书籍链接。

Debugging: 跟踪方法组合

可以跟踪方法组合，但这取决于实现。

在 SBCL 中，可以使用 (trace foo :methods t)。详情参见 this post by an SBCL core developer.

下面是个通用的例子：

(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 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

MOP

这里收集了一些使用元对象协议提供的框架的例子，这个可配置的对象系统决定了 Lisp 对象系统。本节涉及到了高级概念，所以，刚开始学习的话，不要担心：你必理解本节内容就可以使用 Common Lisp 对象系统。

这里不会过多地讲解 MOP，但希望能够充分展示看到它的可能性，或者帮助理解一些CL库是如何构建的。感兴趣的话可以看看介绍中提到的书。

元类

元类是用来控制其他类的一些行为操作的。

As announced, we won’t talk much. See also Wikipedia for metaclasses or CLOS.

标准的元类是 standard-class:

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

但可以将 standard-class 修改成自己的元类。这样就可以 计算实例创建的个数 了。同样的机制可以运用在数据库的主键的自动增加上，用来记录创建对象等。

该元类继承自 standard-class:

(defclass counted-class (standard-class)
  ((counter :initform 0)))
#<STANDARD-CLASS COUNTED-CLASS>
(unintern 'person)
;; this is necessary to change the metaclass of person.
;; or (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>
;;   ^^^ not standard-class anymore.

:metaclass 选项只能出现一次。

事实上，应该得到一个实现 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 关键词是个很好的选择，这样可以让标注的方法正常运行，然后返回一个新的实例

&key 是必须的，注意，这个是用来接收 make-instance 的 initargs 的.

现在再试试看:

(defvar p3 (make-instance 'person :name "adam"))
#<PERSON {1007A8F5B3}>
(slot-value p3 'counter)
;; => error. No, our new slot isn't on the person class.
(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 所调用，

Keene 建议创建 after 方法，因为创建主方法将阻止属性初始化。

(defmethod initialize-instance :after ((obj person) &key) ;; note &key
  (do something with obj))

下面的例子可以对初始值进行验证。该代码会确保 person 的 name 长度不少于 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]

因此，可以给 debugger 加个 “name” 的特性：

(defmethod INITIALIZE-INSTANCE :after ((obj person) &key)
  (with-slots (name) obj
    (assert (>= (length name) 3)
            (name)  ;; creates a restart that offers to change "name"
            "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.    <--- new restart
 1: [RETRY] Retry SLIME REPL evaluation request.
 2: [*ABORT] Return to SLIME's top level.

另一个比较合理的是， CLOS 中 make-instance 实现的两个阶段：申请新的对象，然后将这个对象和参数传给通用函数 initialize-instance。解释器和程序员通过定义 initialize-instance 的 :after 方法，来对实例的属性值进行初始化。系统提供的主要方法会将 (a) :initform 和 :initarg 定义的值和 (b) 通过 makt-instance 的关键词传递进来的参数绑定在一起。可以使用其他的方法来进行拓展。比如说，可以通过访问数据库对特定的属性进行填充。 initialize-instance 的 lambda 列表为：

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

更多的相关的知识，去看看本章推荐的书吧 !

The CommonLisp Cookbook

15. CLOS