第十二章 对象和类

类是描述了一组有共同行为的对象。由类描述的对象称为类的一个实例。类指定了其实例拥有的属性（原文为slot卡槽）的名称，而这些属性的值由实例自身来进行填充。类同样也指定了可以应用于其实例的方法(method)。属性值可以是任何形式，但方法的值必须是过程。

类具有继承性。因此，一个类可以是另一个类的子类，我们称另一个类为它的父类。一个子类不仅有它自己“直接的”属性和方法，也会继承它的父类的所有属性和方法。如果一个类里有与其父类相同名称的属性和方法，那么仅保留子类的属性和方法。

12.1 一个简单的对象系统

现在我们用Scheme来实现一个基本的对象系统。对于每个类，我们只允许有一个父类（单继承性）。如果我们不想指定一个父类，我们可以用#t作为一个“元”父类，既没有属性，也没有方法。而#t的父类则认为是它自己。

作为一次尝试，用结构standard-class来定义类应该是很好的一种方式，用结构的字段来保存属性名字，父类以及方法。前两个字段我们分别叫做slots和superclass。我们将使用两个字段来描述方法，用method-names字段来描述类的方法的名称列表，用method-vector字段来保存一个矢量，里面放着类的方法。这是standard-class的定义：

  1. (defstruct standard-class
  2.   slots superclass method-names method-vector)

我们可以用make-standard-class，即standard-class的制造程序(见第九章)来创建一个新的类：

  1. (define trivial-bike-class
  2.   (make-standard-class
  3.    'superclass #t
  4.    'slots '(frame parts size)
  5.    'method-names '()
  6.    'method-vector #()))

这是一个非常简单的类，更加复杂的类会有有意义的父类和方法，这需要在创建类时进行大量的初始化设置，我们希望把这些工作隐藏在创建类的过程中。因此我们定义一个create-class宏来对make-standard-class进行适当的调用。

  1. (define-macro create-class
  2.   (lambda (superclass slots . methods)
  3.     `(create-class-proc
  4.       ,superclass
  5.       (list ,@(map (lambda (slot) `',slot) slots))
  6.       (list ,@(map (lambda (method) `',(car method)) methods))
  7.       (vector ,@(map (lambda (method) `,(cadr method)) methods)))))

我们稍后再介绍create-class-proc程序的定义。

make-instance程序创建类的一个实例，由类中包含的信息产生一个新的向量。实例向量的格式非常简单：它的第一个元素指向这个类（引用），余下的元素都是属性值。make-instance的第一个参数是一个类，后面的参数是成对的序列，而每一个“对”是属性名称和该实例中属性的值。

  1. (define make-instance
  2.   (lambda (class . slot-value-twosomes)
  4.     ;Find `n', the number of slots in `class'.
  5.     ;Create an instance vector of length `n + 1',
  6.     ;because we need one extra element in the instance
  7.     ;to contain the class.
  9.     (let* ((slotlist (standard-class.slots class))
  10.            (n (length slotlist))
  11.            (instance (make-vector (+ n 1))))
  12.       (vector-set! instance 0 class)
  14.       ;Fill each of the slots in the instance
  15.       ;with the value as specified in the call to
  16.       ;`make-instance'.
  18.       (let loop ((slot-value-twosomes slot-value-twosomes))
  19.         (if (null? slot-value-twosomes) instance
  20.             (let ((k (list-position (car slot-value-twosomes) 
  21.                                     slotlist)))
  22.               (vector-set! instance (+ k 1) 
  23.                 (cadr slot-value-twosomes))
  24.               (loop (cddr slot-value-twosomes))))))))

这是一个类的实例化的例子：

  1. (define my-bike
  2.   (make-instance trivial-bike-class
  3.                  'frame 'cromoly
  4.                  'size '18.5
  5.                  'parts 'alivio))

这将my-bike变量绑定到如下所示的实例上。

  1. #(<trivial-bike-class> cromoly 18.5 alivio)

<trivial‑bike‑class>是一个Scheme数据(另一个向量)代表之前定义的trivia-bike-class的值。

class-of程序返回该实例对应的类：

  1. (define class-of
  2.   (lambda (instance)
  3.     (vector-ref instance 0)))

