第十二章 對象和類
===================
類是描述了一組有共同行為的對象。由類描述的對象稱為類的一個實例。類指定了其實例擁有的`屬性`（原文為slot卡槽）的名稱，而這些`屬性`的值由實例自身來進行填充。類同樣也指定了可以應用于其實例的`方法`(method)。屬性值可以是任何形式，但方法的值必須是過程。
類具有繼承性。因此，一個類可以是另一個類的子類，我們稱另一個類為它的父類。一個子類不僅有它自己“直接的”屬性和方法，也會繼承它的父類的所有屬性和方法。如果一個類里有與其父類相同名稱的屬性和方法，那么僅保留子類的屬性和方法。
## 12.1 一個簡單的對象系統
現在我們用Scheme來實現一個基本的對象系統。對于每個類，我們只允許有一個父類（單繼承性）。如果我們不想指定一個父類，我們可以用`#t`作為一個“元”父類，既沒有屬性，也沒有方法。而`#t`的父類則認為是它自己。
作為一次嘗試，用結構`standard-class`來定義類應該是很好的一種方式，用結構的字段來保存屬性名字，父類以及方法。前兩個字段我們分別叫做`slots`和`superclass`。我們將使用兩個字段來描述方法，用`method-names`字段來描述類的方法的名稱列表，用`method-vector`字段來保存一個矢量，里面放著類的方法。這是`standard-class`的定義：
```scheme
(defstruct standard-class
slots superclass method-names method-vector)
```
我們可以用`make-standard-class`，即`standard-class`的制造程序(見第九章)來創建一個新的類：
```scheme
(define trivial-bike-class
(make-standard-class
'superclass #t
'slots '(frame parts size)
'method-names '()
'method-vector #()))
```
這是一個非常簡單的類，更加復雜的類會有有意義的父類和方法，這需要在創建類時進行大量的初始化設置，我們希望把這些工作隱藏在創建類的過程中。因此我們定義一個`create-class`宏來對`make-standard-class`進行適當的調用。
```scheme
(define-macro create-class
(lambda (superclass slots . methods)
`(create-class-proc
,superclass
(list ,@(map (lambda (slot) `',slot) slots))
(list ,@(map (lambda (method) `',(car method)) methods))
(vector ,@(map (lambda (method) `,(cadr method)) methods)))))
```
我們稍后再介紹`create-class-proc`程序的定義。
`make-instance`程序創建類的一個實例，由類中包含的信息產生一個新的向量。實例向量的格式非常簡單：它的第一個元素指向這個類（引用），余下的元素都是屬性值。`make-instance`的第一個參數是一個類，后面的參數是成對的序列，而每一個“對”是屬性名稱和該實例中屬性的值。
```scheme
(define make-instance
(lambda (class . slot-value-twosomes)
;Find `n', the number of slots in `class'.
;Create an instance vector of length `n + 1',
;because we need one extra element in the instance
;to contain the class.
(let* ((slotlist (standard-class.slots class))
(n (length slotlist))
(instance (make-vector (+ n 1))))
(vector-set! instance 0 class)
;Fill each of the slots in the instance
;with the value as specified in the call to
;`make-instance'.
(let loop ((slot-value-twosomes slot-value-twosomes))
(if (null? slot-value-twosomes) instance
(let ((k (list-position (car slot-value-twosomes)
slotlist)))
(vector-set! instance (+ k 1)
(cadr slot-value-twosomes))
(loop (cddr slot-value-twosomes))))))))
```
這是一個類的實例化的例子：
```scheme
(define my-bike
(make-instance trivial-bike-class
'frame 'cromoly
'size '18.5
'parts 'alivio))
```
這將`my-bike`變量綁定到如下所示的實例上。
```scheme
#(<trivial-bike-class> cromoly 18.5 alivio)
```
`<trivial?bike?class>`是一個Scheme數據(另一個向量)代表之前定義的`trivia-bike-class`的值。
`class-of`程序返回該實例對應的類：
```scheme
(define class-of
(lambda (instance)
(vector-ref instance 0)))
```
這里假定`class-of`的參數是一個類的實例，即一個向量，其第一個元素指向`standard-class`的一些實例。我們可能想使`class-of`對我們給定的任何類型Scheme對象返回一個合適的值。
```scheme
(define class-of
(lambda (x)
(if (vector? x)
(let ((n (vector-length x)))
(if (>= n 1)
(let ((c (vector-ref x 0)))
(if (standard-class? c) c #t))
#t))
#t)))
```
不是用`standard-class`創建的Scheme對象的類被認為是`#t`，即“元類”。
`slot-value`過程和`set!slot-value`過程用來訪問和改變一個類實例的值：
```scheme
(define slot-value
(lambda (instance slot)
(let* ((class (class-of instance))
(slot-index
(list-position slot (standard-class.slots class))))
(vector-ref instance (+ slot-index 1)))))
(define set!slot-value
(lambda (instance slot new-val)
(let* ((class (class-of instance))
(slot-index
(list-position slot (standard-class.slots class))))
(vector-set! instance (+ slot-index 1) new-val))))
```
我們現在來解決`create-class-proc`的定義問題。這個過程接受一個父類，一個屬性的列表，一個方法名稱的列表和一個包含方法體的向量，并適當調用`make-standard-class`程序。唯一困難的部分是給定的屬性字段的值。由于一個類必須包括它的父類的屬性，因此不能只有`create-class`提供的屬性參數。我們必須把所給的屬性追加到父類的屬性中，并保證沒有重復的屬性。
```scheme
(define create-class-proc
(lambda (superclass slots method-names method-vector)
(make-standard-class
'superclass superclass
'slots
(let ((superclass-slots
(if (not (eqv? superclass #t))
(standard-class.slots superclass)
'())))
(if (null? superclass-slots) slots
(delete-duplicates
(append slots superclass-slots))))
'method-names method-names
'method-vector method-vector)))
```
過程`delete-duplicates`接受一個列表`s`為參數，返回一個新列表，該列表只包含`s`中每個元素的最后一次出現。
```scheme
(define delete-duplicates
(lambda (s)
(if (null? s) s
(let ((a (car s)) (d (cdr s)))
(if (memv a d) (delete-duplicates d)
(cons a (delete-duplicates d)))))))
```
現在談談方法的應用。我們通過使用`send`程序調用一個類實例的方法。`send`的參數是方法的名字，緊接著是類實例，以及除了類實例本身之外的該方法的其他參數。由于方法儲存在實例的類中而不是在實例本身中，因此`send`會在該實例對于的類中尋找該方法。如果沒有找到，則到父類中尋找，如此直到找完整個繼承鏈：
```scheme
(define send
(lambda (method instance . args)
(let ((proc
(let loop ((class (class-of instance)))
(if (eqv? class #t) (error 'send)
(let ((k (list-position
method
(standard-class.method-names class))))
(if k
(vector-ref (standard-class.method-vector class) k)
(loop (standard-class.superclass class))))))))
(apply proc instance args))))
```
我們現在可以定義一些更有趣的類了：
```scheme
(define bike-class
(create-class
#t
(frame size parts chain tires)
(check-fit (lambda (me inseam)
(let ((bike-size (slot-value me 'size))
(ideal-size (* inseam 3/5)))
(let ((diff (- bike-size ideal-size)))
(cond ((<= -1 diff 1) 'perfect-fit)
((<= -2 diff 2) 'fits-well)
((< diff -2) 'too-small)
((> diff 2) 'too-big))))))))
```
這里，`bike-class`包括一個名為`check-fit`的方法，它接受一個自行車的實例和一個褲腿的尺寸作為參數，并報告該車對這種褲腿尺寸的人的適應性。
我們再來定義`my-bike`：
```scheme
(define my-bike
(make-instance bike-class
'frame 'titanium ; I wish
'size 21
'parts 'ultegra
'chain 'sachs
'tires 'continental))
```
檢查這個車與褲腿尺寸為32的某個人是否搭配：
```scheme
(send 'check-fit my-bike 32)
```
我們再定義子類`bike-class`。
```scheme
(define mtn-bike-class
(create-class
bike-class
(suspension)
(check-fit (lambda (me inseam)
(let ((bike-size (slot-value me 'size))
(ideal-size (- (* inseam 3/5) 2)))
(let ((diff (- bike-size ideal-size)))
(cond ((<= -2 diff 2) 'perfect-fit)
((<= -4 diff 4) 'fits-well)
((< diff -4) 'too-small)
((> 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個元素的向量。
```scheme
(define standard-class
(vector 'value-of-standard-class-goes-here
(list 'slots
'superclass
'method-names
'method-vector)
#t
'(make-instance)
(vector make-instance)))
```
注意到`standard-class`這個向量并沒有被完全填充：符號`value?of?standard?class?goes?here`此時僅僅做占位用。現在我們已經定義了一個`standard-class`的值，現在我們可以用它來確定它自己的類，即它本身。
```scheme
(vector-set! standard-class 0 standard-class)
```
注意我們不能用`class`結構提供的過程了。我們必須把下面的形式：
```scheme
(standard-class? x)
(standard-class.slots c)
(standard-class.superclass c)
(standard-class.method-names c)
(standard-class.method-vector c)
(make-standard-class ...)
```
換成：
```scheme
(and (vector? x) (eqv? (vector-ref x 0) standard-class))
(vector-ref c 1)
(vector-ref c 2)
(vector-ref c 3)
(vector-ref c 4)
(send 'make-instance standard-class ...)
```
## 12.3 多重繼承
我們可以容易的修改這個對象系統使類可以有一個以上的父類。我們重新定義`standard?class`來添加一個屬性叫`class?precedence?list`取代`superclass`，一個類的`class?precedence?list`是它所有父類的列表，而不只有通過`create-class`創建時指定的“直接”的父類。從這個名字可以看出其超類是以一種特定的順序來存放的，前面的超類有比后面超類更高的優先級。
```scheme
(define standard-class
(vector 'value-of-standard-class-goes-here
(list 'slots 'class-precedence-list 'method-names 'method-vector)
'()
'(make-instance)
(vector make-instance)))
```
不僅屬性列表改變來存放新的屬性，而且`superclass`屬性也從`#t`變為`()`，這是因為`standard?class`的`class?precedence?list`必須是一個列表。我們可以令它的值為`(#t)`，但是我們不會提到元類，由于它在每個類的`class?precedence?list`中。
宏`create-class`也需要修改來接受一個超類的列表而不是一個單獨的超類。
```scheme
(define-macro create-class
(lambda (direct-superclasses slots . methods)
`(create-class-proc
(list ,@(map (lambda (su) `,su) direct-superclasses))
(list ,@(map (lambda (slot) `',slot) slots))
(list ,@(map (lambda (method) `',(car method)) methods))
(vector ,@(map (lambda (method) `,(cadr method)) methods))
)))
```
`create?class?proc`必須根據提供的超類給出類的優先級列表，并根據優先級給出屬性列表：
```scheme
(define create-class-proc
(lambda (direct-superclasses slots method-names method-vector)
(let ((class-precedence-list
(delete-duplicates
(append-map
(lambda (c) (vector-ref c 2))
direct-superclasses))))
(send 'make-instance standard-class
'class-precedence-list class-precedence-list
'slots
(delete-duplicates
(append slots (append-map
(lambda (c) (vector-ref c 1))
class-precedence-list)))
'method-names method-names
'method-vector method-vector))))
```
過程`append-map`是一個`append`和`map`的組合：
```scheme
(define append-map
(lambda (f s)
(let loop ((s s))
(if (null? s) '()
(append (f (car s))
(loop (cdr s)))))))
```
過程`send`在尋找一個方法時必須從左到右搜索類的優先級列表：
```scheme
(define send
(lambda (method-name instance . args)
(let ((proc
(let ((class (class-of instance)))
(if (eqv? class #t) (error 'send)
(let loop ((class class)
(superclasses (vector-ref class 2)))
(let ((k (list-position
method-name
(vector-ref class 3))))
(cond (k (vector-ref
(vector-ref class 4) k))
((null? superclasses) (error 'send))
(else (loop (car superclasses)
(cdr superclasses))))
))))))
(apply proc instance args))))
```
--------------------------
理論上我們可以把方法也定義為屬性（值為一個過程），但是有很多理由不這樣做，類的實例共享方法但是通常有不同的屬性值。也就是說，方法可以包括在類定義中，而且不需要每次實例化時都進行設置——就像屬性那樣。
