第十七章：示例：對(duì)象

在本章里，我們將使用 Lisp 來(lái)自己實(shí)現(xiàn)面向?qū)ο笳Z(yǔ)言。這樣子的程序稱(chēng)為嵌入式語(yǔ)言 (embedded language)。嵌入一個(gè)面向?qū)ο笳Z(yǔ)言到 Lisp 里是一個(gè)絕佳的例子。同時(shí)作為一個(gè) Lisp 的典型用途，並演示了面向?qū)ο蟮某橄笫侨绾味嘧匀坏卦?Lisp 基本的抽象上構(gòu)建出來(lái)。

17.1 繼承 (Inheritance)

11.10 小節(jié)解釋過(guò)通用函數(shù)與消息傳遞的差別。

在消息傳遞模型里，

1. 對(duì)象有屬性，
2. 并回應(yīng)消息，
3. 并從其父類(lèi)繼承屬性與方法。

當(dāng)然了，我們知道 CLOS 使用的是通用函數(shù)模型。但本章我們只對(duì)于寫(xiě)一個(gè)迷你的對(duì)象系統(tǒng) (minimal object system)感興趣，而不是一個(gè)可與 CLOS 匹敵的系統(tǒng)，所以我們將使用消息傳遞模型。

我們已經(jīng)在 Lisp 里看過(guò)許多保存屬性集合的方法。一種可能的方法是使用哈希表來(lái)代表對(duì)象，并將屬性作為哈希表的條目保存。接著可以通過(guò)?gethash?來(lái)存取每個(gè)屬性：