这里假定class-of的参数是一个类的实例，即一个向量，其第一个元素指向standard-class的一些实例。我们可能想使class-of对我们给定的任何类型Scheme对象返回一个合适的值。

  1. (define class-of
  2.   (lambda (x)
  3.     (if (vector? x)
  4.         (let ((n (vector-length x)))
  5.           (if (>= n 1)
  6.               (let ((c (vector-ref x 0)))
  7.                 (if (standard-class? c) c #t))
  8.               #t))
  9.         #t)))

不是用standard-class创建的Scheme对象的类被认为是#t，即“元类”。

slot-value过程和set!slot-value过程用来访问和改变一个类实例的值：

  1. (define slot-value
  2.   (lambda (instance slot)
  3.     (let* ((class (class-of instance))
  4.            (slot-index
  5.             (list-position slot (standard-class.slots class))))
  6.       (vector-ref instance (+ slot-index 1)))))
  8. (define set!slot-value
  9.   (lambda (instance slot new-val)
  10.     (let* ((class (class-of instance))
  11.            (slot-index
  12.             (list-position slot (standard-class.slots class))))
  13.       (vector-set! instance (+ slot-index 1) new-val))))

我们现在来解决create-class-proc的定义问题。这个过程接受一个父类，一个属性的列表，一个方法名称的列表和一个包含方法体的向量，并适当调用make-standard-class程序。唯一困难的部分是给定的属性字段的值。由于一个类必须包括它的父类的属性，因此不能只有create-class提供的属性参数。我们必须把所给的属性追加到父类的属性中，并保证没有重复的属性。

  1. (define create-class-proc
  2.   (lambda (superclass slots method-names method-vector)
  3.     (make-standard-class
  4.      'superclass superclass
  5.      'slots
  6.      (let ((superclass-slots 
  7.             (if (not (eqv? superclass #t))
  8.                 (standard-class.slots superclass)
  9.                 '())))
  10.        (if (null? superclass-slots) slots
  11.            (delete-duplicates
  12.             (append slots superclass-slots))))
  13.      'method-names method-names
  14.      'method-vector method-vector)))

过程delete-duplicates接受一个列表s为参数，返回一个新列表，该列表只包含s中每个元素的最后一次出现。

  1. (define delete-duplicates
  2.   (lambda (s)
  3.     (if (null? s) s
  4.         (let ((a (car s)) (d (cdr s)))
  5.           (if (memv a d) (delete-duplicates d)
  6.               (cons a (delete-duplicates d)))))))

现在谈谈方法的应用。我们通过使用send程序调用一个类实例的方法。send的参数是方法的名字，紧接着是类实例，以及除了类实例本身之外的该方法的其他参数。由于方法储存在实例的类中而不是在实例本身中，因此send会在该实例对于的类中寻找该方法。如果没有找到，则到父类中寻找，如此直到找完整个继承链：

  1. (define send
  2.   (lambda (method instance . args)
  3.     (let ((proc
  4.            (let loop ((class (class-of instance)))
  5.              (if (eqv? class #t) (error 'send)
  6.                  (let ((k (list-position 
  7.                            method
  8.                            (standard-class.method-names class))))
  9.                    (if k
  10.                        (vector-ref (standard-class.method-vector class) k)
  11.                        (loop (standard-class.superclass class))))))))
  12.       (apply proc instance args))))

我们现在可以定义一些更有趣的类了：

  1. (define bike-class
  2.   (create-class
  3.    #t
  4.    (frame size parts chain tires)
  5.    (check-fit (lambda (me inseam)
  6.                 (let ((bike-size (slot-value me 'size))
  7.                       (ideal-size (* inseam 3/5)))
  8.                   (let ((diff (- bike-size ideal-size)))
  9.                     (cond ((<= -1 diff 1) 'perfect-fit)
  10.                           ((<= -2 diff 2) 'fits-well)
  11.                           ((< diff -2) 'too-small)
  12.                           ((> diff 2) 'too-big))))))))

这里，bike-class包括一个名为check-fit的方法，它接受一个自行车的实例和一个裤腿的尺寸作为参数，并报告该车对这种裤腿尺寸的人的适应性。

我们再来定义my-bike：

  1. (define my-bike
  2.   (make-instance bike-class
  3.                  'frame 'titanium ; I wish
  4.                  'size 21
  5.                  'parts 'ultegra
  6.                  'chain 'sachs
  7.                  'tires 'continental))

检查这个车与裤腿尺寸为32的某个人是否搭配：

  1. (send 'check-fit my-bike 32)

我们再定义子类bike-class。

  1. (define mtn-bike-class
  2.   (create-class
  3.     bike-class
  4.     (suspension)
  5.     (check-fit (lambda (me inseam)
  6.                 (let ((bike-size (slot-value me 'size))
  7.                       (ideal-size (- (* inseam 3/5) 2)))
  8.                   (let ((diff (- bike-size ideal-size)))
  9.                     (cond ((<= -2 diff 2) 'perfect-fit)
  10.                           ((<= -4 diff 4) 'fits-well)
  11.                           ((< diff -4) 'too-small)
  12.                           ((> diff 4) 'too-big))))))))

Mtn-bike-class添加了一个名为suspension的属性。并定义了一个稍微不同的名为check-fit的方法。

12.2 类也是实例

到这里为止，精明的读者可能已经发现了：类本身可以是某些其他类（如“元类”）的实例。注意所有类都有一些相同的特点：每个都有属性、父类、方法名称的列表和包含方法体的向量。make-instance看起来像是他们所共享的方法。这意味着我们可以通过另一个类（当然也是某个类的实例啦）来指定这些共同的特点。

具体的说就是我们可以重写我们的类实现并实现其自身（好别扭）。使用面向对象的方法，这样我们可以确保不会遇到鸡生蛋，蛋生鸡的问题。这样我们会跳出class结构和它相关的过程并余下的方法来把类定义为对象。

我们现在把standard-class作为其他类的父类。特别的，standard-class必须是它自己的一个实例。那么standard-class应该是什么样子的呢？

我们知道standard-class是一个实例，而且我们用一个向量来表示这个实例。所以最终是一个向量，其第一个元素是它的父类，也就是它自己，而余下的元素是属性值。我们已经确定有四个所有类都必须有的属性，因此standard-class是一个5个元素的向量。

  1. (define standard-class
  2.   (vector 'value-of-standard-class-goes-here
  3.           (list 'slots
  4.                 'superclass
  5.                 'method-names
  6.                 'method-vector)
  7.           #t
  8.           '(make-instance)
  9.           (vector make-instance)))

注意到standard-class这个向量并没有被完全填充：符号value‑of‑standard‑class‑goes‑here此时仅仅做占位用。现在我们已经定义了一个standard-class的值，现在我们可以用它来确定它自己的类，即它本身。

  1. (vector-set! standard-class 0 standard-class)

注意我们不能用class结构提供的过程了。我们必须把下面的形式：

  1. (standard-class? x)
  2. (standard-class.slots c)
  3. (standard-class.superclass c)
  4. (standard-class.method-names c)
  5. (standard-class.method-vector c)
  6. (make-standard-class ...)

换成：

  1. (and (vector? x) (eqv? (vector-ref x 0) standard-class))
  2. (vector-ref c 1)
  3. (vector-ref c 2)
  4. (vector-ref c 3)
  5. (vector-ref c 4)
  6. (send 'make-instance standard-class ...)

12.3 多重继承

我们可以容易的修改这个对象系统使类可以有一个以上的父类。我们重新定义standard‑class来添加一个属性叫class‑precedence‑list取代superclass，一个类的class‑precedence‑list是它所有父类的列表，而不只有通过create-class创建时指定的“直接”的父类。从这个名字可以看出其超类是以一种特定的顺序来存放的，前面的超类有比后面超类更高的优先级。

  1. (define standard-class
  2.   (vector 'value-of-standard-class-goes-here
  3.           (list 'slots 'class-precedence-list 'method-names 'method-vector)
  4.           '()
  5.           '(make-instance)
  6.           (vector make-instance)))

不仅属性列表改变来存放新的属性，而且superclass属性也从#t变为()，这是因为standard‑class的class‑precedence‑list必须是一个列表。我们可以令它的值为(#t)，但是我们不会提到元类，由于它在每个类的class‑precedence‑list中。

宏create-class也需要修改来接受一个超类的列表而不是一个单独的超类。

  1. (define-macro create-class
  2.   (lambda (direct-superclasses slots . methods)
  3.     `(create-class-proc
  4.       (list ,@(map (lambda (su) `,su) direct-superclasses))
  5.       (list ,@(map (lambda (slot) `',slot) slots))
  6.       (list ,@(map (lambda (method) `',(car method)) methods))
  7.       (vector ,@(map (lambda (method) `,(cadr method)) methods))
  8.       )))

create‑class‑proc必须根据提供的超类给出类的优先级列表，并根据优先级给出属性列表：

  1. (define create-class-proc
  2.   (lambda (direct-superclasses slots method-names method-vector)
  3.     (let ((class-precedence-list
  4.            (delete-duplicates
  5.             (append-map
  6.              (lambda (c) (vector-ref c 2))
  7.              direct-superclasses))))
  8.       (send 'make-instance standard-class
  9.             'class-precedence-list class-precedence-list
  10.             'slots
  11.             (delete-duplicates
  12.              (append slots (append-map
  13.                             (lambda (c) (vector-ref c 1))
  14.                             class-precedence-list)))
  15.             'method-names method-names
  16.             'method-vector method-vector))))

过程append-map是一个append和map的组合：

  1. (define append-map
  2.   (lambda (f s)
  3.     (let loop ((s s))
  4.       (if (null? s) '()
  5.           (append (f (car s))
  6.                   (loop (cdr s)))))))

过程send在寻找一个方法时必须从左到右搜索类的优先级列表：

  1. (define send
  2.   (lambda (method-name instance . args)
  3.     (let ((proc
  4.            (let ((class (class-of instance)))
  5.              (if (eqv? class #t) (error 'send)
  6.                  (let loop ((class class)
  7.                             (superclasses (vector-ref class 2)))
  8.                    (let ((k (list-position 
  9.                              method-name
  10.                              (vector-ref class 3))))
  11.                      (cond (k (vector-ref 
  12.                                (vector-ref class 4) k))
  13.                            ((null? superclasses) (error 'send))
  14.                            (else (loop (car superclasses)
  15.                                        (cdr superclasses))))
  16.                      ))))))
  17.       (apply proc instance args))))

理论上我们可以把方法也定义为属性（值为一个过程），但是有很多理由不这样做，类的实例共享方法但是通常有不同的属性值。也就是说，方法可以包括在类定义中，而且不需要每次实例化时都进行设置——就像属性那样。