第 25 章 面向?qū)ο蟮?Lisp

第 25 章 面向?qū)ο蟮?Lisp

本章討論了 Lisp 中的面向?qū)ο缶幊?。Common Lisp 提供了一組操作符可供編寫面向?qū)ο蟮某绦驎r使用。

這些操作符和起來，并稱為 Common Lisp Object System，或者叫?CLOS?。在這里我們不把?CLOS僅僅看作一種編寫面向?qū)ο蟪绦虻氖侄危阉旧砭彤?dāng)成一個 Lisp 程序。從這個角度來看待?CLOS是理解 Lisp 和面向?qū)ο缶幊讨g關(guān)系的關(guān)鍵。

25.1 萬變不離其宗

面向?qū)ο蟮木幊桃馕吨绦蚪M織方式的一次變革。歷史上的另一個變化與這個變革有幾分類似，即發(fā)生在處理器計算能力分配方式上的變化。在 1970 年代，多用戶計算機(jī)系統(tǒng)指的就是聯(lián)接到大量啞終端的一兩個大型機(jī)。時至今日，這個詞更有可能說的是大量用網(wǎng)絡(luò)互相聯(lián)接的工作站?，F(xiàn)在，系統(tǒng)的處理能力散布于多個獨立用戶中，而不是集中在一臺大型計算機(jī)上。

這與面向?qū)ο缶幊逃泻艽蟪潭壬系南嗨?，后者把傳統(tǒng)的程序結(jié)構(gòu)拆分開來：它不再讓單一的程序邏輯去操縱那些被動的數(shù)據(jù)，而是讓數(shù)據(jù)自己知道該做些什么，程序邏輯就隱含在這些新的數(shù)據(jù) "對象" 間的交互過程之中。

舉例來說，假設(shè)我們要算出一個二維圖形的面積。解決這個問題的一個辦法就是寫一個單獨的函數(shù)，讓它檢查參數(shù)的類型，然后分情況處理：

(defun area (x)
  (cond ((rectangle-p x) (* (height x) (width x)))
    ((circle-p x) (* pi (expt (radius x) 2)))))

面向?qū)ο蟮姆椒▌t是讓每種對象自己就能夠計算出自身的面積。area 這個函數(shù)就被拆開，同時每條語句都被分到對象的對應(yīng)類型中去，比如rectangle 類可能就會看起來像這樣：

#'(lambda (x) (* (height x) (width x)))

至于 circle 則會是這樣：

#'(lambda (x) (* pi (expt (radius x) 2)))

在這種模式下，我們向?qū)ο笤儐栐搶ο蟮拿娣e，然后對象則根據(jù)所屬類型所提供的方法來作出回應(yīng)。

CLOS?的到來似乎意味著 Lisp 正在改變自己，以擁抱面向?qū)ο蟮木幊谭绞?。與其這樣說，不如改成：Lisp 還在墨守成規(guī)，用老樣子來擁抱面向?qū)ο缶幊?，這樣還確切一些。不過 Lisp 中的那些基本概念沒有名字，面向?qū)ο缶幊虆s有，所以時下有種趨勢要把 Lisp 算成面向?qū)ο蟮恼Z言。另一種說法：Lisp 是一門可擴(kuò)展的語言，在這種語言里，面向?qū)ο缶幊痰臋C(jī)制和結(jié)構(gòu)可以輕松實現(xiàn)，這種說法恐怕更接近真相。

由于?CLOS?是原來就有的，所以把 Lisp 說成面向?qū)ο蟮木幊陶Z言并沒有誤導(dǎo)。然而，如果就這樣看待 Lisp 未免太小覷它了。誠然，Lisp 是一種面向?qū)ο蟮木幊陶Z言，但是原因并不是它采納了面向?qū)ο蟮木幊棠Ｊ健?/p>

事實在于，這種編程模式只是 Lisp 的抽象系統(tǒng)提供的又一種可能性而已。為了證明這種可能性，我們有了?CLOS?一個Lisp 程序，它讓Lisp 成為了一門面向?qū)ο蟮恼Z言。

本章的主旨在于：通過把?CLOS?作為一個嵌入式語言的實例來研究，進(jìn)而揭示 Lisp 和面向?qū)ο缶幊讨g的聯(lián)系。這同時也是了解?CLOS?本身的一個很好的手段，要學(xué)習(xí)一個編程語言的特性，沒什么方法能比了解這個特性的實現(xiàn)更有效的了。在第 7.6 節(jié)，那些宏就是用這種方式來講解的。下一節(jié)將會有一個類似的對面向?qū)ο蟪橄笫侨绾谓⒃?Lisp 之上的一個粗略的介紹。其中提到的程序?qū)⒈坏?25.3 節(jié)到第 25.5 節(jié)作為一個基準(zhǔn)實現(xiàn)來參考。

25.2 陽春版 Lisp 中的對象

我們可以用 Lisp 來模擬各種各樣不同種類的語言。有一種特別直接的辦法可以把面向?qū)ο缶幊痰睦砟顚?yīng)到Lisp 的基本抽象機(jī)制上。不過，?CLOS?的龐大規(guī)模讓我們難以認(rèn)清這個事實。因此，在我們開始了解?CLOS?能讓我們做什么之前，不妨先看看我們用最原始的Lisp 都能干些什么。

我們在面向?qū)ο缶幊讨邢胍拇蠖鄶?shù)特性，其實在Lisp 里面已經(jīng)有了。我們可以用少得出奇的代碼來得

到剩下的那部分。在本節(jié)中，我們將會用兩頁紙的代碼實現(xiàn)一個對象系統(tǒng)，這個系統(tǒng)對于相當(dāng)多真實的應(yīng)

用已經(jīng)夠用了。面向?qū)ο缶幊?，簡而言之，就是?/p>

1. 具有屬性的對象

2. 它能對各種消息作出反應(yīng)，

3. 而且對象能從它的父對象繼承相應(yīng)的屬性和方法。

在 Lisp 里面已經(jīng)有好幾種存放成組屬性的方法。其中一種就是把對象實現(xiàn)成哈希表，把對象的屬性作為哈希表里的表項。這樣我們就可以用 gethash 來訪問指定的屬性：

