## 第 25 章 面向對象的 Lisp 本章討論了 Lisp 中的面向對象編程。Common Lisp 提供了一組操作符可供編寫面向對象的程序時使用。 這些操作符和起來，并稱為 Common Lisp Object System，或者叫?**CLOS**?。在這里我們不把?**CLOS**僅僅看作一種編寫面向對象程序的手段，而把它本身就當成一個 Lisp 程序。從這個角度來看待?**CLOS**是理解 Lisp 和面向對象編程之間關系的關鍵。 ### 25.1 萬變不離其宗 面向對象的編程意味著程序組織方式的一次變革。歷史上的另一個變化與這個變革有幾分類似，即發生在處理器計算能力分配方式上的變化。在 1970 年代，多用戶計算機系統指的就是聯接到大量啞終端的一兩個大型機。時至今日，這個詞更有可能說的是大量用網絡互相聯接的工作站。現在，系統的處理能力散布于多個獨立用戶中，而不是集中在一臺大型計算機上。 這與面向對象編程有很大程度上的相似，后者把傳統的程序結構拆分開來：它不再讓單一的程序邏輯去操縱那些被動的數據，而是讓數據自己知道該做些什么，程序邏輯就隱含在這些新的數據 "對象" 間的交互過程之中。 舉例來說，假設我們要算出一個二維圖形的面積。解決這個問題的一個辦法就是寫一個單獨的函數，讓它檢查參數的類型，然后分情況處理： ~~~ (defun area (x) (cond ((rectangle-p x) (* (height x) (width x))) ((circle-p x) (* pi (expt (radius x) 2))))) ~~~ 面向對象的方法則是讓每種對象自己就能夠計算出自身的面積。area 這個函數就被拆開，同時每條語句都被分到對象的對應類型中去，比如rectangle 類可能就會看起來像這樣： ~~~ #'(lambda (x) (* (height x) (width x))) ~~~ 至于 circle 則會是這樣： ~~~ #'(lambda (x) (* pi (expt (radius x) 2))) ~~~ 在這種模式下，我們向對象詢問該對象的面積，然后對象則根據所屬類型所提供的方法來作出回應。 **CLOS**?的到來似乎意味著 Lisp 正在改變自己，以擁抱面向對象的編程方式。與其這樣說，不如改成：Lisp 還在墨守成規，用老樣子來擁抱面向對象編程，這樣還確切一些。不過 Lisp 中的那些基本概念沒有名字，面向對象編程卻有，所以時下有種趨勢要把 Lisp 算成面向對象的語言。另一種說法：Lisp 是一門可擴展的語言，在這種語言里，面向對象編程的機制和結構可以輕松實現，這種說法恐怕更接近真相。 由于?**CLOS**?是原來就有的，所以把 Lisp 說成面向對象的編程語言并沒有誤導。然而，如果就這樣看待 Lisp 未免太小覷它了。誠然，Lisp 是一種面向對象的編程語言，但是原因并不是它采納了面向對象的編程模式。 事實在于，這種編程模式只是 Lisp 的抽象系統提供的又一種可能性而已。為了證明這種可能性，我們有了?**CLOS**?一個Lisp 程序，它讓Lisp 成為了一門面向對象的語言。 本章的主旨在于：通過把?**CLOS**?作為一個嵌入式語言的實例來研究，進而揭示 Lisp 和面向對象編程之間的聯系。這同時也是了解?**CLOS**?本身的一個很好的手段，要學習一個編程語言的特性，沒什么方法能比了解這個特性的實現更有效的了。在第 7.6 節，那些宏就是用這種方式來講解的。下一節將會有一個類似的對面向對象抽象是如何建立在 Lisp 之上的一個粗略的介紹。其中提到的程序將被第 25.3 節到第 25.5 節作為一個基準實現來參考。 ### 25.2 陽春版 Lisp 中的對象 我們可以用 Lisp 來模擬各種各樣不同種類的語言。有一種特別直接的辦法可以把面向對象編程的理念對應到Lisp 的基本抽象機制上。不過，?**CLOS**?的龐大規模讓我們難以認清這個事實。因此，在我們開始了解?**CLOS**?能讓我們做什么之前，不妨先看看我們用最原始的Lisp 都能干些什么。 我們在面向對象編程中想要的大多數特性，其實在Lisp 里面已經有了。我們可以用少得出奇的代碼來得 到剩下的那部分。在本節中，我們將會用兩頁紙的代碼實現一個對象系統，這個系統對于相當多真實的應 用已經夠用了。面向對象編程，簡而言之，就是： 1. 具有屬性的對象 2. 它能對各種消息作出反應， 3. 而且對象能從它的父對象繼承相應的屬性和方法。 在 Lisp 里面已經有好幾種存放成組屬性的方法。其中一種就是把對象實現成哈希表，把對象的屬性作為哈希表里的表項。這樣我們就可以用 gethash 來訪問指定的屬性： ~~~ (gethash 'color obj) ~~~ 由于函數是數據對象，我們同樣可以把它們當作屬性保存起來。這就是說，我們的對象系統也可以有方法了，要調用對象的特定方法就 funcall 一下哈希表里的同名屬性： ~~~ (funcall (gethash 'move obj) obj 10) ~~~ 據此，我們可以定義一種 Smalltalk 風格的消息傳遞語法： ~~~ (defun tell (obj message &rest args) (apply (gethash message obj) obj args)) ~~~ 這樣的話，要告訴 (tell) obj 移動 10 個單位，就可以說 ~~~ (tell obj 'move 10) ~~~ 事實上，陽春版 Lisp 唯一缺少的要素就是繼承機制，不過我們可以用六行代碼來實現一個初步的版本，這個版本用一個遞歸版的 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) ~~~ 到現在為止，我們只是有了單繼承 即一個對象只能有一個父類。不過我們可以把 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)))))) ~~~ * * * 在單繼承體系里面，當我們需要得到對象的某個屬性時，只需要遞歸地在對象的祖先中向上搜索。如果在對象本身里面沒有我們想要的屬性信息時，就檢查它的父類，如此這般直到找到。在多繼承體系里，我們一樣會需要做這樣的搜索，但是這次的搜索會有點復雜，因為對象的多個祖先會構成一個圖，而不再只是個簡單列表了。我們不能用深度優先來搜索這個圖。如果允許有多個父類，我們有如 [示例代碼 25.2] 中所示的繼承樹： a 繼承自 b 和 c ，而 b 和 c 均繼承于 d 。深度優先（或叫高度優先） 的遍歷會依次走過 a、b、|d|、c 和d 。倘若想要的屬性同時存在于在 d 和 c 里，那么我們將會得到 d 中的屬性，而非 c 中的。這種情況會違反一個原則：即子類應當會覆蓋基類中提供的缺省值。 ~~~ d b c a ~~~ [示例代碼 25.2]： 到同一基類的多條路徑 如果需要實現繼承系統的基本理念，我們就絕不能在檢查一個對象的子類之前，提前檢查該對象。在本例中，正確的搜索順序應該是a、b、c、d 。那怎么樣才能保證搜索的順序是先嘗試子孫再祖先呢？最簡單的辦法是構造一個列表，列表由原始對象的所有祖先構成，然后對列表排序，讓列表中沒有一個對象出現在它的子孫之前，最后再依次查看每個元素。 get-ancestors 采用了這種策略，它會返回一個按照上面規則排序的列表，列表中的元素是對象和它的祖先們。為了避免在排序時把同一層次的祖先順序打亂，get-ancestors 使用的是 stable-sort 而非 sort。 一旦排序完畢，rget 只要找到第一個具有期望屬性的對象就可以了。（實用工具 some2 是 some 的一個修改版，它能適用于 gethash 這類用第二個返回值表示成功或失敗的函數。） 對象的祖先列表中元素的順序是先從最具體的開始，最后到最一般的類型。如果 orange 是citrus 的子類型，后者又是 fruit 的子類型，那么列表的順序就會像這樣：（orange citrus fruit）。 倘若有個對象，它具有多個父類，那么這些前輩的座次會是從左到右排列的。也就是，如果我們說 ~~~ (setf (gethash 'parents x) (list y z)) ~~~ 那么當我們在搜索一個繼承得來的屬性時，y 就會優先于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 ~~~ 現在讓我們對這個簡陋的系統加以改進。可以從對象創建函數著手。這個函數將會在新建對象時，構造一個該對象祖先的列表。雖然當前的版本是在進行查詢的時候構造這種表的，但是我們沒有理由不把這件事情提前完成。[示例代碼 25.3] 中定義了一個名為 obj 的函數，這個函數被用于生成新的對象，對象的祖先列表被保存在對象本身里。為了用上保存的祖先列表，我們同時重新定義了 rget 。 * * * **[示例代碼 25.3] 用來新建對象的函數** ~~~ (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))) ~~~ * * * 另一個可以改進的地方是消息調用的語法。tell 本身是多余的東西，并且由于它的原因，動詞被排到了第二位。這意味著我們的程序讀起來不再像是熟悉的Lisp 前綴表達式了： ~~~ (tell (tell obj 'find-owner) 'find-owner) ~~~ 我們可以通過把每個屬性定義成函數來去掉tell 這種語法，如[示例代碼 25.4] 所示。可選參數meth? 的值如果是真的話，那表示這個屬性應該被當作方法來處理，否則它應該被當成一個slot，并徑直返回rget 所取到的值。一旦我們把這兩種屬性中任一種，像這樣定義好了： ~~~ (defprop find-owner t) ~~~ 我們就可以用函數調用的方式來引用它，同時代碼讀起來又有 Lisp 的樣子了： * * * **[示例代碼 25.4] 函數式的語法** ~~~ (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)))) ~~~ * * * 現在，原先的例子也變得更有可讀性了： ~~~ > (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 ~~~ 在當前的實現里，對象中每個名字最多對應一個方法。這個方法要么是對象自己的，要么是通過繼承得來的。要是能在這個問題上有更多的靈活性，允許把本地的方法和繼承來的方法組合起來，那肯定會方便很多。比如說，我們會希望某個對象的 move 方法沿用其父類的 move 方法，但是除此之外還要在調用之前或者之后運行一些其它的代碼。 為了讓這個設想變成現實，我們將修改程序，加上 before、 after 和around 方法。before 方法讓我們能吩咐程序，"先別急，把這事做完再說"。這些方法會在該方法中其余部分運行前，作為前奏，被先行調用。 after 方法讓我們可以要求程序說，"還有，把這事也給辦了"。而這些方法會作為收場在最后調用。在兩者之間，我們會執行曾經自己就是整個方法的函數，現在被稱為主方法（primarymethod）。它的返回值將被作為整個方法的返回值，即使 after 方法在其后調用。 before 和 after 方法讓我們能用新的行為把主方法包起來。around 方法則以一種更奇妙的方法實現了這個功能。如果存在around 方法，那么被調用的就不再是主方法，而是around 方法。并且，around 方法有辦法調用主方法（用call-next ，該函數在[示例代碼 25.7] 中提供），至于調不調則是它的自由。 如[示例代碼 25.5] 和[示例代碼 25.6] 所示，為了讓這些輔助的方法生效，我們對run-methods 和rget 加以了改進。在之前的版本里，當我們調用對象的某個方法時，運行的僅是一個函數：即最匹配的那個主函數。我們將會運行搜索祖先列表時找到的第一個方法。加上輔助方法的支持，調用的順序將變成這樣： 1. 倘若有的話，先是最匹配的around 方法 2. 否則的話，依次是： (a) 所有的before 方法,從最匹配的到最不匹配的。 (b) 最匹配的主方法(這是我們以前會調用的)。 (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]： 輔助的方法（續） 同時也注意到，方法不再作為單個的函數出現，它成了有四個成員的結構。現在要定義一個（主） 方法，不能再像這樣說了： ~~~ (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] 定義的就是這樣的一個宏。代碼中有很大篇幅被用來實現兩個函數，這兩個函數讓方法能引用其它的方法。`around`?和主方法可以使用?`call-next`?來調用下一個方法，所謂下一個方法，指的是倘若當前方法不存在，就會被調用的方法。舉個例子，如果當前運行的方法是唯一的一個`around`?方法，那么下一個方法就是常見的由?`before`?方法、最匹配的主方法和?`after`?方法三者合體而成的夾心餅干。在最匹配的主方法里， 下一個方法則會是第二匹配的主方法。由于?`call-next`的行為取決于它被調用的地方，因此?`call-next`?絕對不會用一個?`defun`?來在全局定義，不過它可以在每個由?`defmeth`?定義的方法里局部定義。 around 方法或者主方法可以用?`next-p`?來獲知下一個方法是否存在。如果當前的方法是個主方法，而且主方法所屬的對象是沒有父類的，那么就不會有下一個方法。由于當沒有下個方法時，`call-next`?會報錯， 因此應該經常調用?`next-p`?試試深淺。像?`call-next`?，`next-p`?也是在方法里面單獨地局部定義的。 下面將介紹新宏?`defmeth`?的使用方法。如果我們只是希望定義?`rectangle`?對象的?`area`?方法，我們會說 ~~~ (setq rectangle (obj)) (defprop height) (defprop width) (defmeth (area) rectangle (r) (* (height r) (width r))) ~~~ 現在，一個?`rectangle`?實例的面積就會由類型中對應方法計算得出： ~~~ > (let ((myrec (obj rectangle))) (setf (height myrec) 2 (width myrec) 3) (area myrec)) 6 ~~~ 這里有個復雜一些的例子，假設我們為?`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.~%")) ~~~ 正常的調用次序如下： ~~~ > （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))) ~~~ 現在只要調用?`filesystem`?子類的?`backup`?（除非有更匹配的 around 方法介入），那么我們的around 方法就會執行。它會運行平常時候在 backup 里運行的那些代碼，不同之處是把它們放到了一個 time 的調用里執行。time 的返回值則會被作為 backup 方法調用的值返回。 ~~~ > (backup (obj filesystem)) Remember to mount the tape. Oops, deleted all your files. Well, that was easy. Elapsed Time = .01 seconds DONE ~~~ 一旦知道了備份操作需要的時間，我們就會想要去掉這個around 方法。調用undefmeth 可達到這個目的（如[示例代碼 25.8]），它的參數和defmeth 的前兩個參數相同： * * * **[示例代碼 25.8]**?去掉方法 ~~~ (undefmeth (backup :around) filesystem) (defmacro undefmeth ((name &optional (type :primary)) obj) '(setf (,(symb 'meth- type) (gethash ',name ,obj)) nil)) ~~~ * * * **[示例代碼 25.9]**?維護父類和子類的聯系 ~~~ (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)) ~~~ * * * 另外一個我們可能需要修改的是對象的父類列表。但是進行了這種修改之后，我們還應該相應地更新該對象以及其所有子類的的祖先列表。到目前為止，還沒有辦法從對象那里獲知它的子類信息，所以我們必須另加一個 children 屬性。 [示例代碼 25.9] 中的代碼被用來操作對象的父類和子類。這里不再用 gethash 來獲得父類和子類信息，而是分別改用操作符 parents 和children。其中后者是個宏，因而它對于 setf 是透明的。前者是一個函數，它的逆操作被 defsetf 定義為 set-parents ，這個函數包攬了所有的相關工作，讓新的雙向鏈接系統能保持其一致性。 為了更新一顆子樹里所有對象的祖先，set-parents 調用了 maphier ，這個函數的作用相當于繼承樹里的mapc 。mapc 對列表里每個元素運行一個函數，同樣的，maphier 也會對對象和它所有的后代應用指定的函數。除非這些節點構成沒有公共子節點的樹，否則有的對象會被傳入這個函數一次以上。在這里，這不會導致問題，因為調用多次get-ancestors 和調用一次的效果是相同的。 現在，要修改繼承層次結構的話，我們只要在對象的 parents 上調用 setf 就可以了： ~~~ > (progn (pop (parents patriotic-scoundrel)) (serves patriotic-scoundrel)) COUNTRY T ~~~ 當這個層次結構被修改的時候，受到影響的子孫列表和祖先列表會同時自動地更新。（children 本不是讓人直接修改的，但是這也不是不可以。只要我們定義一個和 set-parents 對應的 set-children 就可以了。） 為了配合新代碼，我們在[示例代碼 25.9] 的最后重新定義了 obj 函數。 這次我們要開發一個新的手段來組合方法，作為對這個系統的最后一項改進。現在，會被調用的唯一主方法將是最匹配的那個（雖然它可以用 call-next 來調用其它的主方法）。要是我們希望能把對象所有祖先的主方法的結果組合起來呢？比如說，假設 my-orange 是 orange 的子類，而 orange 又是 citrus 的子類。如果props 方法用在 citrus 上的返回值是 （round acidic），相應的，orange 的返回值是（orange sweet） ，my-orange 的結果是（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]： 方法的組合 假如能讓方法對所有主方法的返回值應用某個函數，而不是僅僅返回最匹配的那個主函數的返回值，那就能解決這個問題了。[示例代碼 25.10] 中定義有一個宏，這個宏讓我們能指定方法的組合手段，圖中還定義了新版本的 run-core-methods ，它允許我們把方法組合在一起使用。我們用 defcomb 定義方法的組合形式，它把方法名作為第一個參數，第二個參數描述了期望的組合方式。通常，這第二個參數應該是一個函數。不過，它也可以是 :progn :and :or 和 :standard 中的一個。如果使用前三個，系統就會用相應的操作符來組合主方法，用 :standard 的話，就表示我們想用以前的辦法來執行方法。 [示例代碼 25.10] 中的核心函數是新的run-core-methods 。如果被調用的方法沒有名為mcombine 的屬性，那么一切如常。否則，mcombine 應該是個函數（比如+），或是個關鍵字（比如：or）。前面一種情況，所有主方法返回值構成的列表會被送進這個函數。如果是后者的情況，我們會用和這個關鍵字對應的函數對主方法一一進行操作。 如果代碼寫得更講究一些，可以考慮用 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]： 方法的組合（續） * * * 如[示例代碼 25.11] 所示，and 和 or 這兩個操作符必須要特殊處理。它們被特殊對待的原因不是因為它們是special form，而是因為它們的短路（short-circuit） 求值方式： ~~~ > (or 1 (princ "wahoo")) 1 ~~~ 這里，什么都不會被打印出來，因為or 一看到非nil 的參數就會立即返回。與之類似，如果有一個更匹配的方法返回真的話，那么剩下的用or 組合的主方法將不會被調用。為了實現 and 和 or 的這種短路求值，我們用了兩個專門的函數：comb-and 和 comb-or。 為了實現我們之前的例子，可以這樣寫： ~~~ (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 里用面向對象編程才會面臨的選擇：是把信息保存在slot 里，還是保存在方法里。 以后，如果想要 props 方法恢復到缺省的行為，只要把方法的組合方式改回標準模式（standard） 即可： ~~~ > (defcomb props :standard) NIL > (props my-orange) (DENTED) ~~~ 要注意，before 和 after 方法只是在標準的組合模式下才會有效。而 around 方法會像以前那樣工作。 本節中展示的程序只是作為一個演示模型，而不是想以它為基礎，進行面向對象編程。寫這個模型的著眼點是簡潔而非效率。不管如何，這至少是一個可以工作的模型，因此也可以被用在試驗性質的開發和原型【注4】由于 props 里用的組合函數是 union ，因此列表里的元素不一定會按照原來的順序排列。 開發中。如果你有意這樣用它的話，有一個小改動可以讓它的效率有相當的改進：如果對象只有一個父類的話，就不要計算或者保存它的祖先列表。 ### 25.3 類和實例 上一節中寫了一個盡可能短小的程序來重新實現?**CLOS**?。理解它為我們進而理解?**CLOS**?鋪平了道路。在下面幾節中，我們會仔細考察?**CLOS**?本身。 在我們的這個簡單實現里，沒有把類和實例作語法上的區分，也沒有把 slot 和方法分開。在?**CLOS**里，我們用defclass 定義類，同時把各slot 組成列表一并聲明： ~~~ (defclass circle () (radius center)) ~~~ 這個表達式的意思是，circle 類沒有父類，但是有兩個slot：radius 和center。我們用下面的語句可以新建一個 circle 類的實例： ~~~ (make-instance 'circle) ~~~ 不幸的是，我們還沒有定義讀取circle 中slot 的方式，因此我們創建的任何實例都只是個擺設。為了訪問特定的slot，我們需要為它定義一個訪問（accessor） 函數： ~~~ (defclass circle () ((radius :accessor circle-radius) (center :accessor circle-center))) ~~~ 現在，如果我們建立了一個circle 的實例，就可以用setf 和與之對應的訪問函數來設置它的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 定義中出現的 ：initarg 關鍵字表示：接下來的實參將要在make-instance 中成為一個關鍵字形參。這個關鍵字實參的值將會被作為該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))) ~~~ 會缺省地被設置成t ： ~~~ > (shape-visible (make-instance 'shape)) T ~~~ 如果一個slot 同時具有initarg 和initform，那么當initarg 被指定的時候，它享有優先權： ~~~ > (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 實例的那些訪問函數和 initarg 會對 screen-circle 類型的實例繼續生效： ~~~ > (shape-color (make-instance 'screen-circle :color 'red :radius 3)) RED ~~~ 如果在?`defclass`?里給?`color`?指定一個?`initform`，我們就可以讓所有的?`screen-circle`?的對應`slot`?都有個缺省值： ~~~ (defclass screen-circle (circle shape) ((color :initform 'purple))) ~~~ 這樣，`screen-circle`?類型的實例在缺省情況下就會是紫色的了： ~~~ > (shape-color (make-instance 'screen-circle)) PURPLE ~~~ 不過我們還是可以通過顯式地指定一個：`colorinitarg`，來把這個?`slot`?初始化成其他顏色。 在我們之前實現的簡裝版面向對象編程框架里，實例的值可以直接從父類的slot 繼承得到。在?**CLOS**中， 實例包含 slot 的方式卻和類不一樣。我們通過在父類里定義 initform 來為實例定義可被繼承的缺省值。 在某種程度上，這樣處理更有靈活性。因為initform 不僅可以是一個常量，它還可以是一個每次都返回不同值的表達式： ~~~ (defclass random-dot () ((x :accessor dot-x :initform (random 100)) (y :accessor dot-y :initform (random 100)))) ~~~ 每創建一個random-dot 實例，它在x 和y 軸上的坐標都會是從0 到99 之間的一個隨機整數： ~~~ > (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)) ~~~ 在我們的簡裝版實現里，我們對兩種slot 不加區別：一種是實例自己具有的slot，這種slot 實例和實例之間可以不同；另一種slot 應該是在整個類里面都相同的。在?**CLOS**?中，我們可以指定某些slot 是共享的，換句話說，就是讓這些slot 的值在每個實例里都是相同的。為了達到這個效果，我們可以把slot 聲明成 ：allocation ：class 的。（另一個選項是 ：allocation ：instance。不過由于這是缺省的設置，因此就沒有必要再顯式地指定了。） 比如說，如果所有的貓頭鷹都是夜間生活的動物，那么我們可以讓nocturnal 這個slot 作為owl 類的共享slot，同時讓它的初始值為t ： ~~~ (defclass owl () ((nocturnal :accessor owl-nocturnal :initform t :allocation :class))) ~~~ 現在，所有的owl 實例都會繼承這個slot 了： ~~~ > (owl-nocturnal (make-instance 'owl)) T ~~~ 如果我們改動了這個slot 的"局部" 值，那么我們實際上修改的是保存在這個類里面的值： ~~~ > (setf (owl-nocturnal (make-instance 'owl)) 'maybe) MAYBE > (owl-nocturnal (make-instance 'owl)) MAYBE ~~~ 這種機制或許會造成一些困擾，所以我們可能會希望讓這個slot 成為只讀的。在我們為一個slot 定義訪問函數的同時，也是在為這個slot 的值定義一個讀和寫的方法。如果我們需要讓這個值可讀，但是不可寫，那么我們可以給這個slot 僅僅設置一個reader 函數，而不是全功能的訪問函數： ~~~ (defclass owl () ((nocturnal :reader owl-nocturnal :initform t :allocation :class))) ~~~ 現在如果嘗試修改owl 實例的nocturnal slot 的話，就會產生一個錯誤： ~~~ > (setf (owl-nocturnal (make-instance 'owl)) nil) >> Error: The function (SETF OWL-NOCTURNAL) is undefined. ~~~ ### 25.4 方法 在我們的簡裝版實現中，強調了這樣一個思想，即在具有詞法作用域的語言里，其slot 和方法間是有其相似性的。在實現的時候，保存和繼承主方法的方式和對slot 值的處理方式沒有什么不同。slot 和方法區別只在于：把一個名字定義成slot，是通過 ~~~ (defprop area) ~~~ 把area 作為一個函數實現的，這個函數得到并返回一個值。而把這個名字定義成一個方法，則是通過 ~~~ (defprop area t) ~~~ 把area 實現成一個函數，這個函數在得到值之后，會funcall 這個值，同時把函數的參數傳給它。 在?**CLOS**?中，實現這個功能的單元仍然被稱為"方法"，同時也可以定義這些方法，讓它們看上去就像類的屬性一樣。這里，我們為circle 類定義一個名為area 的方法： ~~~ (defmethod area ((c circle)) (* pi (expt (circle-radius c) 2))) ~~~ 這個方法的參數列表表示，這是個接受一個參數的函數，參數應該是circle 類型的實例。 和簡單實現里一樣，我們像調用一個函數那樣調用這個方法： ~~~ > (area (make-instance 'circle :radius 1)) 3.14... ~~~ 我們同樣可以讓方法接受更多的參數： ~~~ (defmethod move ((c circle) dx dy) (incf (car (circle-center c)) dx) (incf (cdr (circle-center c)) dy) (circle-center c)) ~~~ 如果我們對一個circle 的實例調用這個方法，circle 實例的中心會移動?dx，dy? ： ~~~ > (move (make-instance 'circle :center '(1 . 1)) 2 3) (3 . 4) ~~~ 方法的返回值表明了圓形的新位置。 和我們的簡裝版實現一樣，如果一個實例對應的類及其父類有個方法，那么調用這個方法會使最匹配的方法被調用。因此，如果unit-circle 是 circle 的子類，同時具有如下所示的area 方法： ~~~ (defmethod area ((c unit-circle)) pi) ~~~ 那么當我們對一個unit-circle 的實例調用area 方法的時候，將被調用的不是更一般的那個方法，而是在上面定義area。 當一個類有多個父類時，它們的優先級從左到右依次降低。patriotic-scoundrel 類的定義如下： ~~~ (defclass scoundrel nil nil) (defclass patriot nil nil) (defclass patriotic-scoundrel (scoundrel patriot) nil) ~~~ 我們認為愛國的無賴，他首先是一個無賴，然后才是一個愛國者。當兩個父類都有合適的方法時， ~~~ (defmethod self-or-country? ((s scoundrel)) 'self) (defmethod self-or-country? ((p patriot)) 'country) ~~~ scoundrel 類的方法會這樣被執行： ~~~ > (self-or-country? (make-instance 'patriotic-scoundrel)) SELF ~~~ 到目前為止，所以的例子都讓人覺得?**CLOS**?中的方法只針對某一個類。實際上，?**CLOS**?中的方法是更為通用的一個概念。在move 方法的參數列表中，我們稱 （c circle） 為特化（specialized） 參數，它表示，如果move 的第一個參數是circle 類的一個實例的話，就適用這個方法。對于?**CLOS**?方法，不止一個參數可以被特化。下面的方法就有兩個特化參數和一個可選的非特化參數： ~~~ (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 的前兩個參數分別是ice-cream 和topping 的實例的話，上面定義的方法就會被調用。如果我們定義幾個最簡單類以便構造實例 ~~~ (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) ~~~ 倘若方法特化了一個以上的參數，這時就沒有辦法再把方法當成類的屬性了。我們的combine 方法是屬于ice-cream 類還是屬于topping 類呢？在?**CLOS**?里，所謂"對象響應消息" 的模型不復存在。如果我們像下面那樣調用函數，這種模型似乎還是順理成章的： ~~~ (tell obj 'move 2 3) ~~~ 顯而易見，在這里我們調用的是obj 的move 方法。但是一旦我們廢棄這種語法，而改用函數風格的等價操作： ~~~ (move obj 2 3) ~~~ 我們就需要定義move ，讓它能根據它的第一個參數dispatch 操作，即按照第一個參數的類型來調用適合的方法。 走出這一步，于是有個問題浮出了水面：為什么只能根據第一個參數來進行dispatch 呢？?**CLOS**?的回答是： 就是呀，為什么非得這樣呢？在?**CLOS**?中，方法能夠指定任意個數的參數進行特化，而且這并不限于用戶自定義的類，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." ~~~ 下面，第二個參數將對符號palindrome 進行特化： ~~~ (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) ~~~ 到現在，我們講述的內容已經不僅僅局限于面向對象的范疇，它有著更普遍的意義。?**CLOS**?在設計的時候就已經認識到，在對象方法的背后，更深層次的思想是分派（dispatch） 的概念，即選擇合適方法的依據可以不僅僅是單獨的一個參數，還可以基于多個參數的類型。當我們基于這種更通用的表示手段來構造方法時， 方法就可以脫離特定的類而存在了。方法不再在邏輯上從屬于類，它現在和其它的同名方法成為了一體。 **CLOS**?把這樣的一組方法稱為generic 函數。所有的combine 方法隱式地定義了名為combine 的generic 函數。 我們可以顯式地用defgeneric 宏定義generic 函數。雖然沒有必要專門調用defgeneric 來定義一個generic 函數，但是這個定義卻是一個安置文檔，或者為一些錯誤加入保護措施的好地方。我們在下面的定義中兩樣都用上了： ~~~ (defgeneric combine (x y &optional z) (:method (x y &optional z) "I can't combine these arguments.") (:documentation "Combines things.")) ~~~ 由于這里為combine 定義的方法沒有特化任何參數，所以如果沒有其它方法適用的話，這個方法就會被調用。 ~~~ > (combine #'expt "chocolate") "I can't combine these arguments." ~~~ 倘若沒有顯式定義上面的generic 函數，這個調用就會報錯。 ?或者更準確地說，是?**CLOS**?定義的一系列形似類型的類，這些類的定義和Common Lisp 的內建類型體系是平行對應的。 ?在一個Common Lisp 實現中（否則這個實現就完美了），concatenate 不會接受cons 作為它的第一個參數，因此這個方法調用在這種情況下將無法正常工作。 generic 函數也加入了一個我們把方法當成對象屬性時沒有的限制：當所有的同名方法加盟一個generic 方法時，這些同名方法的參數列表必須一致。這就是為什么我們所有的combine 方法都另有一個可選參數的原因。如果讓第一個定義的combine 方法接受三個參數，那么當我們試著去定義另一個只有兩個參數的方法時，就會出錯。 **CLOS**?要求所有同名方法的參數列表必須是一致的。兩個參數列表取得一致的前提是：它們必須具有相同數量的必選參數，相同數量的可選參數，并且&rest 和&key 的使用也要相互兼容。不同方法最后用的關鍵字參數（keywordparameter） 可以不一樣，不過defgeneric 會堅持要求讓它的所有方法接受一個特定的最小集。下面每對參數列表，兩兩之間是相互一致的： ~~~ (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) ~~~ 重新定義方法就像重定義函數一樣。由于只有必選參數才能被特化，每個方法都唯一地對應著它的generic function 及其必選參數的類型。如果我們定義另一個有著相同特化參數的方法，那么新的方法就會覆蓋原來的方法。因而，如果我們這樣寫道： ~~~ (defmethod combine ((x string) (y string) &optional ignore) (concatenate 'string x " + " y)) ~~~ 那么就會重新定義頭兩個參數都是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**?中并沒有一個內建的defmethod 的逆操作。萬幸的是，這是Lisp，所以我們可以自己寫一個。[示例代碼 25.12] 中的undefmethod 記錄了手動刪除一個方法的具體細節。就像調用defmethod 時一樣，我們在使用這個宏的時候，把參數傳入它，不過不同之處在于，這次我們并沒有把整個的參數列表作為第二個或者第三個參數傳進去，只是把必選參數的類名送入這個宏。所以，如果要刪除兩個string 的combine 方法，可以這樣寫： ~~~ (undefmethod combine (string string)) ~~~ 沒有特化的參數被缺省指定為類t ，所以，如果我們之前定義了一個方法，而且這個方法有必選參數，但是這些參數沒有特化的話： ~~~ (defmethod combine ((fn function) &optional y) (funcall fn x y)) ~~~ 我們可以用下面的語句把它去掉 ~~~ (undefmethod combine (function t)) ~~~ 如果希望刪除整個的genericfunction，那么我們可以用和刪除任意函數相同的方法來達到這個目的，即調用fmakunbound ： ~~~ (fmakunbound 'combine) ~~~ ### 25.5 輔助方法和組合 在?**CLOS**?里，輔助函數還是和我們的精簡版實現一樣的運作。到現在，我們只看到了主方法，但是我們一樣可以用before、 after 和around 方法。可以通過在方法的名字后面加上限定關鍵字（qualifyingkeyword），來定義這些輔助函數。假如我們為speaker 類定義一個主方法speak 如下： ~~~ (defclass speaker nil nil) (defmethod speak ((s speak) string) (format t "~A" string) ~~~ 那么，對一個speaker 的實例調用speak 方法，就會把方法的第二個參數打印出來： ~~~ > (speak (make-instance 'speaker) "life is not what it used to be") life is not what it used to be NIL ~~~ 現在定義一個名為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 ~~~ 在標準的方法組合方式中，方法調用的順序和我們精簡版實現中規定的順序是一樣的：所有的before 方法是從最匹配的開始，然后是最匹配的主方法，接著是 after 方法， after 方法是最匹配的最后才調用。因此，如果我們像下面這樣為父類speaker 定義before 或者 after 方法， ~~~ (defmethod speak :before ((s speaker) string) (princ "I think ")) ~~~ 這些方法會在夾心餅干的中間被調用： ~~~ > (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 ~~~ 無論被調用的是什么before 或 after 方法，generic 函數的返回值總是最匹配的主方法的值，在本例中，返回的值就是format 返回的nil 。 如果有around 方法的話，這個論斷就要稍加改動。倘若一個對象的繼承樹中有一個類具有around 方法， 或者更準確地說，如果有around 方法特化了generic 函數的某些參數，那么這個around 方法會被首先調用， 然后其余的這些方法是否會被運行將取決于這個around 方法。在我們的精簡版實現中，一個around 方法或者主方法能夠通過運行一個函數，調用下一個方法：我們以前定義的名為call-next 的函數在?**CLOS**?中叫做call-next-method。與我們的next-p 相對應，?**CLOS**?中同樣也有一個叫next-method-p 的函數。有了around 方法，我們可以定義speaker 的另一個子類，這個子類說話會更慎重一些： ~~~ (defclass courtier (speaker) nil) (defmethod speak :around ((c courtier) string) (format t "Does the King believe that ~A? " string) (if (eq (read) 'yes) (if (next-method-p) (call-next-method)) (format t "Indeed, it is a preposterous idea.~%")) 'bow) ~~~ 當speak 的第一個參數是個courtier 實例時，這個around 方法會幫弄臣把話說得更四平八穩： ~~~ > (speak (make-instance 'courtier) "kings will last") Does the King believe that kings will last? yes I think kings will last BOW > (speak (make-instance 'courtier) "the world is round") Does the King believe that the world is round? no Indeed, it is a preposterous idea. BOW ~~~ 可以注意到，和 before 和 after 方法不同，around 方法的返回值被作為 generic 函數的返回值返回了。 一般來說，方法調用的順序如下所列，這些內容是從第 25.2 節里摘抄下來的： 1. 倘若有的話，先是最匹配的 around 方法 2. 否則的話，依次是： (a) 所有的before 方法,從最匹配的到最不匹配的。 (b) 最匹配的主方法(這是我們以前會調用的)。 (c) 所有的 after 方法,從最不匹配的到最匹配的。 這種組合方法的方式被稱為標準的方法組合。和我們之前的簡裝版一樣，這里一樣有辦法以其它的方式組合方法。比如說，讓一個 generic 函數返回所有可用的主方法返回值之和。 在我們的程序里，我們通過調用 defcomb 來指定組合方法的方式。缺省情況下，方法是以上面列出的規則調用的，不過如果我們像這樣寫的話： ~~~ (defcomb price #'+) ~~~ 就能讓 price 這個函數返回所有適用主方法的和。 在?**CLOS**?中這被稱為操作符方法組合。在我們的程序里，這個方法組合的效果就好像對這樣一個Lisp 表達式求值：該表達式中的第一個元素是某個操作符，傳給操作符的參數是對所有適用主方法的調用，而調用的順序是按照匹配程度從高到低的。如果我們定義 price 的 generic 函數，讓它使用+ 來組合返回值，同時假設 price 沒有適用的 around 方法，那么調用 price 的效果就如同它是用下面的語句定義的： ~~~ (defun price (&rest args) (+ (apply ?most specific primary method? args) . . . (apply ?most specific primary method? args))) ~~~ 如果有適用的around 方法的話，它們有更高的優先級，這和標準方法組合是一樣的。在操作符方法組合里， around 方法仍然可以通過 call-next-method 來調用下一個方法。不過在這里主方法就不能調用 call-next-method 了。（這一點是和精簡版的不同之處，在精簡版里，我們是允許主方法調用 call-next 的。） 在?**CLOS**?里，我們可以對一個 generic 函數指定它所使用的方法組合類型，傳給 defgeneric 的缺省參數 ： method-combination 就是用來實現這一功能的。如下所示： ~~~ (defgeneric price (x) (:method-combination +)) ~~~ 現在這個price 方法就會用+ 這種方法組合了。如果我們定義幾種有價格的類， ~~~ (defclass jacket nil nil) (defclass trousers nil nil) (defclass suit (jacet trousers) nil) (defmethod price + ((jk jacket)) 350) (defmethod price + ((tr trousers)) 200) ~~~ 那么當我們要知道一個 suit 實例的價格時，就會得到各個適用的 price 方法之和： ~~~ > (price (make-instance 'suit)) 550 ~~~ 下面所列的符號可以被用作 defmethod 的第二個參數，同時它們也可以用在 defgeneric 的：method-combination 選項上： ~~~ + and append list max min nconc or progn ~~~ 用 define-method-combination ，你可以自己定義其它的方法組合方式：參見 CLTL2，第830 頁。 你一旦定義了一個 generic 函數要使用的方法組合方式，那么所有這個函數對應的方法就必須使用和你所指定的方式相同類型的方法組合。如果我們試圖把其它操作符（或 :before 和 :after） 用作 price 的 defmethod 方法里的第二個參數，就會導致錯誤。倘若我們一定要改變 price 的方法組合方式的話，我們只能通過 fmakunbound 來刪除整個 price 的 generic 函數. ### 25.6?**CLOS**?與 Lisp **CLOS**?為嵌入式語言樹立了一個好榜樣。這種編程方式有兩大好處： 1. 嵌入式語言在概念上可以很好地與它們所處的領域很好融合在一起，因此在嵌入式語言中，我們得以繼續以原來的術語來思考程序代碼。 2. 嵌入式語言可以是非常強大的，因為它們能利用被作為基礎的那門語言已有的所有功能。 **CLOS**?把這兩點都占全了。它和 Lisp 集成得天衣無縫，同時靈活運用了 Lisp 中已有的抽象機制。事實上， 我們可以透 過?**CLOS**?可以看出 Lisp 的神韻。就像物件上雖然蒙著薄布，其形狀仍然清晰可辨一樣。 我們與?**CLOS**?溝通交互的渠道是一層宏，這并不是巧合。宏是用來轉換程序的，而從本質上說，**CLOS**?就是一個程序，它把用面向對象的抽象形式編寫而成的程序翻譯轉換成為 用Lisp 的抽象形式構造而成的程序。 正如本章前兩節所展示的，由于面向對象編程的抽象形式能被如此清晰簡潔地實現成基于 Lisp 的抽象形式，我們幾乎可以把前者說成后者的一個特殊形式了。我們能毫不費力地把面向對象編程里的對象實現成 Lisp 對象，把對象的方法實現為詞法閉包。利用這種同構性，我們得以用區區幾行代碼實現了一個面向對象編程的初步框架，用寥寥幾頁篇幅就容下了一個?**CLOS**?的簡單實現。 雖然?**CLOS**?和我們的簡單實現相比，其規模要大很多，功能也強了很多，但是它還沒有大到能把其根基偽裝成一門嵌入式語言。以defmethod 為例。雖然 CLTL2 沒有明確地提出，但是?**CLOS**?的方法具有詞法閉包的所有能力。如果我們在某個變量的作用域內定義幾個方法： ~~~ (let ((transactions 0)) (defmethod withdraw ((a account) amt) (incf transactions) (decf (balance a) amt)) (defmethod deposit ((a account) amt) (incf transactions) (incf (balance a) amt)) (defun transactions () transactions)) ~~~ 那么在運行時，它們就會像閉包一樣，共享這個變量。這些方法之所以會這樣是因為，在語法帶來的表象之下，它們就是閉包。如果觀察一下 defmethod 的展開式，可以發現它的程序體被原封不動地保存在了井號–引號里的 lambda 表達式中。 第 7.6 節中曾提到，思忖宏的運行方式比考慮它們是什么意思要容易些。與之相似，理解?**CLOS**?的法門在于弄清?**CLOS**?是如何映射到 Lisp 基本的抽象形式中的。 ### 25.7 何時用對象 面向對象的風格有幾個明顯的好處。不同的程序希望在不同程度上從中受益。這些情況有兩種趨勢。一種情況，有的程序，比如說一些模擬程序，如果用面向對象編程的抽象形式來表達它們是最為自然的。而另外一種程序之所以選用面向對象的風格來編寫，主要原因是希望提高程序的可擴展性。 可擴展性的確是面向對象編程帶來的巨大好處之一。程序不再被寫成囫圇的一團，而是分成小塊，每個部分都以自己的功用命名。所以如果事后有其他人需要修改這個程序的話，他就能很方便地找到需要改動的那部分代碼。 倘若我們希望 ob 類型的對象顯示在屏幕上的樣子有所改變的話，我們可以修改 ob 類的 display 方法。要是我們希望創建一個類，讓這個類的實例與 ob 的實例大體一樣，只在某些方面有些差異，那么我們可以從 ob 派生一個子類，在這個子類里面，我們僅僅修改我們想要的那些屬性，其它所有的東西都會從 ob 類缺省地繼承得到。 如果我們只是想讓某一個 ob 對象的行為和其它 ob 對象有些不一樣，可以就新建一個 ob 對象，然后直接修改這個對象的屬性。 倘若要修改的程序原來寫得很認真，那么我們就可以在完成上述各種修改的同時，甚至不用看程序中其它的代碼一眼。從這個角度上來說，以面向對象的思想寫出的程序就像被組織成表格一樣：只要找到對應的單元格，我們就可以迅速安全地修改程序。 對于擴展性來說，它從面向對象風格得到的東西是最少的。實際上，為了要實現可擴展性，基本上不需要什么外部的支持，所以，一個可擴展的程序完全可以不寫成面向對象的。如果要說前面的幾章說明了什么道理的話，那就是 Lisp 程序是可以不用寫為囫圇一團的。 Lisp 給出了全系列的實現擴展性的方案。比如說， 你可以把程序實現成一張表格：即一個由保存在數組里的閉包構成的程序。 假如你想要的就是可擴展性，那么你大可不必在 "面向對象" 編程和 "傳統" 形式的編程中兩者取其一。你常常可以不依賴面向對象的技術，就能賦予一個 Lisp 程序它所需要的可擴展性，不多也不少。屬于類的slot 是一種全局變量。在本可以用使用參數的地方，卻要用全局變量，我們知道這樣做有些不合適。和這種情形有幾分相似，如果本來可以用原始的Lisp 就輕松完成的程序，偏要寫成一堆類和實例，這樣做或許也不是很妥當。有了?**CLOS**?，Common Lisp 已經成為了被廣泛使用的最強大的面向對象語言。具有諷刺意味的是，對 Common Lisp 來說，面向對象編程是它最無足輕重的特性。 備注： 【注1】譯者注：在原文中，本節的標題是 "Plus?aChange" 。它源自法國諺語 "plus?achange，plusc'estlamêmechose" ，字面意思是：變化得越多，越是原來的事物。平時使用中常常略作前半句。 【注2】譯者注：指和常用的工作站相比，功能較有限的計算機終端。