(gethash 'color obj)

由于函數(shù)是數(shù)據(jù)對(duì)象，我們也可以將函數(shù)作為屬性保存起來(lái)。這表示我們也可以有方法；要調(diào)用一個(gè)對(duì)象特定的方法，可以通過(guò)funcall?一下哈希表里的同名屬性：

(funcall (gethash 'move obj) obj 10)

我們可以在這個(gè)概念上，定義一個(gè) Smalltalk 風(fēng)格的消息傳遞語(yǔ)法，

(defun tell (obj message &rest args)
  (apply (gethash message obj) obj args))

所以想要一個(gè)對(duì)象?obj?移動(dòng) 10 單位，我們可以說(shuō)：

(tell obj 'move 10)

事實(shí)上，純 Lisp 唯一缺少的原料是繼承。我們可以通過(guò)定義一個(gè)遞歸版本的?gethash?來(lái)實(shí)現(xiàn)一個(gè)簡(jiǎn)單版，如圖 17.1 ?，F(xiàn)在僅用共 8 行代碼，便實(shí)現(xiàn)了面向?qū)ο缶幊痰?3 個(gè)基本元素。

(defun rget (prop obj)
  (multiple-value-bind (val in) (gethash prop obj)
    (if in
        (values val in)
        (let ((par (gethash :parent obj)))
          (and par (rget prop par))))))

(defun tell (obj message &rest args)
  (apply (rget message obj) obj args))

圖 17.1：繼承

讓我們用這段代碼，來(lái)試試本來(lái)的例子。我們創(chuàng)建兩個(gè)對(duì)象，其中一個(gè)對(duì)象是另一個(gè)的子類(lèi)：

> (setf circle-class (make-hash-table)
        our-circle   (make-hash-table)
        (gethash :parent our-circle) circle-class
        (gethash 'radius our-circle) 2)
2

circle-class?對(duì)象會(huì)持有給所有圓形使用的?area?方法。它是接受一個(gè)參數(shù)的函數(shù)，該參數(shù)為傳來(lái)原始消息的對(duì)象：

> (setf (gethash 'area circle-class)
        #'(lambda (x)
            (* pi (expt (rget 'radius x) 2))))
#<Interpreted-Function BF1EF6>

現(xiàn)在當(dāng)我們?cè)儐?wèn)?our-circle?的面積時(shí)，會(huì)根據(jù)此類(lèi)所定義的方法來(lái)計(jì)算。我們使用?rget?來(lái)讀取一個(gè)屬性，用?tell?來(lái)調(diào)用一個(gè)方法：

> (rget 'radius our-circle)
2
T
> (tell our-circle 'area)
12.566370614359173

在開(kāi)始改善這個(gè)程序之前，值得停下來(lái)想想我們到底做了什么。僅使用 8 行代碼，我們使純的、舊的、無(wú) CLOS 的 Lisp ，轉(zhuǎn)變成一個(gè)面向?qū)ο笳Z(yǔ)言。我們是怎么完成這項(xiàng)壯舉的？應(yīng)該用了某種秘訣，才會(huì)僅用了 8 行代碼，就實(shí)現(xiàn)了面向?qū)ο缶幊獭?/p>

的確有一個(gè)秘訣存在，但不是編程的奇技淫巧。這個(gè)秘訣是，Lisp 本來(lái)就是一個(gè)面向?qū)ο蟮恼Z(yǔ)言了，甚至說(shuō)，是種更通用的語(yǔ)言。我們需要做的事情，不過(guò)就是把本來(lái)就存在的抽象，再重新包裝一下。

17.2 多重繼承 (Multiple Inheritance)

到目前為止我們只有單繼承 ── 一個(gè)對(duì)象只可以有一個(gè)父類(lèi)。但可以通過(guò)使?parent?屬性變成一個(gè)列表來(lái)獲得多重繼承，并重新定義?rget?，如圖 17.2 所示。

在只有單繼承的情況下，當(dāng)我們想要從對(duì)象取出某些屬性，只需要遞歸地延著祖先的方向往上找。如果對(duì)象本身沒(méi)有我們想要屬性的有關(guān)信息，可以檢視其父類(lèi)，以此類(lèi)推。有了多重繼承后，我們?nèi)韵胍獔?zhí)行同樣的搜索，但這件簡(jiǎn)單的事，卻被對(duì)象的祖先可形成一個(gè)圖，而不再是簡(jiǎn)單的樹(shù)給復(fù)雜化了。不能只使用深度優(yōu)先來(lái)搜索這個(gè)圖。有多個(gè)父類(lèi)時(shí)，可以有如圖 17.3 所示的層級(jí)存在：?a?起源于?b?及?c?，而他們都是?d?的子孫。一個(gè)深度優(yōu)先（或說(shuō)高度優(yōu)先）的遍歷結(jié)果會(huì)是?a?,?b?,?d,?c?,?d?。而如果我們想要的屬性在?d與?c?都有的話(huà)，我們會(huì)獲得存在?d?的值，而不是存在?c?的值。這違反了子類(lèi)可覆寫(xiě)父類(lèi)提供缺省值的原則。

如果我們想要實(shí)現(xiàn)普遍的繼承概念，就不應(yīng)該在檢查其子孫前，先檢查該對(duì)象。在這個(gè)情況下，適當(dāng)?shù)乃阉黜樞驎?huì)是?a?,?b?,?c?,?d?。那如何保證搜索總是先搜子孫呢？最簡(jiǎn)單的方法是用一個(gè)對(duì)象，以及按正確優(yōu)先順序排序的，由祖先所構(gòu)成的列表。通過(guò)調(diào)用traverse?開(kāi)始，建構(gòu)一個(gè)列表，表示深度優(yōu)先遍歷所遇到的對(duì)象。如果任一個(gè)對(duì)象有共享的父類(lèi)，則列表中會(huì)有重復(fù)元素。如果僅保存最后出現(xiàn)的復(fù)本，會(huì)獲得一般由 CLOS 定義的優(yōu)先級(jí)列表。（刪除所有除了最后一個(gè)之外的復(fù)本，根據(jù) 183 頁(yè)所描述的算法，規(guī)則三。）Common Lisp 函數(shù)?delete-duplicates?定義成如此作用的，所以我們只要在深度優(yōu)先的基礎(chǔ)上調(diào)用它，我們就會(huì)得到正確的優(yōu)先級(jí)列表。一旦優(yōu)先級(jí)列表創(chuàng)建完成，?rget?根據(jù)需要的屬性搜索第一個(gè)符合的對(duì)象。

我們可以通過(guò)利用優(yōu)先級(jí)列表的優(yōu)點(diǎn)，舉例來(lái)說(shuō)，一個(gè)愛(ài)國(guó)的無(wú)賴(lài)先是一個(gè)無(wú)賴(lài)，然后才是愛(ài)國(guó)者：

> (setf scoundrel           (make-hash-table)
        patriot             (make-hash-table)
        patriotic-scoundrel (make-hash-table)
        (gethash 'serves scoundrel) 'self
        (gethash 'serves patriot) 'country
        (gethash :parents patriotic-scoundrel)
                 (list scoundrel patriot))
(#<Hash-Table C41C7E> #<Hash-Table C41F0E>)
> (rget 'serves patriotic-scoundrel)
SELF
T

到目前為止，我們有一個(gè)強(qiáng)大的程序，但極其丑陋且低效。在一個(gè) Lisp 程序生命周期的第二階段，我們將這個(gè)初步框架提煉成有用的東西。

17.3 定義對(duì)象 (Defining Objects)

第一個(gè)我們需要改善的是，寫(xiě)一個(gè)用來(lái)創(chuàng)建對(duì)象的函數(shù)。我們程序表示對(duì)象以及其父類(lèi)的方式，不需要給用戶(hù)知道。如果我們定義一個(gè)函數(shù)來(lái)創(chuàng)建對(duì)象，用戶(hù)將能夠一個(gè)步驟就創(chuàng)建出一個(gè)對(duì)象，并指定其父類(lèi)。我們可以在創(chuàng)建一個(gè)對(duì)象的同時(shí)，順道構(gòu)造優(yōu)先級(jí)列表，而不是在每次當(dāng)我們需要找一個(gè)屬性或方法時(shí)，才花費(fèi)龐大代價(jià)來(lái)重新構(gòu)造。

如果我們要維護(hù)優(yōu)先級(jí)列表，而不是在要用的時(shí)候再構(gòu)造它們，我們需要處理列表會(huì)過(guò)時(shí)的可能性。我們的策略會(huì)是用一個(gè)列表來(lái)保存所有存在的對(duì)象，而無(wú)論何時(shí)當(dāng)某些父類(lèi)被改動(dòng)時(shí)，重新給所有受影響的對(duì)象生成優(yōu)先級(jí)列表。這代價(jià)是相當(dāng)昂貴的，但由于查詢(xún)比重定義父類(lèi)的可能性來(lái)得高許多，我們會(huì)省下許多時(shí)間。這個(gè)改變對(duì)我們的程序的靈活性沒(méi)有任何影響；我們只是將花費(fèi)從頻繁的操作轉(zhuǎn)到不頻繁的操作。

圖 17.4 包含了新的代碼。?λ?全局的?*objs*?會(huì)是一個(gè)包含所有當(dāng)前對(duì)象的列表。函數(shù)?parents?取出一個(gè)對(duì)象的父類(lèi)；相反的?(setfparents)?不僅配置一個(gè)對(duì)象的父類(lèi)，也調(diào)用?make-precedence?來(lái)重新構(gòu)造任何需要變動(dòng)的優(yōu)先級(jí)列表。這些列表與之前一樣，由precedence?來(lái)構(gòu)造。

用戶(hù)現(xiàn)在不用調(diào)用?make-hash-table?來(lái)創(chuàng)建對(duì)象，調(diào)用?obj?來(lái)取代，?obj?一步完成創(chuàng)建一個(gè)新對(duì)象及定義其父類(lèi)。我們也重定義了rget?來(lái)利用保存優(yōu)先級(jí)列表的好處。

(defvar *objs* nil)

(defun parents (obj) (gethash :parents obj))

(defun (setf parents) (val obj)
  (prog1 (setf (gethash :parents obj) val)
         (make-precedence obj)))

(defun make-precedence (obj)
  (setf (gethash :preclist obj) (precedence obj))
  (dolist (x *objs*)
    (if (member obj (gethash :preclist x))
        (setf (gethash :preclist x) (precedence x)))))

(defun obj (&rest parents)
  (let ((obj (make-hash-table)))
    (push obj *objs*)
    (setf (parents obj) parents)
    obj))

(defun rget (prop obj)
  (dolist (c (gethash :preclist obj))
    (multiple-value-bind (val in) (gethash prop c)
      (if in (return (values val in))))))

圖 17.4：創(chuàng)建對(duì)象

17.4 函數(shù)式語(yǔ)法 (Functional Syntax)

另一個(gè)可以改善的空間是消息調(diào)用的語(yǔ)法。?tell?本身是無(wú)謂的雜亂不堪，這也使得動(dòng)詞在第三順位才出現(xiàn)，同時(shí)代表著我們的程序不再可以像一般 Lisp 前序表達(dá)式那樣閱讀:

(tell (tell obj 'find-owner) 'find-owner)

我們可以使用圖 17.5 所定義的?defprop?宏，通過(guò)定義作為函數(shù)的屬性名稱(chēng)來(lái)擺脫這種?tell?語(yǔ)法。若選擇性參數(shù)?meth??為真的話(huà)，會(huì)將此屬性視為方法。不然會(huì)將屬性視為槽，而由?rget?所取回的值會(huì)直接返回。一旦我們定義了屬性作為槽或方法的名字，

(defmacro defprop (name &optional meth?)
  `(progn
     (defun ,name (obj &rest args)
       ,(if meth?
          `(run-methods obj ',name args)
          `(rget ',name obj)))
     (defun (setf ,name) (val obj)
       (setf (gethash ',name obj) val))))

(defun run-methods (obj name args)
  (let ((meth (rget name obj)))
    (if meth
        (apply meth obj args)
        (error "No ~A method for ~A." name obj))))

圖 17.5: 函數(shù)式語(yǔ)法

(defprop find-owner t)

我們就可以在函數(shù)調(diào)用里引用它，則我們的代碼讀起來(lái)將會(huì)再次回到 Lisp 本來(lái)那樣：

(find-owner (find-owner obj))

我們的前一個(gè)例子在某種程度上可讀性變得更高了：

> (progn
    (setf scoundrel           (obj)
          patriot             (obj)
          patriotic-scoundrel (obj scoundrel patriot))
    (defprop serves)
    (setf (serves scoundrel) 'self
          (serves patriot) 'country)
    (serves patriotic-scoundrel))
SELF
T

17.5 定義方法 (Defining Methods)

到目前為止，我們借由敘述如下的東西來(lái)定義一個(gè)方法：

(defprop area t)

(setf circle-class (obj))

(setf (area circle-class)
      #'(lambda (c) (* pi (expt (radius c) 2))))

(defmacro defmeth (name obj parms &rest body)
  (let ((gobj (gensym)))
    `(let ((,gobj ,obj))
       (setf (gethash ',name ,gobj)
             (labels ((next () (get-next ,gobj ',name)))
               #'(lambda ,parms ,@body))))))

(defun get-next (obj name)
  (some #'(lambda (x) (gethash name x))
        (cdr (gethash :preclist obj))))

圖 17.6 定義方法。

在一個(gè)方法里，我們可以通過(guò)給對(duì)象的?:preclist?的?cdr?獲得如內(nèi)置?call-next-method?方法的效果。所以舉例來(lái)說(shuō)，若我們想要定義一個(gè)特殊的圓形，這個(gè)圓形在返回面積的過(guò)程中印出某個(gè)東西，我們可以說(shuō)：

(setf grumpt-circle (obj circle-class))

(setf (area grumpt-circle)
      #'(lambda (c)
          (format t "How dare you stereotype me!~%")
          (funcall (some #'(lambda (x) (gethash 'area x))
                         (cdr (gethash :preclist c)))
                   c)))

這里?funcall?等同于一個(gè)?call-next-method?調(diào)用，但他..

圖 17.6 的?defmeth?宏提供了一個(gè)便捷方式來(lái)定義方法，并使得調(diào)用下個(gè)方法變得簡(jiǎn)單。一個(gè)?defmeth?的調(diào)用會(huì)展開(kāi)成一個(gè)?setf?表達(dá)式，但?setf?在一個(gè)?labels?表達(dá)式里定義了?next?作為取出下個(gè)方法的函數(shù)。這個(gè)函數(shù)與?next-method-p?類(lèi)似（第 188 頁(yè)「譯註: 11.7 節(jié)」），但返回的是我們可以調(diào)用的東西，同時(shí)作為?call-next-method?。?λ?前述兩個(gè)方法可以被定義成：

(defmeth area circle-class (c)
  (* pi (expt (radius c) 2)))

(defmeth area grumpy-circle (c)
  (format t "How dare you stereotype me!~%")
  (funcall (next) c))

順道一提，注意?defmeth?的定義也利用到了符號(hào)捕捉。方法的主體被插入至函數(shù)?next?是局部定義的一個(gè)上下文里。

17.6 實(shí)例 (Instances)

到目前為止，我們還沒(méi)有將類(lèi)別與實(shí)例做區(qū)別。我們使用了一個(gè)術(shù)語(yǔ)來(lái)表示兩者，對(duì)象(object)。將所有的對(duì)象視為一體是優(yōu)雅且靈活的，但這非常沒(méi)效率。在許多面向?qū)ο髴?yīng)用里，繼承圖的底部會(huì)是復(fù)雜的。舉例來(lái)說(shuō)，模擬一個(gè)交通情況，我們可能有少于十個(gè)對(duì)象來(lái)表示車(chē)子的種類(lèi)，但會(huì)有上百個(gè)對(duì)象來(lái)表示特定的車(chē)子。由于后者會(huì)全部共享少數(shù)的優(yōu)先級(jí)列表，創(chuàng)建它們是浪費(fèi)時(shí)間的，并且浪費(fèi)空間來(lái)保存它們。

圖 17.7 定義一個(gè)宏?inst?，用來(lái)創(chuàng)建實(shí)例。實(shí)例就像其他對(duì)象一樣（現(xiàn)在也可稱(chēng)為類(lèi)別），有區(qū)別的是只有一個(gè)父類(lèi)且不需維護(hù)優(yōu)先級(jí)列表。它們也沒(méi)有包含在列表?*objs**?里。在前述例子里，我們可以說(shuō)：

(setf grumpy-circle (inst circle-class))

由于某些對(duì)象不再有優(yōu)先級(jí)列表，函數(shù)?rget?以及?get-next?現(xiàn)在被重新定義，檢查這些對(duì)象的父類(lèi)來(lái)取代。獲得的效率不用拿靈活性交換。我們可以對(duì)一個(gè)實(shí)例做任何我們可以給其它種對(duì)象做的事，包括創(chuàng)建一個(gè)實(shí)例以及重定義其父類(lèi)。在后面的情況里，?(setfparents)?會(huì)有效地將對(duì)象轉(zhuǎn)換成一個(gè)“類(lèi)別”。

17.7 新的實(shí)現(xiàn) (New Implementation)

我們到目前為止所做的改善都是犧牲靈活性交換而來(lái)。在這個(gè)系統(tǒng)的開(kāi)發(fā)后期，一個(gè) Lisp 程序通?？梢誀奚┰S靈活性來(lái)獲得好處，這里也不例外。目前為止我們使用哈希表來(lái)表示所有的對(duì)象。這給我們帶來(lái)了超乎我們所需的靈活性，以及超乎我們所想的花費(fèi)。在這個(gè)小節(jié)里，我們會(huì)重寫(xiě)我們的程序，用簡(jiǎn)單向量來(lái)表示對(duì)象。

(defun inst (parent)
  (let ((obj (make-hash-table)))
    (setf (gethash :parents obj) parent)
    obj))

(defun rget (prop obj)
  (let ((prec (gethash :preclist obj)))
    (if prec
        (dolist (c prec)
          (multiple-value-bind (val in) (gethash prop c)
            (if in (return (values val in)))))
      (multiple-value-bind (val in) (gethash prop obj)
        (if in
            (values val in)
            (rget prop (gethash :parents obj)))))))

(defun get-next (obj name)
  (let ((prec (gethash :preclist obj)))
    (if prec
        (some #'(lambda (x) (gethash name x))
              (cdr prec))
      (get-next (gethash obj :parents) name))))

圖 17.7: 定義實(shí)例

這個(gè)改變意味著放棄動(dòng)態(tài)定義新屬性的可能性。目前我們可通過(guò)引用任何對(duì)象，給它定義一個(gè)屬性?，F(xiàn)在當(dāng)一個(gè)類(lèi)別被創(chuàng)建時(shí)，我們會(huì)需要給出一個(gè)列表，列出該類(lèi)有的新屬性，而當(dāng)實(shí)例被創(chuàng)建時(shí)，他們會(huì)恰好有他們所繼承的屬性。

在先前的實(shí)現(xiàn)里，類(lèi)別與實(shí)例沒(méi)有實(shí)際區(qū)別。一個(gè)實(shí)例只是一個(gè)恰好有一個(gè)父類(lèi)的類(lèi)別。如果我們改動(dòng)一個(gè)實(shí)例的父類(lèi)，它就變成了一個(gè)類(lèi)別。在新的實(shí)現(xiàn)里，類(lèi)別與實(shí)例有實(shí)際區(qū)別；它使得將實(shí)例轉(zhuǎn)成類(lèi)別不再可能。

在圖 17.8-17.10 的代碼是一個(gè)完整的新實(shí)現(xiàn)。圖片 17.8 給創(chuàng)建類(lèi)別與實(shí)例定義了新的操作符。類(lèi)別與實(shí)例用向量來(lái)表示。表示類(lèi)別與實(shí)例的向量的前三個(gè)元素包含程序自身要用到的信息，而圖 17.8 的前三個(gè)宏是用來(lái)引用這些元素的：

(defmacro parents (v) `(svref ,v 0))
(defmacro layout (v) `(the simple-vector (svref ,v 1)))
(defmacro preclist (v) `(svref ,v 2))

(defmacro class (&optional parents &rest props)
  `(class-fn (list ,@parents) ',props))

(defun class-fn (parents props)
  (let* ((all (union (inherit-props parents) props))
         (obj (make-array (+ (length all) 3)
                          :initial-element :nil)))
    (setf (parents obj)  parents
          (layout obj)   (coerce all 'simple-vector)
          (preclist obj) (precedence obj))
    obj))

(defun inherit-props (classes)
  (delete-duplicates
    (mapcan #'(lambda (c)
                (nconc (coerce (layout c) 'list)
                       (inherit-props (parents c))))
            classes)))

(defun precedence (obj)
  (labels ((traverse (x)
             (cons x
                   (mapcan #'traverse (parents x)))))
    (delete-duplicates (traverse obj))))

(defun inst (parent)
  (let ((obj (copy-seq parent)))
    (setf (parents obj)  parent
          (preclist obj) nil)
    (fill obj :nil :start 3)
    obj))

圖 17.8: 向量實(shí)現(xiàn)：創(chuàng)建

1. parents?字段取代舊實(shí)現(xiàn)中，哈希表?xiàng)l目里?:parents?的位置。在一個(gè)類(lèi)別里，?parents?會(huì)是一個(gè)列出父類(lèi)的列表。在一個(gè)實(shí)例里，?parents?會(huì)是一個(gè)單一的父類(lèi)。
2. layout?字段是一個(gè)包含屬性名字的向量，指出類(lèi)別或?qū)嵗膹牡谒膫€(gè)元素開(kāi)始的設(shè)計(jì) (layout)。
3. preclist?字段取代舊實(shí)現(xiàn)中，哈希表?xiàng)l目里?:preclist?的位置。它會(huì)是一個(gè)類(lèi)別的優(yōu)先級(jí)列表，實(shí)例的話(huà)就是一個(gè)空表。

因?yàn)檫@些操作符是宏，他們?nèi)伎梢员?setf?的第一個(gè)參數(shù)使用（參考 10.6 節(jié)）。

class?宏用來(lái)創(chuàng)建類(lèi)別。它接受一個(gè)含有其基類(lèi)的選擇性列表，伴隨著零個(gè)或多個(gè)屬性名稱(chēng)。它返回一個(gè)代表類(lèi)別的對(duì)象。新的類(lèi)別會(huì)同時(shí)有自己本身的屬性名，以及從所有基類(lèi)繼承而來(lái)的屬性。

> (setf *print-array* nil
        gemo-class (class nil area)
        circle-class (class (geom-class) radius))
#<Simple-Vector T 5 C6205E>

這里我們創(chuàng)建了兩個(gè)類(lèi)別：?geom-class?沒(méi)有基類(lèi)，且只有一個(gè)屬性，?area?；?circle-class?是?gemo-class?的子類(lèi)，并添加了一個(gè)屬性，?radius?。?[1]?circle-class?類(lèi)的設(shè)計(jì)

> (coerce (layout circle-class) 'list)
(AREA RADIUS)

顯示了五個(gè)字段里，最后兩個(gè)的名稱(chēng)。?[2]

class?宏只是一個(gè)?class-fn?的介面，而?class-fn?做了實(shí)際的工作。它調(diào)用?inherit-props?來(lái)匯整所有新對(duì)象的父類(lèi)，匯整成一個(gè)列表，創(chuàng)建一個(gè)正確長(zhǎng)度的向量，并適當(dāng)?shù)嘏渲们叭齻€(gè)字段。（?preclist?由?precedence?創(chuàng)建，本質(zhì)上?precedence?沒(méi)什么改變。）類(lèi)別余下的字段設(shè)置為?:nil?來(lái)指出它們尚未初始化。要檢視?circle-class?的?area?屬性，我們可以：

> (svref circle-class
         (+ (position 'area (layout circle-class)) 3))
:NIL

稍后我們會(huì)定義存取函數(shù)來(lái)自動(dòng)辦到這件事。

最后，函數(shù)?inst?用來(lái)創(chuàng)建實(shí)例。它不需要是一個(gè)宏，因?yàn)樗鼉H接受一個(gè)參數(shù)：

> (setf our-circle (inst circle-class))
#<Simple-Vector T 5 C6464E>

比較?inst?與?class-fn?是有益學(xué)習(xí)的，它們做了差不多的事。因?yàn)閷?shí)例僅有一個(gè)父類(lèi)，不需要決定它繼承什么屬性。實(shí)例可以?xún)H拷貝其父類(lèi)的設(shè)計(jì)。它也不需要構(gòu)造一個(gè)優(yōu)先級(jí)列表，因?yàn)閷?shí)例沒(méi)有優(yōu)先級(jí)列表。創(chuàng)建實(shí)例因此與創(chuàng)建類(lèi)別比起來(lái)來(lái)得快許多，因?yàn)閯?chuàng)建實(shí)例在多數(shù)應(yīng)用里比創(chuàng)建類(lèi)別更常見(jiàn)。

(declaim (inline lookup (setf lookup)))

(defun rget (prop obj next?)
  (let ((prec (preclist obj)))
    (if prec
        (dolist (c (if next? (cdr prec) prec) :nil)
          (let ((val (lookup prop c)))
            (unless (eq val :nil) (return val))))
        (let ((val (lookup prop obj)))
          (if (eq val :nil)
              (rget prop (parents obj) nil)
              val)))))

(defun lookup (prop obj)
  (let ((off (position prop (layout obj) :test #'eq)))
    (if off (svref obj (+ off 3)) :nil)))

(defun (setf lookup) (val prop obj)
  (let ((off (position prop (layout obj) :test #'eq)))
    (if off
        (setf (svref obj (+ off 3)) val)
        (error "Can't set ~A of ~A." val obj))))

圖 17.9: 向量實(shí)現(xiàn)：存取

現(xiàn)在我們可以創(chuàng)建所需的類(lèi)別層級(jí)及實(shí)例，以及需要的函數(shù)來(lái)讀寫(xiě)它們的屬性。圖 17.9 的第一個(gè)函數(shù)是?rget?的新定義。它的形狀與圖 17.7 的?rget?相似。條件式的兩個(gè)分支，分別處理類(lèi)別與實(shí)例。

1. 若對(duì)象是一個(gè)類(lèi)別，我們遍歷其優(yōu)先級(jí)列表，直到我們找到一個(gè)對(duì)象，其中欲找的屬性不是?:nil?。如果沒(méi)有找到，返回?:nil。
2. 若對(duì)象是一個(gè)實(shí)例，我們直接查找屬性，并在沒(méi)找到時(shí)遞回地調(diào)用?rget?。

rget?與?next??新的第三個(gè)參數(shù)稍后解釋?，F(xiàn)在只要了解如果是?nil?，?rget?會(huì)像平常那樣工作。

函數(shù)?lookup?及其反相扮演著先前?rget?函數(shù)里?gethash?的角色。它們使用一個(gè)對(duì)象的?layout?，來(lái)取出或設(shè)置一個(gè)給定名稱(chēng)的屬性。這條查詢(xún)是先前的一個(gè)復(fù)本：

> (lookup 'area circle-class)
:NIL

由于?lookup?的?setf?也定義了，我們可以給?circle-class?定義一個(gè)?area?方法，通過(guò)：

(setf (lookup 'area circle-class)
      #'(lambda (c)
          (* pi (expt (rget 'radius c nil) 2))))

在這個(gè)程序里，和先前的版本一樣，沒(méi)有特別區(qū)別出方法與槽。一個(gè)“方法”只是一個(gè)字段，里面有著一個(gè)函數(shù)。這將很快會(huì)被一個(gè)更方便的前端所隱藏起來(lái)。

(declaim (inline run-methods))

(defmacro defprop (name &optional meth?)
  `(progn
     (defun ,name (obj &rest args)
       ,(if meth?
            `(run-methods obj ',name args)
            `(rget ',name obj nil)))
     (defun (setf ,name) (val obj)
       (setf (lookup ',name obj) val))))

(defun run-methods (obj name args)
  (let ((meth (rget name obj nil)))
    (if (not (eq meth :nil))
        (apply meth obj args)
        (error "No ~A method for ~A." name obj))))

(defmacro defmeth (name obj parms &rest body)
  (let ((gobj (gensym)))
    `(let ((,gobj ,obj))
       (defprop ,name t)
       (setf (lookup ',name ,gobj)
             (labels ((next () (rget ,gobj ',name t)))
               #'(lambda ,parms ,@body))))))

圖 17.10: 向量實(shí)現(xiàn)：宏介面

圖 17.10 包含了新的實(shí)現(xiàn)的最后部分。這個(gè)代碼沒(méi)有給程序加入任何威力，但使程序更容易使用。宏?defprop?本質(zhì)上沒(méi)有改變；現(xiàn)在僅調(diào)用?lookup?而不是?gethash?。與先前相同，它允許我們用函數(shù)式的語(yǔ)法來(lái)引用屬性：

> (defprop radius)
(SETF RADIUS)
> (radius our-circle)
:NIL
> (setf (radius our-circle) 2)
2

如果?defprop?的第二個(gè)選擇性參數(shù)為真的話(huà)，它展開(kāi)成一個(gè)?run-methods?調(diào)用，基本上也沒(méi)什么改變。

最后，函數(shù)?defmeth?提供了一個(gè)便捷方式來(lái)定義方法。這個(gè)版本有三件新的事情：它隱含了?defprop?，它調(diào)用?lookup?而不是gethash?，且它調(diào)用?regt?而不是 278 頁(yè)的?get-next?(譯注: 圖 17.7 的?get-next?)來(lái)獲得下個(gè)方法。現(xiàn)在我們理解給?rget?添加額外參數(shù)的理由。它與?get-next?非常相似，我們同樣通過(guò)添加一個(gè)額外參數(shù)，在一個(gè)函數(shù)里實(shí)現(xiàn)。若這額外參數(shù)為真時(shí)，?rget?取代get-next?的位置。

現(xiàn)在我們可以達(dá)到先前方法定義所有的效果，但更加清晰：

(defmeth area circle-class (c)
  (* pi (expt (radius c) 2)))

注意我們可以直接調(diào)用?radius?而無(wú)須調(diào)用?rget?，因?yàn)槲覀兪褂?defprop?將它定義成一個(gè)函數(shù)。因?yàn)殡[含的?defprop?由?defmeth實(shí)現(xiàn)，我們也可以調(diào)用?area?來(lái)獲得?our-circle?的面積：

> (area our-circle)
12.566370614359173

17.8 分析 (Analysis)

我們現(xiàn)在有了一個(gè)適合撰寫(xiě)實(shí)際面向?qū)ο蟪绦虻那度胧秸Z(yǔ)言。它很簡(jiǎn)單，但就大小來(lái)說(shuō)相當(dāng)強(qiáng)大。而在典型應(yīng)用里，它也會(huì)是快速的。在一個(gè)典型的應(yīng)用里，操作實(shí)例應(yīng)比操作類(lèi)別更常見(jiàn)。我們重新設(shè)計(jì)的重點(diǎn)在于如何使得操作實(shí)例的花費(fèi)降低。

在我們的程序里，創(chuàng)建類(lèi)別既慢且產(chǎn)生了許多垃圾。如果類(lèi)別不是在速度為關(guān)鍵考量時(shí)創(chuàng)建，這還是可以接受的。會(huì)需要速度的是存取函數(shù)以及創(chuàng)建實(shí)例。這個(gè)程序里的沒(méi)有做編譯優(yōu)化的存取函數(shù)大約與我們預(yù)期的一樣快。?λ?而創(chuàng)建實(shí)例也是如此。且兩個(gè)操作都沒(méi)有用到構(gòu)造 (consing)。除了用來(lái)表達(dá)實(shí)例的向量例外。會(huì)自然的以為這應(yīng)該是動(dòng)態(tài)地配置才對(duì)。但我們甚至可以避免動(dòng)態(tài)配置實(shí)例，如果我們使用像是 13.4 節(jié)所提出的策略。

我們的嵌入式語(yǔ)言是 Lisp 編程的一個(gè)典型例子。只不過(guò)是一個(gè)嵌入式語(yǔ)言就可以是一個(gè)例子了。但 Lisp 的特性是它如何從一個(gè)小的、受限版本的程序，進(jìn)化成一個(gè)強(qiáng)大但低效的版本，最終演化成快速但稍微受限的版本。

Lisp 惡名昭彰的緩慢不是 Lisp 本身導(dǎo)致（Lisp 編譯器早在 1980 年代就可以產(chǎn)生出與 C 編譯器一樣快的代碼），而是由于許多程序員在第二個(gè)階段就放棄的事實(shí)。如同 Richard Gabriel 所寫(xiě)的，

要在 Lisp 撰寫(xiě)出性能極差的程序相當(dāng)簡(jiǎn)單；而在 C 這幾乎是不可能的。?λ

這完全是一個(gè)真的論述，但也可以解讀為贊揚(yáng)或貶低 Lisp 的論點(diǎn)：

1. 通過(guò)犧牲靈活性換取速度，你可以在 Lisp 里輕松地寫(xiě)出程序；在 C 語(yǔ)言里，你沒(méi)有這個(gè)選擇。
2. 除非你優(yōu)化你的 Lisp 代碼，不然要寫(xiě)出緩慢的軟件根本易如反掌。

你的程序?qū)儆谀囊环N解讀完全取決于你。但至少在開(kāi)發(fā)初期，Lisp 使你有犧牲執(zhí)行速度來(lái)?yè)Q取時(shí)間的選擇。

有一件我們示例程序沒(méi)有做的很好的事是，它不是一個(gè)稱(chēng)職的 CLOS 模型（除了可能沒(méi)有說(shuō)明難以理解的?call-next-method?如何工作是件好事例外）。如大象般龐大的 CLOS 與這個(gè)如蚊子般微小的 70 行程序之間，存在多少的相似性呢？當(dāng)然，這兩者的差別是出自于教育性，而不是探討有多相似。首先，這使我們理解到“面向?qū)ο蟆钡膹V度。我們的程序比任何被稱(chēng)為是面向?qū)ο蟮亩紒?lái)得強(qiáng)大，而這只不過(guò)是 CLOS 的一小部分威力。

我們程序與 CLOS 不同的地方是，方法是屬于某個(gè)對(duì)象的。這個(gè)方法的概念使它們與對(duì)第一個(gè)參數(shù)做派發(fā)的函數(shù)相同。而當(dāng)我們使用函數(shù)式語(yǔ)法來(lái)調(diào)用方法時(shí)，這看起來(lái)就跟 Lisp 的函數(shù)一樣。相反地，一個(gè) CLOS 的通用函數(shù)，可以派發(fā)它的任何參數(shù)。一個(gè)通用函數(shù)的組件稱(chēng)為方法，而若你將它們定義成只對(duì)第一個(gè)參數(shù)特化，你可以制造出它們是某個(gè)類(lèi)或?qū)嵗姆椒ǖ腻e(cuò)覺(jué)。但用面向?qū)ο缶幊痰南鬟f模型來(lái)思考 CLOS 最終只會(huì)使你困惑，因?yàn)?CLOS 凌駕在面向?qū)ο缶幊讨稀?/p>

CLOS 的缺點(diǎn)之一是它太龐大了，并且 CLOS 費(fèi)煞苦心的隱藏了面向?qū)ο缶幊?，其?shí)只不過(guò)是改寫(xiě) Lisp 的這個(gè)事實(shí)。本章的例子至少闡明了這一點(diǎn)。如果我們滿(mǎn)足于舊的消息傳遞模型，我們可以用一頁(yè)多一點(diǎn)的代碼來(lái)實(shí)現(xiàn)。面向?qū)ο缶幊滩贿^(guò)是 Lisp 可以做的小事之一而已。更發(fā)人深省的問(wèn)題是，Lisp 除此之外還能做些什么？

腳注

[1] | 當(dāng)類(lèi)別被顯示時(shí)，?*print-array*?應(yīng)當(dāng)是?nil?。 任何類(lèi)別的?preclist?的第一個(gè)元素都是類(lèi)別本身，所以試圖顯示類(lèi)別的內(nèi)部結(jié)構(gòu)會(huì)導(dǎo)致一個(gè)無(wú)限循環(huán)。

[2] | 這個(gè)向量被 coerced 成一個(gè)列表，只是為了看看里面有什么。有了?*print-array*?被設(shè)成?nil?，一個(gè)向量的內(nèi)容應(yīng)該不會(huì)顯示出來(lái)。