(gethash 'color obj)

由于函數(shù)是數(shù)據(jù)對象，我們同樣可以把它們當(dāng)作屬性保存起來。這就是說，我們的對象系統(tǒng)也可以有方法了，要調(diào)用對象的特定方法就 funcall 一下哈希表里的同名屬性：

(funcall (gethash 'move obj) obj 10)

據(jù)此，我們可以定義一種 Smalltalk 風(fēng)格的消息傳遞語法：

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

這樣的話，要告訴 (tell) obj 移動 10 個單位，就可以說

(tell obj 'move 10)

事實上，陽春版 Lisp 唯一缺少的要素就是繼承機(jī)制，不過我們可以用六行代碼來實現(xiàn)一個初步的版本，這個版本用一個遞歸版的 gethash 來完成這個功能：

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

如果我們在原本用 gethash 的地方用 rget ，就會得到繼承而來的屬性和方法。如此這般，就可以指定對象的父類：

(setf (gethash 'parent obj) obj2)

到現(xiàn)在為止，我們只是有了單繼承 即一個對象只能有一個父類。不過我們可以把 parent 屬性改成一個列表，這樣就能有多繼承了，如 [示例代碼 25.1] 中定義的 rget 。

---

[示例代碼 25.1] 多繼承

(defun rget (obj prop)
  (some2 #'(lambda (a) (gethash prop a))
    (get-ancestors obj)))

(defun get-ancestors (obj)
  (labels ((getall (x)
        (append (list x)
          (mapcan #'getall
            (gethash 'parent x)))))
    (stable-sort (delete-duplicates (getall obj))
      #'(lambda (x y)
        (member y (gethash 'parents x))))))

(defun some2 (fn lst)
  (if (atom lst)
    nil
    (multiple-value-bind (val win) (funcall fn (car lst))
      (if (or val win)
        (values val win)
        (some2 fn (cdr lst))))))

---

在單繼承體系里面，當(dāng)我們需要得到對象的某個屬性時，只需要遞歸地在對象的祖先中向上搜索。如果在對象本身里面沒有我們想要的屬性信息時，就檢查它的父類，如此這般直到找到。在多繼承體系里，我們一樣會需要做這樣的搜索，但是這次的搜索會有點復(fù)雜，因為對象的多個祖先會構(gòu)成一個圖，而不再只是個簡單列表了。我們不能用深度優(yōu)先來搜索這個圖。如果允許有多個父類，我們有如 [示例代碼 25.2] 中所示的繼承樹：

a 繼承自 b 和 c ，而 b 和 c 均繼承于 d 。深度優(yōu)先（或叫高度優(yōu)先） 的遍歷會依次走過 a、b、|d|、c 和d 。倘若想要的屬性同時存在于在 d 和 c 里，那么我們將會得到 d 中的屬性，而非 c 中的。這種情況會違反一個原則：即子類應(yīng)當(dāng)會覆蓋基類中提供的缺省值。

d

b c

a

[示例代碼 25.2]： 到同一基類的多條路徑

如果需要實現(xiàn)繼承系統(tǒng)的基本理念，我們就絕不能在檢查一個對象的子類之前，提前檢查該對象。在本例中，正確的搜索順序應(yīng)該是a、b、c、d 。那怎么樣才能保證搜索的順序是先嘗試子孫再祖先呢？最簡單的辦法是構(gòu)造一個列表，列表由原始對象的所有祖先構(gòu)成，然后對列表排序，讓列表中沒有一個對象出現(xiàn)在它的子孫之前，最后再依次查看每個元素。

get-ancestors 采用了這種策略，它會返回一個按照上面規(guī)則排序的列表，列表中的元素是對象和它的祖先們。為了避免在排序時把同一層次的祖先順序打亂，get-ancestors 使用的是 stable-sort 而非 sort。

一旦排序完畢，rget 只要找到第一個具有期望屬性的對象就可以了。（實用工具 some2 是 some 的一個修改版，它能適用于 gethash 這類用第二個返回值表示成功或失敗的函數(shù)。）

對象的祖先列表中元素的順序是先從最具體的開始，最后到最一般的類型。如果 orange 是citrus 的子類型，后者又是 fruit 的子類型，那么列表的順序就會像這樣：（orange citrus fruit）。

倘若有個對象，它具有多個父類，那么這些前輩的座次會是從左到右排列的。也就是，如果我們說

(setf (gethash 'parents x) (list y z))

那么當(dāng)我們在搜索一個繼承得來的屬性時，y 就會優(yōu)先于z 被考慮。舉個例子，我們可以說愛國的無賴首先是一個無賴，然后才是愛國者：

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

現(xiàn)在讓我們對這個簡陋的系統(tǒng)加以改進(jìn)?？梢詮膶ο髣?chuàng)建函數(shù)著手。這個函數(shù)將會在新建對象時，構(gòu)造一個該對象祖先的列表。雖然當(dāng)前的版本是在進(jìn)行查詢的時候構(gòu)造這種表的，但是我們沒有理由不把這件事情提前完成。[示例代碼 25.3] 中定義了一個名為 obj 的函數(shù)，這個函數(shù)被用于生成新的對象，對象的祖先列表被保存在對象本身里。為了用上保存的祖先列表，我們同時重新定義了 rget 。

---

[示例代碼 25.3] 用來新建對象的函數(shù)

(defun obj (&rest parents)
  (let ((obj (make-hash-table)))
    (setf (gethash 'parents obj) parents)
    (ancestors obj)
    obj))

(defun ancestors (obj)
  (or (gethash 'ancestors obj)
    (setf (gethash 'ancestors obj) (get-ancestors obj))))

(defun rget (obj prop)
  (some2 #'(lambda (a) (gethash prop a))
    (ancestors obj)))

---

另一個可以改進(jìn)的地方是消息調(diào)用的語法。tell 本身是多余的東西，并且由于它的原因，動詞被排到了第二位。這意味著我們的程序讀起來不再像是熟悉的Lisp 前綴表達(dá)式了：

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

我們可以通過把每個屬性定義成函數(shù)來去掉tell 這種語法，如[示例代碼 25.4] 所示?？蛇x參數(shù)meth? 的值如果是真的話，那表示這個屬性應(yīng)該被當(dāng)作方法來處理，否則它應(yīng)該被當(dāng)成一個slot，并徑直返回rget 所取到的值。一旦我們把這兩種屬性中任一種，像這樣定義好了：

(defprop find-owner t)

我們就可以用函數(shù)調(diào)用的方式來引用它，同時代碼讀起來又有 Lisp 的樣子了：

---

[示例代碼 25.4] 函數(shù)式的語法

(find-owner (find-owner obj))

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

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

---

現(xiàn)在，原先的例子也變得更有可讀性了：

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

在當(dāng)前的實現(xiàn)里，對象中每個名字最多對應(yīng)一個方法。這個方法要么是對象自己的，要么是通過繼承得來的。要是能在這個問題上有更多的靈活性，允許把本地的方法和繼承來的方法組合起來，那肯定會方便很多。比如說，我們會希望某個對象的 move 方法沿用其父類的 move 方法，但是除此之外還要在調(diào)用之前或者之后運行一些其它的代碼。

為了讓這個設(shè)想變成現(xiàn)實，我們將修改程序，加上 before、 after 和around 方法。before 方法讓我們能吩咐程序，"先別急，把這事做完再說"。這些方法會在該方法中其余部分運行前，作為前奏，被先行調(diào)用。 after 方法讓我們可以要求程序說，"還有，把這事也給辦了"。而這些方法會作為收場在最后調(diào)用。在兩者之間，我們會執(zhí)行曾經(jīng)自己就是整個方法的函數(shù)，現(xiàn)在被稱為主方法（primarymethod）。它的返回值將被作為整個方法的返回值，即使 after 方法在其后調(diào)用。

before 和 after 方法讓我們能用新的行為把主方法包起來。around 方法則以一種更奇妙的方法實現(xiàn)了這個功能。如果存在around 方法，那么被調(diào)用的就不再是主方法，而是around 方法。并且，around 方法有辦法調(diào)用主方法（用call-next ，該函數(shù)在[示例代碼 25.7] 中提供），至于調(diào)不調(diào)則是它的自由。

如[示例代碼 25.5] 和[示例代碼 25.6] 所示，為了讓這些輔助的方法生效，我們對run-methods 和rget 加以了改進(jìn)。在之前的版本里，當(dāng)我們調(diào)用對象的某個方法時，運行的僅是一個函數(shù)：即最匹配的那個主函數(shù)。我們將會運行搜索祖先列表時找到的第一個方法。加上輔助方法的支持，調(diào)用的順序?qū)⒆兂蛇@樣：

1. 倘若有的話，先是最匹配的around 方法

2. 否則的話，依次是：

   (a) 所有的before 方法,從最匹配的到最不匹配的。

   (b) 最匹配的主方法(這是我們以前會調(diào)用的)。

   (c) 所有的 after 方法,從最不匹配的到最匹配的。

   (defstruct meth around before primary after)

   (defmacro meth- (field obj) (let ((gobj (gensym))) '(let ((,gobj ,obj)) (and (meth-p ,gobj) (,(symb 'meth- field) ,gobj)))))

   (defun run-methods (obj name args) (let ((pri (rget obj name :primary))) (if pri (let ((ar (rget obj name :around))) (if ar (apply ar obj args) (run-core-methods obj name args pri))) (error "No primary ~A method for ~A." name obj))))

   (defun run-core-methods (obj name args &optional pri) (multiple-value-prog1 (progn (run-befores obj name args) (apply (or pri (rget obj name :primary)) obj args)) (run-afters obj name args)))

   (defun rget (obj prop &optional meth (skip 0)) (some2 #'(lambda (a) (multiple-value-bind (val win) (gethash prop a) (if win (case meth (:around (meth- around val)) (:primary (meth- primary val)) (t (values val win)))))) (nthcdr skip (ancestors obj))))

[示例代碼 25.5]： 輔助的方法

(defun run-befores (obj prop args)
  (dolist (a (ancestors obj))
    (let ((bm (meth- before (gethash prop a))))
      (if bm (apply bm obj args)))))

(defun run-afters (obj prop args)
  (labels ((rec (lst)
        (when lst
          (rec (cdr lst))
          (let ((am (meth- after
                  (gethash prop (car lst)))))
            (if am (apply am (car lst) args))))))
    (rec (ancestors obj))))

[示例代碼 25.6]： 輔助的方法（續(xù)）

同時也注意到，方法不再作為單個的函數(shù)出現(xiàn)，它成了有四個成員的結(jié)構(gòu)?，F(xiàn)在要定義一個（主） 方法，不能再像這樣說了：

(setf (gethash 'move obj) #'(lambda ...))

我們改口說：

(setf (meth-primary (gethash 'move obj)) #'(lambda ...))

基于上面、還有其它一些原因，我們下一步將會定義一個宏，讓它幫我們定義方法。

---

[示例代碼 25.7] 定義方法

(defmacro defmeth ((name &optional (type :primary))
    obj parms &body body)
  (let ((gobj (gensym)))
    '(let ((,gobj ,obj))
      (defprop ,name t)
      (unless (meth-p (gethash ',name ,gobj))
        (setf (gethash ',name ,gobj) (make-meth)))
      (setf (,(symb 'meth- type) (gethash ',name ,gobj))
        ,(build-meth name type gobj parms body)))))

(defun build-meth (name type gobj parms body)
  (let ((gargs (gensym)))
    '#'(lambda (&rest ,gargs)
      (labels
        ((call-next ()
            ,(if (or (eq type :primary)
                (eq type :around))
              '(cnm ,gobj ',name (cdr ,gargs) ,type)
              '(error "Illegal call-next.")))
          (next-p ()
            ,(case type
              (:around
                '(or (rget ,gobj ',name :around 1)
                  (rget ,gobj ',name :primary)))
              (:primary
                '(rget ,gobj ',name :primary 1))
              (t nil))))
        (apply #'(lambda ,parms ,@body) ,gargs)))))

(defun cnm (obj name args type)
  (case type
    (:around (let ((ar (rget obj name :around 1)))
        (if ar
          (apply ar obj args)
          (run-core-methods obj name args))))
    (:primary (let ((pri (rget obj name :primary 1)))
        (if pri
          (apply pri obj args)
          (error "No next method."))))))

---

[示例代碼 25.7] 定義的就是這樣的一個宏。代碼中有很大篇幅被用來實現(xiàn)兩個函數(shù)，這兩個函數(shù)讓方法能引用其它的方法。around?和主方法可以使用?call-next?來調(diào)用下一個方法，所謂下一個方法，指的是倘若當(dāng)前方法不存在，就會被調(diào)用的方法。舉個例子，如果當(dāng)前運行的方法是唯一的一個around?方法，那么下一個方法就是常見的由?before?方法、最匹配的主方法和?after?方法三者合體而成的夾心餅干。在最匹配的主方法里， 下一個方法則會是第二匹配的主方法。由于?call-next的行為取決于它被調(diào)用的地方，因此?call-next?絕對不會用一個?defun?來在全局定義，不過它可以在每個由?defmeth?定義的方法里局部定義。

around 方法或者主方法可以用?next-p?來獲知下一個方法是否存在。如果當(dāng)前的方法是個主方法，而且主方法所屬的對象是沒有父類的，那么就不會有下一個方法。由于當(dāng)沒有下個方法時，call-next?會報錯， 因此應(yīng)該經(jīng)常調(diào)用?next-p?試試深淺。像?call-next?，next-p?也是在方法里面單獨地局部定義的。

下面將介紹新宏?defmeth?的使用方法。如果我們只是希望定義?rectangle?對象的?area?方法，我們會說

(setq rectangle (obj))
(defprop height)
(defprop width)
(defmeth (area) rectangle (r)
  (* (height r) (width r)))

現(xiàn)在，一個?rectangle?實例的面積就會由類型中對應(yīng)方法計算得出：

> (let ((myrec (obj rectangle)))
  (setf (height myrec) 2
    (width myrec) 3)
  (area myrec))
6

這里有個復(fù)雜一些的例子，假設(shè)我們?yōu)?filesystem?對象定義了一個?backup?方法：

(setq filesystem (obj))
(defmeth (backup :before) filesystem (fs)
  (format t "Remember to mount the tape.~%"))
(defmeth (backup) filesystem (fs)
  (format t "Oops, deleted all your files.~%")
  'done)
(defmeth (backup :after) filesystem (fs)
  (format t "Well, that was easy.~%"))

正常的調(diào)用次序如下：

> （backup （obj filesystem））
Remember to mount the tape.
Oops， deleted all your files.
Well， that was easy.
DONE

接下來，我們想要知道備份一次會花費多少時間，所以可以定義下面的?around?方法：

(defmeth (backup :around) filesystem (fs)
  (time (call-next)))

現(xiàn)在只要調(diào)用?filesystem?子類的?backup?（除非有更匹配的 around 方法介入），那么我們的around 方法就會執(zhí)行。它會運行平常時候在 backup 里運行的那些代碼，不同之處是把它們放到了一個 time 的調(diào)用里執(zhí)行。time 的返回值則會被作為 backup 方法調(diào)用的值返回。

> (backup (obj filesystem))
Remember to mount the tape.
Oops, deleted all your files.
Well, that was easy.
Elapsed Time = .01 seconds
DONE

一旦知道了備份操作需要的時間，我們就會想要去掉這個around 方法。調(diào)用undefmeth 可達(dá)到這個目的（如[示例代碼 25.8]），它的參數(shù)和defmeth 的前兩個參數(shù)相同：

---

[示例代碼 25.8]?去掉方法

(undefmeth (backup :around) filesystem)

(defmacro undefmeth ((name &optional (type :primary)) obj)
  '(setf (,(symb 'meth- type) (gethash ',name ,obj))
    nil))

---

[示例代碼 25.9]?維護(hù)父類和子類的聯(lián)系

(defmacro children (obj)
  '(gethash 'children ,obj))

(defun parents (obj)
  (gethash 'parents obj))

(defun set-parents (obj pars)
  (dolist (p (parents obj))
    (setf (children p)
      (delete obj (children p))))
  (setf (gethash 'parents obj) pars)
  (dolist (p pars)
    (pushnew obj (children p)))
  (maphier #'(lambda (obj)
      (setf (gethash 'ancestors obj)
        (get-ancestors obj)))
    obj)
  pars)

(defsetf parents set-parents)

(defun maphier (fn obj)
  (funcall fn obj)
  (dolist (c (children obj))
    (maphier fn c)))

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

---

另外一個我們可能需要修改的是對象的父類列表。但是進(jìn)行了這種修改之后，我們還應(yīng)該相應(yīng)地更新該對象以及其所有子類的的祖先列表。到目前為止，還沒有辦法從對象那里獲知它的子類信息，所以我們必須另加一個 children 屬性。

[示例代碼 25.9] 中的代碼被用來操作對象的父類和子類。這里不再用 gethash 來獲得父類和子類信息，而是分別改用操作符 parents 和children。其中后者是個宏，因而它對于 setf 是透明的。前者是一個函數(shù)，它的逆操作被 defsetf 定義為 set-parents ，這個函數(shù)包攬了所有的相關(guān)工作，讓新的雙向鏈接系統(tǒng)能保持其一致性。

為了更新一顆子樹里所有對象的祖先，set-parents 調(diào)用了 maphier ，這個函數(shù)的作用相當(dāng)于繼承樹里的mapc 。mapc 對列表里每個元素運行一個函數(shù)，同樣的，maphier 也會對對象和它所有的后代應(yīng)用指定的函數(shù)。除非這些節(jié)點構(gòu)成沒有公共子節(jié)點的樹，否則有的對象會被傳入這個函數(shù)一次以上。在這里，這不會導(dǎo)致問題，因為調(diào)用多次get-ancestors 和調(diào)用一次的效果是相同的。

現(xiàn)在，要修改繼承層次結(jié)構(gòu)的話，我們只要在對象的 parents 上調(diào)用 setf 就可以了：

> (progn (pop (parents patriotic-scoundrel))
  (serves patriotic-scoundrel))
COUNTRY
T

當(dāng)這個層次結(jié)構(gòu)被修改的時候，受到影響的子孫列表和祖先列表會同時自動地更新。（children 本不是讓人直接修改的，但是這也不是不可以。只要我們定義一個和 set-parents 對應(yīng)的 set-children 就可以了。） 為了配合新代碼，我們在[示例代碼 25.9] 的最后重新定義了 obj 函數(shù)。

這次我們要開發(fā)一個新的手段來組合方法，作為對這個系統(tǒng)的最后一項改進(jìn)?，F(xiàn)在，會被調(diào)用的唯一主方法將是最匹配的那個（雖然它可以用 call-next 來調(diào)用其它的主方法）。要是我們希望能把對象所有祖先的主方法的結(jié)果組合起來呢？比如說，假設(shè) my-orange 是 orange 的子類，而 orange 又是 citrus 的子類。如果props 方法用在 citrus 上的返回值是 （round acidic），相應(yīng)的，orange 的返回值是（orange sweet） ，my-orange 的結(jié)果是（dented）。要是能讓 （props my-orange） 能返回這些值的并集就好辦多了：（dented orange sweet round acidic）。

(defmacro defcomb (name op)
  '(progn
    (defprop ,name t)
    (setf (get ',name 'mcombine)
      ,(case op
        (:standard nil)
        (:progn '#'(lambda (&rest args)
            (car (last args))))
        (t op)))))

(defun run-core-methods (obj name args &optional pri)
  (let ((comb (get name 'mcombine)))
    (if comb
      (if (symbolp comb)
        (funcall (case comb (:and #'comb-and)
            (:or #'comb-or))
          obj name args (ancestors obj))
        (comb-normal comb obj name args))
      (multiple-value-prog1
        (progn (run-befores obj name args)
          (apply (or pri (rget obj name :primary))
            obj args))
        (run-afters obj name args)))))

(defun comb-normal (comb obj name args)
  (apply comb
    (mapcan #'(lambda (a)
        (let* ((pm (meth- primary
                (gethash name a)))
            (val (if pm
                (apply pm obj args))))
          (if val (list val))))
      (ancestors obj))))

[示例代碼 25.10]： 方法的組合

假如能讓方法對所有主方法的返回值應(yīng)用某個函數(shù)，而不是僅僅返回最匹配的那個主函數(shù)的返回值，那就能解決這個問題了。[示例代碼 25.10] 中定義有一個宏，這個宏讓我們能指定方法的組合手段，圖中還定義了新版本的 run-core-methods ，它允許我們把方法組合在一起使用。我們用 defcomb 定義方法的組合形式，它把方法名作為第一個參數(shù)，第二個參數(shù)描述了期望的組合方式。通常，這第二個參數(shù)應(yīng)該是一個函數(shù)。不過，它也可以是 :progn :and :or 和 :standard 中的一個。如果使用前三個，系統(tǒng)就會用相應(yīng)的操作符來組合主方法，用 :standard 的話，就表示我們想用以前的辦法來執(zhí)行方法。

[示例代碼 25.10] 中的核心函數(shù)是新的run-core-methods 。如果被調(diào)用的方法沒有名為mcombine 的屬性，那么一切如常。否則，mcombine 應(yīng)該是個函數(shù)（比如+），或是個關(guān)鍵字（比如：or）。前面一種情況，所有主方法返回值構(gòu)成的列表會被送進(jìn)這個函數(shù)。如果是后者的情況，我們會用和這個關(guān)鍵字對應(yīng)的函數(shù)對主方法一一進(jìn)行操作。

如果代碼寫得更講究一些，可以考慮用 reduce ，這樣可以避免手動 cons。

---

(defun comb-and (obj name args ancs &optional (last t))
  (if (null ancs)
    last
    (let ((pm (meth- primary (gethash name (car ancs)))))
      (if pm
        (let ((new (apply pm obj args)))
          (and new
            (comb-and obj name args (cdr ancs) new)))
        (comb-and obj name args (cdr ancs) last)))))

(defun comb-or (obj name args ancs)
  (and ancs
    (let ((pm (meth- primary (gethash name (car ancs)))))
      (or (and pm (apply pm obj args))
        (comb-or obj name args (cdr ancs))))))

[示例代碼 25.11]： 方法的組合（續(xù)）

---

如[示例代碼 25.11] 所示，and 和 or 這兩個操作符必須要特殊處理。它們被特殊對待的原因不是因為它們是special form，而是因為它們的短路（short-circuit） 求值方式：

> (or 1 (princ "wahoo"))
1

這里，什么都不會被打印出來，因為or 一看到非nil 的參數(shù)就會立即返回。與之類似，如果有一個更匹配的方法返回真的話，那么剩下的用or 組合的主方法將不會被調(diào)用。為了實現(xiàn) and 和 or 的這種短路求值，我們用了兩個專門的函數(shù)：comb-and 和 comb-or。

為了實現(xiàn)我們之前的例子，可以這樣寫：

(setq citrus (obj))
(setq orange (obj citrus))
(setq my-orange (obj orange))

(defmeth (props) citrus (c) '(round acidic))
(defmeth (props) orange (c) '(orange sweet))
(defmeth (props) my-orange (m) '(dented))

(defcomb props #'(lambda (&rest args) (reduce #'union args)))

這樣定義之后，props 就能返回所有主方法返回值的并集了：?

> (props my-orange)
(DENTED ORANGE SWEET ROUND ACIDIC)

這個例子恰巧顯示了一個只有在 Lisp 里用面向?qū)ο缶幊滩艜媾R的選擇：是把信息保存在slot 里，還是保存在方法里。

以后，如果想要 props 方法恢復(fù)到缺省的行為，只要把方法的組合方式改回標(biāo)準(zhǔn)模式（standard） 即可：

> (defcomb props :standard)
NIL
> (props my-orange)
(DENTED)

要注意，before 和 after 方法只是在標(biāo)準(zhǔn)的組合模式下才會有效。而 around 方法會像以前那樣工作。

本節(jié)中展示的程序只是作為一個演示模型，而不是想以它為基礎(chǔ)，進(jìn)行面向?qū)ο缶幊?。寫這個模型的著眼點是簡潔而非效率。不管如何，這至少是一個可以工作的模型，因此也可以被用在試驗性質(zhì)的開發(fā)和原型【注4】由于 props 里用的組合函數(shù)是 union ，因此列表里的元素不一定會按照原來的順序排列。

開發(fā)中。如果你有意這樣用它的話，有一個小改動可以讓它的效率有相當(dāng)?shù)母倪M(jìn)：如果對象只有一個父類的話，就不要計算或者保存它的祖先列表。

25.3 類和實例

上一節(jié)中寫了一個盡可能短小的程序來重新實現(xiàn)?CLOS?。理解它為我們進(jìn)而理解?CLOS?鋪平了道路。在下面幾節(jié)中，我們會仔細(xì)考察?CLOS?本身。

在我們的這個簡單實現(xiàn)里，沒有把類和實例作語法上的區(qū)分，也沒有把 slot 和方法分開。在?CLOS里，我們用defclass 定義類，同時把各slot 組成列表一并聲明：

(defclass circle ()
  (radius center))

這個表達(dá)式的意思是，circle 類沒有父類，但是有兩個slot：radius 和center。我們用下面的語句可以新建一個 circle 類的實例：

(make-instance 'circle)

不幸的是，我們還沒有定義讀取circle 中slot 的方式，因此我們創(chuàng)建的任何實例都只是個擺設(shè)。為了訪問特定的slot，我們需要為它定義一個訪問（accessor） 函數(shù)：

(defclass circle ()
  ((radius :accessor circle-radius)
    (center :accessor circle-center)))

現(xiàn)在，如果我們建立了一個circle 的實例，就可以用setf 和與之對應(yīng)的訪問函數(shù)來設(shè)置它的radius 和center slot：

> (setf (circle-radius (make-instance 'circle)) 2)
2

如果像下面那樣定義slot，那么我們也可以在make-instance 里直接完成這種初始化的工作：

(defclass circle ()
  ((radius :accessor circle-radius :initarg :radius)
    (center :accessor circle-center :initarg :center)))

在slot 定義中出現(xiàn)的 ：initarg 關(guān)鍵字表示：接下來的實參將要在make-instance 中成為一個關(guān)鍵字形參。這個關(guān)鍵字實參的值將會被作為該slot 的初始值：

> (circle-radius (make-instance 'circle
    :radius 2
    :center '(0 . 0)))
2

使用：initform，我們也可以定義一些slot，讓它們能初始化自己。shape 類中的visible

(defclass shape ()
  ((color :accessor shape-color :initarg :color)
    (visible :accessor shape-visible :initarg :visible
      :initform t)))

會缺省地被設(shè)置成t ：

> (shape-visible (make-instance 'shape))
T

如果一個slot 同時具有initarg 和initform，那么當(dāng)initarg 被指定的時候，它享有優(yōu)先權(quán)：

> (shape-visible (make-instance 'shape :visible nil))
NIL

slot 會被實例和子類繼承下來。如果一個類有多個父類，那么它會繼承得到這些父類slot 的并集。因此，如果我們把screen-circle 類同時定義成circle 和shape 兩個類的子類，

(defclass screen-circle (circle shape)
  nil)

那么 screen-circle 會具有四個 slot，每個父類繼承兩個 slot。注意到，一個類并不一定要自己新建一些新的 slot，screen-circle 的意義就在于提供了一個可以實例化的類型，它同時繼承自 circle 和 shape。

以前可以用在 circle 和 shape 實例的那些訪問函數(shù)和 initarg 會對 screen-circle 類型的實例繼續(xù)生效：

> (shape-color (make-instance 'screen-circle
    :color 'red :radius 3))
RED

如果在?defclass?里給?color?指定一個?initform，我們就可以讓所有的?screen-circle?的對應(yīng)slot?都有個缺省值：

(defclass screen-circle (circle shape)
  ((color :initform 'purple)))

這樣，screen-circle?類型的實例在缺省情況下就會是紫色的了：

> (shape-color (make-instance 'screen-circle))
PURPLE

不過我們還是可以通過顯式地指定一個：colorinitarg，來把這個?slot?初始化成其他顏色。

在我們之前實現(xiàn)的簡裝版面向?qū)ο缶幊炭蚣芾铮瑢嵗闹悼梢灾苯訌母割惖膕lot 繼承得到。在?CLOS中， 實例包含 slot 的方式卻和類不一樣。我們通過在父類里定義 initform 來為實例定義可被繼承的缺省值。

在某種程度上，這樣處理更有靈活性。因為initform 不僅可以是一個常量，它還可以是一個每次都返回不同值的表達(dá)式：

(defclass random-dot ()
  ((x :accessor dot-x :initform (random 100))
    (y :accessor dot-y :initform (random 100))))

每創(chuàng)建一個random-dot 實例，它在x 和y 軸上的坐標(biāo)都會是從0 到99 之間的一個隨機(jī)整數(shù)：

> (mapcar #'(lambda (name)
    (let ((rd (make-instance 'random-dot)))
      (list name (dot-x rd) (dot-y rd))))
  '(first second third))
((FIRST 25 8) (SECOND 26 15) (THIRD 75 59))

在我們的簡裝版實現(xiàn)里，我們對兩種slot 不加區(qū)別：一種是實例自己具有的slot，這種slot 實例和實例之間可以不同；另一種slot 應(yīng)該是在整個類里面都相同的。在?CLOS?中，我們可以指定某些slot 是共享的，換句話說，就是讓這些slot 的值在每個實例里都是相同的。為了達(dá)到這個效果，我們可以把slot 聲明成 ：allocation ：class 的。（另一個選項是 ：allocation ：instance。不過由于這是缺省的設(shè)置，因此就沒有必要再顯式地指定了。） 比如說，如果所有的貓頭鷹都是夜間生活的動物，那么我們可以讓nocturnal 這個slot 作為owl 類的共享slot，同時讓它的初始值為t ：

(defclass owl ()
  ((nocturnal :accessor owl-nocturnal
      :initform t
      :allocation :class)))

現(xiàn)在，所有的owl 實例都會繼承這個slot 了：

> (owl-nocturnal (make-instance 'owl))
T

如果我們改動了這個slot 的"局部" 值，那么我們實際上修改的是保存在這個類里面的值：

> (setf (owl-nocturnal (make-instance 'owl)) 'maybe)
MAYBE
> (owl-nocturnal (make-instance 'owl))
MAYBE

這種機(jī)制或許會造成一些困擾，所以我們可能會希望讓這個slot 成為只讀的。在我們?yōu)橐粋€slot 定義訪問函數(shù)的同時，也是在為這個slot 的值定義一個讀和寫的方法。如果我們需要讓這個值可讀，但是不可寫，那么我們可以給這個slot 僅僅設(shè)置一個reader 函數(shù)，而不是全功能的訪問函數(shù)：

(defclass owl ()
  ((nocturnal :reader owl-nocturnal
      :initform t
      :allocation :class)))

現(xiàn)在如果嘗試修改owl 實例的nocturnal slot 的話，就會產(chǎn)生一個錯誤：

> (setf (owl-nocturnal (make-instance 'owl)) nil)
>> Error: The function (SETF OWL-NOCTURNAL) is undefined.

25.4 方法

在我們的簡裝版實現(xiàn)中，強(qiáng)調(diào)了這樣一個思想，即在具有詞法作用域的語言里，其slot 和方法間是有其相似性的。在實現(xiàn)的時候，保存和繼承主方法的方式和對slot 值的處理方式?jīng)]有什么不同。slot 和方法區(qū)別只在于：把一個名字定義成slot，是通過

(defprop area)

把a(bǔ)rea 作為一個函數(shù)實現(xiàn)的，這個函數(shù)得到并返回一個值。而把這個名字定義成一個方法，則是通過

(defprop area t)

把a(bǔ)rea 實現(xiàn)成一個函數(shù)，這個函數(shù)在得到值之后，會funcall 這個值，同時把函數(shù)的參數(shù)傳給它。

在?CLOS?中，實現(xiàn)這個功能的單元仍然被稱為"方法"，同時也可以定義這些方法，讓它們看上去就像類的屬性一樣。這里，我們?yōu)閏ircle 類定義一個名為area 的方法：

(defmethod area ((c circle))
  (* pi (expt (circle-radius c) 2)))

這個方法的參數(shù)列表表示，這是個接受一個參數(shù)的函數(shù)，參數(shù)應(yīng)該是circle 類型的實例。

和簡單實現(xiàn)里一樣，我們像調(diào)用一個函數(shù)那樣調(diào)用這個方法：

> (area (make-instance 'circle :radius 1))
3.14...

我們同樣可以讓方法接受更多的參數(shù)：

(defmethod move ((c circle) dx dy)
  (incf (car (circle-center c)) dx)
  (incf (cdr (circle-center c)) dy)
  (circle-center c))

如果我們對一個circle 的實例調(diào)用這個方法，circle 實例的中心會移動?dx，dy? ：

> (move (make-instance 'circle :center '(1 . 1)) 2 3)
(3 . 4)

方法的返回值表明了圓形的新位置。

和我們的簡裝版實現(xiàn)一樣，如果一個實例對應(yīng)的類及其父類有個方法，那么調(diào)用這個方法會使最匹配的方法被調(diào)用。因此，如果unit-circle 是 circle 的子類，同時具有如下所示的area 方法：

(defmethod area ((c unit-circle)) pi)

那么當(dāng)我們對一個unit-circle 的實例調(diào)用area 方法的時候，將被調(diào)用的不是更一般的那個方法，而是在上面定義area。

當(dāng)一個類有多個父類時，它們的優(yōu)先級從左到右依次降低。patriotic-scoundrel 類的定義如下：

(defclass scoundrel nil nil)
(defclass patriot nil nil)
(defclass patriotic-scoundrel (scoundrel patriot) nil)

我們認(rèn)為愛國的無賴，他首先是一個無賴，然后才是一個愛國者。當(dāng)兩個父類都有合適的方法時，

(defmethod self-or-country? ((s scoundrel))
  'self)

(defmethod self-or-country? ((p patriot))
  'country)

scoundrel 類的方法會這樣被執(zhí)行：

> (self-or-country? (make-instance 'patriotic-scoundrel))
SELF

到目前為止，所以的例子都讓人覺得?CLOS?中的方法只針對某一個類。實際上，?CLOS?中的方法是更為通用的一個概念。在move 方法的參數(shù)列表中，我們稱 （c circle） 為特化（specialized） 參數(shù)，它表示，如果move 的第一個參數(shù)是circle 類的一個實例的話，就適用這個方法。對于?CLOS?方法，不止一個參數(shù)可以被特化。下面的方法就有兩個特化參數(shù)和一個可選的非特化參數(shù)：

(defmethod combine ((ic ice-cream) (top topping)
    &optional (where :here))
  (append (list (name ic) 'ice-cream)
    (list 'with (name top) 'topping)
    (list 'in 'a
      (case where
        (:here 'glass)
        (:to-go 'styrofoam))
      'dish)))

如果combine 的前兩個參數(shù)分別是ice-cream 和topping 的實例的話，上面定義的方法就會被調(diào)用。如果我們定義幾個最簡單類以便構(gòu)造實例

(defclass stuff () ((name :accessor name :initarg :name)))
(defclass ice-cream (stuff) nil)
(defclass topping (stuff) nil)

那么我們就能定義并運行這個方法了：

> (combine (make-instance 'ice-cream :name 'fig)
  (make-instance 'topping :name 'olive)
  :here)
(FIG ICE-CREAM WITH OLIVE TOPPING IN A GLASS DISH)

倘若方法特化了一個以上的參數(shù)，這時就沒有辦法再把方法當(dāng)成類的屬性了。我們的combine 方法是屬于ice-cream 類還是屬于topping 類呢？在?CLOS?里，所謂"對象響應(yīng)消息" 的模型不復(fù)存在。如果我們像下面那樣調(diào)用函數(shù)，這種模型似乎還是順理成章的：

(tell obj 'move 2 3)

顯而易見，在這里我們調(diào)用的是obj 的move 方法。但是一旦我們廢棄這種語法，而改用函數(shù)風(fēng)格的等價操作：

(move obj 2 3)

我們就需要定義move ，讓它能根據(jù)它的第一個參數(shù)dispatch 操作，即按照第一個參數(shù)的類型來調(diào)用適合的方法。

走出這一步，于是有個問題浮出了水面：為什么只能根據(jù)第一個參數(shù)來進(jìn)行dispatch 呢？?CLOS?的回答是：

就是呀，為什么非得這樣呢？在?CLOS?中，方法能夠指定任意個數(shù)的參數(shù)進(jìn)行特化，而且這并不限于用戶自定義的類，Common Lisp 類型?也一樣可以，甚至能針對單個的特定對象特化。下面是一個名為combine 的方法，它被用于字符串：

(defmethod combine ((s1 string) (s2 string) &optional int?)
  (let ((str (concatenate 'string s1 s2)))
    (if int? (intern str) str)))

這不僅意味著方法不再是類的屬性，而且還表明，我們可以根本不用定義類就能使用方法了。

> (combine "I am not a " "cook.")
"I am not a cook."

下面，第二個參數(shù)將對符號palindrome 進(jìn)行特化：

(defmethod combine ((s1 sequence) (x (eql 'palindrome))
    &optional (length :odd))
  (concatenate (type-of s1)
    s1
    (subseq (reverse s1)
      (case length (:odd 1) (:even 0)))))

上面的這個方法能生成任意元素序列的回文：?

> (combine '(able was i ere) 'palindrome)
(ABLE WAS I ERE I WAS ABLE)

到現(xiàn)在，我們講述的內(nèi)容已經(jīng)不僅僅局限于面向?qū)ο蟮姆懂牐兄毡榈囊饬x。?CLOS?在設(shè)計的時候就已經(jīng)認(rèn)識到，在對象方法的背后，更深層次的思想是分派（dispatch） 的概念，即選擇合適方法的依據(jù)可以不僅僅是單獨的一個參數(shù)，還可以基于多個參數(shù)的類型。當(dāng)我們基于這種更通用的表示手段來構(gòu)造方法時， 方法就可以脫離特定的類而存在了。方法不再在邏輯上從屬于類，它現(xiàn)在和其它的同名方法成為了一體。

CLOS?把這樣的一組方法稱為generic 函數(shù)。所有的combine 方法隱式地定義了名為combine 的generic 函數(shù)。

我們可以顯式地用defgeneric 宏定義generic 函數(shù)。雖然沒有必要專門調(diào)用defgeneric 來定義一個generic 函數(shù)，但是這個定義卻是一個安置文檔，或者為一些錯誤加入保護(hù)措施的好地方。我們在下面的定義中兩樣都用上了：

(defgeneric combine (x y &optional z)
  (:method (x y &optional z)
    "I can't combine these arguments.")
  (:documentation "Combines things."))

由于這里為combine 定義的方法沒有特化任何參數(shù)，所以如果沒有其它方法適用的話，這個方法就會被調(diào)用。

> (combine #'expt "chocolate")
"I can't combine these arguments."

倘若沒有顯式定義上面的generic 函數(shù)，這個調(diào)用就會報錯。

?或者更準(zhǔn)確地說，是?CLOS?定義的一系列形似類型的類，這些類的定義和Common Lisp 的內(nèi)建類型體系是平行對應(yīng)的。

?在一個Common Lisp 實現(xiàn)中（否則這個實現(xiàn)就完美了），concatenate 不會接受cons 作為它的第一個參數(shù)，因此這個方法調(diào)用在這種情況下將無法正常工作。

generic 函數(shù)也加入了一個我們把方法當(dāng)成對象屬性時沒有的限制：當(dāng)所有的同名方法加盟一個generic 方法時，這些同名方法的參數(shù)列表必須一致。這就是為什么我們所有的combine 方法都另有一個可選參數(shù)的原因。如果讓第一個定義的combine 方法接受三個參數(shù)，那么當(dāng)我們試著去定義另一個只有兩個參數(shù)的方法時，就會出錯。

CLOS?要求所有同名方法的參數(shù)列表必須是一致的。兩個參數(shù)列表取得一致的前提是：它們必須具有相同數(shù)量的必選參數(shù)，相同數(shù)量的可選參數(shù)，并且&rest 和&key 的使用也要相互兼容。不同方法最后用的關(guān)鍵字參數(shù)（keywordparameter） 可以不一樣，不過defgeneric 會堅持要求讓它的所有方法接受一個特定的最小集。下面每對參數(shù)列表，兩兩之間是相互一致的：

(x) (a)
(x &optional y) (a &optional b)
(x y &rest z) (a b &rest c)
(x y &rest z) (a b &key c d)

而下列的每組都不一致：

(x) (a b)
(x &optional y) (a &optional b c)
(x &optional y) (a &rest b)
(x &key x y) (a)

重新定義方法就像重定義函數(shù)一樣。由于只有必選參數(shù)才能被特化，每個方法都唯一地對應(yīng)著它的generic function 及其必選參數(shù)的類型。如果我們定義另一個有著相同特化參數(shù)的方法，那么新的方法就會覆蓋原來的方法。因而，如果我們這樣寫道：

(defmethod combine ((x string) (y string)
    &optional ignore)
  (concatenate 'string x " + " y))

那么就會重新定義頭兩個參數(shù)都是string 時，combine 方法的行為。

(defmacro undefmethod (name &rest args)
  (if (consp (car args))
    (udm name nil (car args))
    (udm name (list (car args)) (cadr args))))

(defun udm (name qual specs)
  (let ((classes (mapcar #'(lambda (s)
            '(find-class ',s))
          specs)))
    '(remove-method (symbol-function ',name)
      (find-method (symbol-function ',name)
        ',qual
        (list ,@classes)))))

[示例代碼 25.12]： 用于刪除方法的宏

不幸的是，如果我們不希望重新定義方法，而是想刪除它，?CLOS?中并沒有一個內(nèi)建的defmethod 的逆操作。萬幸的是，這是Lisp，所以我們可以自己寫一個。[示例代碼 25.12] 中的undefmethod 記錄了手動刪除一個方法的具體細(xì)節(jié)。就像調(diào)用defmethod 時一樣，我們在使用這個宏的時候，把參數(shù)傳入它，不過不同之處在于，這次我們并沒有把整個的參數(shù)列表作為第二個或者第三個參數(shù)傳進(jìn)去，只是把必選參數(shù)的類名送入這個宏。所以，如果要刪除兩個string 的combine 方法，可以這樣寫：

(undefmethod combine (string string))

沒有特化的參數(shù)被缺省指定為類t ，所以，如果我們之前定義了一個方法，而且這個方法有必選參數(shù)，但是這些參數(shù)沒有特化的話：

(defmethod combine ((fn function) &optional y)
  (funcall fn x y))

我們可以用下面的語句把它去掉

(undefmethod combine (function t))

如果希望刪除整個的genericfunction，那么我們可以用和刪除任意函數(shù)相同的方法來達(dá)到這個目的，即調(diào)用fmakunbound ：

(fmakunbound 'combine)

25.5 輔助方法和組合

在?CLOS?里，輔助函數(shù)還是和我們的精簡版實現(xiàn)一樣的運作。到現(xiàn)在，我們只看到了主方法，但是我們一樣可以用before、 after 和around 方法?？梢酝ㄟ^在方法的名字后面加上限定關(guān)鍵字（qualifyingkeyword），來定義這些輔助函數(shù)。假如我們?yōu)閟peaker 類定義一個主方法speak 如下：

(defclass speaker nil nil)

(defmethod speak ((s speak) string)
  (format t "~A" string)

那么，對一個speaker 的實例調(diào)用speak 方法，就會把方法的第二個參數(shù)打印出來：

> (speak (make-instance 'speaker)
  "life is not what it used to be")
life is not what it used to be
NIL

現(xiàn)在定義一個名為intellectual 的子類，讓它把主方法speak 用before 和 after 方法包裝起來，

(defclass intellectual (speaker) nil)

(defmethod speak :before ((i intellectual) string)
  (princ "Perhaps "))

(defmethod speak :after ((i intellectual) string)
  (princ " in some sense"))

然后，我們就能新建一個speaker 的子類，讓這個子類總是會自己加上最后一個（以及第一個） 詞：

> (speak (make-instance 'intellectual)
  "life is not what it used to be")
Perhaps life is not what it used to be in some sense
NIL

在標(biāo)準(zhǔn)的方法組合方式中，方法調(diào)用的順序和我們精簡版實現(xiàn)中規(guī)定的順序是一樣的：所有的before 方法是從最匹配的開始，然后是最匹配的主方法，接著是 after 方法， after 方法是最匹配的最后才調(diào)用。因此，如果我們像下面這樣為父類speaker 定義before 或者 after 方法，

(defmethod speak :before ((s speaker) string)
  (princ "I think "))

這些方法會在夾心餅干的中間被調(diào)用：

> (speak (make-instance 'intellectual)
  "life is not what it used to be")
Perhaps I think life is not what it used to be in some sense
NIL

無論被調(diào)用的是什么before 或 after 方法，generic 函數(shù)的返回值總是最匹配的主方法的值，在本例中，返回的值就是format 返回的nil 。

如果有around 方法的話，這個論斷就要稍加改動。倘若一個對象的繼承樹中有一個類具有around 方法， 或者更準(zhǔn)確地說，如果有around 方法特化了generic 函數(shù)的某些參數(shù)，那么這個around 方法會被首先調(diào)用， 然后其余的這些方法是否會被運行將取決于這個around 方法。在我們的精簡版實現(xiàn)中，一個around 方法或者主方法能夠通過運行一個函數(shù)，調(diào)用下一個方法：我們以前定義的名為call-next 的函數(shù)在?CLOS?中叫做call-next-method。與我們的next-p 相對應(yīng)，?CLOS?中同樣也有一個叫next-method-p 的函數(shù)。有了around 方法，我們可以定義speaker 的另一個子類，這個子類說話會更慎重一些：

(defclass courtier (speaker) nil)

(defmethod speak :around ((c courtier) st