## 第 11 章 經典宏
本章介紹如何定義幾種最常用的宏。它們可以大致歸為三類 帶有一定重疊。第一組宏創建上下文(context)。任何令其參數在一個新的上下文環境里求值的操作符都必須被定義成宏。本章的前兩節描述兩種基本類型的上下文，并且展示如何定義它們。
接下來的三個小節將描述帶有條件和重復求值的宏。一個操作符，如果其參數求值的次數少于一次或者多于一次，那么也同樣必須被定義成宏。在做條件求值和重復求值的操作符之間沒有明顯區別：在本章中，有些例子兼具這兩項功能(綁定操作也是如此)。最后一節解釋了條件求值和重復求值之間的另一種相似性：
在某些場合，它們都可以用函數來完成。
### 11.1 創建上下文
這里的上下文有兩層意思。一類上下文指的是詞法環境。`special form let`?創建一個新的詞法環境；`let`?主體中的表達式將在一個可能包含新變量的環境中被求值。如果在?`toplevel`?下，把?`x`設置成?`a`?，那么:
~~~
(let ((x 'b)) (list x))
~~~
將必定返回?`(b)`?，因為對?`list`?的調用被放在一個新環境里，它包含一個新的?`x`?，其值為?`b`?。
通常會把帶有表達式體的操作符定義成宏。除了類似?`prog1`?和?`progn`?的情況外，這類操作符的目地通常都是讓它的主體在某個新的上下文環境中被求值。如果要用創建上下文的代碼把主體包裹起來，就需要用到宏，即使這個上下文環境里不包含新的詞法變量。
* * *
**[示例代碼 11.1] let 的宏實現**
~~~
(defmacro our-let (binds &body body)
'((lambda ,(mapcar #'(lambda (x)
(if (consp x) (car x) x))
binds)
,@body)
,@(mapcar #'(lambda (x)
(if (consp x) (cadr x) nil))
binds)))
~~~
* * *
[示例代碼 11.1] 顯示了如何通過?`lambda`?將?`let`?定義為一個宏。一個?`our-let`?展開到一個函數應用:
~~~
(our-let ((x 1) (y 2))
(+ x y))
~~~
展開成:
~~~
((lambda (x y) (+ x y)) 1 2)
~~~
[示例代碼 11.2] 包含三個新的創建詞法環境的宏。第 7.5 節使用了?`when-bind`?作為參數列表解構的示例，所以這個宏已經在第 7.5 節介紹過了。更一般的?`when-bind*`?接受一個由成對的 (symbol expression)?`form`?所組成的列表 就和?`let 的第一個參數的形式相同。如果任何`expression`返回`nil`，那么整個`when-bind*`表達式就返回`nil`。同樣，它的主體在每個符號像在`let*` 里那樣被綁定的情況下求值：
* * *
**[示例代碼 11.2] 綁定變量的宏**
~~~
(defmacro when-bind ((var expr) &body body)
'(let ((,var ,expr))
(when ,var
,@body)))
(defmacro when-bind* (binds &body body)
(if (null binds)
'(progn ,@body)
'(let (,(car binds))
(if ,(caar binds)
(when-bind* ,(cdr binds) ,@body)))))
(defmacro with-gensyms (syms &body body)
'(let ,(mapcar #'(lambda (s)
'(,s (gensym)))
syms)
,@body))
~~~
* * *
~~~
> (when-bind* ((x (find-if #'consp '(a (1 2) b)))
(y (find-if #'oddp x)))
(+ y 10))
11
~~~
最后，宏?`with-gensyms`?本身就是用來編寫宏的。許多宏在定義的開頭就會用?`gensym`?生成一些符號，有時需要生成符號的數量還比較多。宏?`with-redraw`?(第 8.3 節) 就必須生成五個：
~~~
(defmacro with-redraw ((var objs) &body body)
(let ((gob (gensym))
(x0 (gensym)) (y0 (gensym))
(x1 (gensym)) (y1 (gensym)))
...))
~~~
這樣的定義可以通過使用?`with-gensyms`?得以簡化，后者將整個變量列表綁定到?`gensym`?上。借助這個新的宏，我們只需寫成：
~~~
(defmacro with-redraw ((var objs) &body body)
(with-gensyms (gob x0 y0 x1 y1)
...))
~~~
這個新的宏將被廣泛用于后續的章節中。
如果我們需要綁定某些變量，然后依據某些條件，來求值一組表達式中的一個，我們只需在?`let`?里使用一個條件判斷：
~~~
(let ((sun-place 'park) (rain-place 'library))
(if (sunny)
(visit sun-place)
(visit rain-place)))
~~~
不幸的是，對于相反的情形沒有簡便的寫法，就是說我們總是想要求值相同的代碼，但在綁定的那里必須隨某些條件而變。
[示例代碼 11.3] 包含一個處理類似情況的宏。從它的名字就能看出，`condlet`?行為就好像它是`cond`?和?`let`?的后代一樣。它接受一個綁定語句的列表，接著是一個代碼主體。每個綁定語句是否生效都要視其對應的測試表達式而定；第一個測試表達式為真的綁定語句所構造的綁定環境將會勝出，代碼主體將在這個綁定環境中被求值。有的變量只出現在某些語句中，卻在其它語句里沒有出現，如果最后被選中的語句里沒有為它們指定綁定的話，它們將會被綁定到?`nil`?上：
* * *
**[示例代碼 11.3]?`cond`?與?`let`?的組合**
~~~
(defmacro condlet (clauses &body body)
(let ((bodfn (gensym))
(vars (mapcar #'(lambda (v) (cons v (gensym)))
(remove-duplicates
(mapcar #'car
(mappend #'cdr clauses))))))
'(labels ((,bodfn ,(mapcar #'car vars)
,@body))
(cond ,@(mapcar #'(lambda (cl)
(condlet-clause vars cl bodfn))
clauses)))))
(defun condlet-clause (vars cl bodfn)
'(,(car cl) (let ,(mapcar #'cdr vars)
(let ,(condlet-binds vars cl)
(,bodfn ,@(mapcar #'cdr vars))))))
(defun condlet-binds (vars cl)
(mapcar #'(lambda (bindform)
(if (consp bindform)
(cons (cdr (assoc (car bindform) vars))
(cdr bindform))))
(cdr cl)))
~~~
* * *
~~~
> (condlet (((= 1 2) (x (princ 'a)) (y (princ 'b)))
((= 1 1) (y (princ 'c)) (x (princ 'd)))
(t (x (princ 'e)) (z (princ 'f))))
(list x y z))
CD
(D C NIL)
~~~
可以把?`condlet`?的定義理解成為?`our-let`?定義的一般化。后者將其主體做成一個函數，然后被應用到初值 (initial value) 形式的求值結果上。`condlet`?展開后的代碼用?`labels`?定義了一個本地函數，然后一個 cond 語句來決定哪一組初值將被求值并傳給該函數。
注意到展開器使用?`mappend`?代替?`mapcan`?來從綁定語句中解出變量名。這是因為?`mapcan`?是破壞性的，根據第 10.3 節里的警告，它比較危險，會修改參數列表結構。
### 11.2?`with-`?宏
除了詞法環境以外還有另一種上下文。廣義上來講，上下文是世界的狀態，包括特殊變量的值，數據結構的內容，以及 Lisp 之外事物的狀態。構造這種類型上下文的操作符也必須被定義成宏，除非它們的代碼主體要被打包進閉包里。
構造上下文的宏的名字經常以?`with-`?開始。這類宏中，用得最多恐怕要算?`with-open-file`?了。它的主體和一個新打開的文件一起求值，其時，該文件已經綁定到了用戶給定的變量：
~~~
(with-open-file (s "dump" :direction :output)
(princ 99 s))
~~~
該表達式求值完畢以后，文件 "dump" 將自動關閉，它的內容將是兩個字符 "99"。
很明顯，這個操作符應該定義成宏，因為它綁定了?`s`?。其實，只要一個操作符需要讓?`form`?在新的上下文中進行求值，那就應當把它定義為宏。在?**CLTL2**?中新加入的?`ignore-errors`?宏，使它的參數就像在一個?`progn`?里求值一樣。不管什么地方出了錯，整個?`ignore-errors form`?會直接返回`nil`?。(在讀取用戶的輸入時，可能就有這種需要。所以這還是有點用的。) 盡管?`ignore-errors`?沒有創建任何變量，但它還是必須定義成宏，因為它的參數是在一個新的上下文里求值的。
一般而言，創建上下文的宏將被展開成一個代碼塊；附加的表達式可能被放在主體之前、之后，或者前后都有。如果是出現在主體之后，其目的可能是為了在結束時，讓系統的狀態保持一致 去做某些清理工作。
例如，`with-open-file`?必須關閉它打開的文件。在這種情況下，典型的方法是將上下文創建的宏展開進一個?`unwind-protect`?里。`unwind-protect`?的目的是確保特定表達式被求值，甚至當執行被中斷時。它接受一個或更多參數，這些參數按順序執行。如果一切正常的話它將返回第一個參數的值，就像?`prog1`?。區別在于，即使當出現錯誤，或者拋出的異常中斷了第一個參數的求值，其余的參數也一樣會被求值。
~~~
> (setq x 'a)
A
> (unwind-protect
(progn (princ "What error?")
(error "This error."))
(setq x 'b))
What error?
>>Error: This error.
~~~
`unwind-protect`?產生了一個錯誤。但是在返回到?`toplevel`?之后，我們注意到它的第二個參作為整體，`form toplevel`?數仍然被求值了：
~~~
> x
B
~~~
因為?`with-open-file`?展開成了一個?`unwind-protect`?，所以即使對?`with-open-file`?的?`body`?求值時發生了錯誤，它打開的文件還是會一如既往地被關閉。
上下文創建宏多數是為特定應用而寫的。舉個例子，假設我們在寫一個程序，它會和多個遠程數據庫打交道。程序在同一時刻只和一個數據庫通信，這個數據庫由全局變量 *db* 指定。在使用數據庫之前，我們必須對它加鎖，以確保沒有其他程序能同時使用它。完成操作后需要對其解鎖。如果想對數據庫?`db`?查詢?`q`?的值，或許會這樣說：
~~~
(let ((temp *db*))
(setq *db* db)
(lock *db*)
(prog1 (eval-query q)
(release *db*)
(setq *db* temp)))
~~~
我們可以通過宏把所有這些維護操作都藏起來。[示例代碼 11.4] 定義了一個宏，它讓我們在更高的抽象層面上管理數據庫。使用?`with-db`?，我們只需說：
~~~
(with-db db
(eval-query q))
~~~
而且調用?`with-db`?也更安全，因為它會展開成?`unwind-protect`?而不是簡單的?`prog1`?。
[示例代碼 11.4] 中的兩個定義闡述了編寫此類宏的兩種可能方式。第一種是完全用宏，第二種把函數和宏結合起來。當?`with-`?宏變得愈發復雜時，第二種方法更有實踐意義。
在 CLTL2 Common Lisp 中，`dynamic-extent`?聲明使得在為含主體的閉包分配空間時，可以更高效一些(?**CLTL1**?實現會忽略該聲明)。我們只有在?`with-db-fn`?調用期間才需要這個閉包，該聲明也正合乎這個要求，它允許編譯器從棧上為其分配空間。這些空間將在let 表達式退出時自動回收，而不是之后由垃圾收集器回收。
* * *
**[示例代碼 11.4] 一個典型的?`with-`?宏**
完全使用宏：
~~~
(defmacro with-db (db &body body)
(let ((temp (gensym)))
'(let ((,temp *db*))
(unwind-protect
(progn
(setq *db* ,db)
(lock *db*)
,@body)
(progn
(release *db*)
(setq *db* ,temp))))))
~~~
宏和函數結合使用：
~~~
(defmacro with-db (db &body body)
(let ((gbod (gensym)))
'(let ((,gbod #'(lambda () ,@body)))
(declare (dynamic-extent ,gbod))
(with-db-fn *db* ,db ,gbod))))
(defun with-db-fn (old-db new-db body)
(unwind-protect
(progn
(setq *db* new-db)
(lock *db*)
(funcall body))
(progn
(release *db*)
(setq *db* old-db))))
~~~
* * *
### 11.3 條件求值
有時我們需要讓宏調用中的某個參數僅在特定條件下才被求值。這超出了函數的能力，因為函數總是會對它所有的參數進行求值。不過諸如?`if`、`and`?和?`cond`?這樣內置的操作符能夠使某些參數免于求值，除非其它參數返回某些特定的值。例如在下式中
~~~
(if t
'phew
(/ x 0))
~~~
第三個參數如果被求值的話將導致一個除零錯誤。但由于只有前兩個參數將被求值，`if`?從整體上將總是安全地返回?`phew`?。
我們可以通過編寫宏，將調用展開到已有的操作符上來創造這類新操作符。[示例代碼 11.5] 中的兩個宏是許多可能的?`if`?變形中的兩個。`if3`?的定義顯示了應如何定義一個三值邏輯的條件選擇。這個宏不再將?`nil`?當成假，把除此之外的都作為真，而是考慮了三種真值類型：真，假，以及不確定，表示為?`?`。它可能用于下面關于五歲小孩的描述：
~~~
(while (not sick)
(if3 (cake-permitted)
(eat-cake)
(throw 'tantrum nil)
(plead-insistently)))
~~~
* * *
** [示例代碼 11.5] 做條件求值的宏**
~~~
(defmacro if3 (test t-case nil-case ?-case)
'(case ,test
((nil) ,nil-case)
(? ,?-case)
(t ,t-case)))
(defmacro nif (expr pos zero neg)
(let ((g (gensym)))
'(let ((,g ,expr))
(cond ((plusp ,g) ,pos)
((zerop ,g) ,zero)
(t ,neg)))))
~~~
* * *
這個新的條件選擇展開成一個?`case`。(那個?`nil`?鍵必須封裝在列表里，原因是單獨的?`nil`?鍵會有歧義。)
最后三個參數中只有一個會被求值，至于是哪一個，這取決于第一個參數的值。
nif 的意思是 "numericif" 。該宏的另一種實現出現在 7.2 節上。它接受數值表達式作為第一個參數，并根據這個表達式的符號來求值接下來三個參數中的一個。
~~~
> (mapcar #'(lambda (x)
(nif x 'p 'z 'n))
'(0 1 -1))
(Z P N)
~~~
[示例代碼 11.6] 包含了另外幾個使用條件求值的宏。宏?`in`?用來高效地測試集合的成員關系。要是你想要測試一個對象是否屬于某備選對象的集合，可以把這個查詢表達式表示成邏輯或：
~~~
(let ((x (foo)))
(or (eql x (bar)) (eql x (baz))))
~~~
或者你也可以用集合的成員關系來表達：
~~~
(member (foo) (list (bar) (baz)))
~~~
后者更抽象，但效率要差些。該?`member`?表達式在兩個地方導致了毫無必要的開銷。它需要構造點對，因為它必須將所有備選對象連結成一個列表以便?`member`?進行查找。并且為了把備選項做成列表形式它們全都要被求值，盡管某些值可能根本不需要。如果?`(foo)`?和?`(bar)`?的值相等，那么就不需要求值?`(baz)`?了。不管它在建模上多么抽象，使用?`member`?都不是好方法。我們可以通過宏來得到更有效率的抽象：`in`?把?`member`?的抽象與?`or`?的效率結合在了一起。等價的?`in`?表達式:
~~~
(in (foo) (bar) (baz))
~~~
跟?`member`?表達式的形態相同，但卻可以展開成：
~~~
(let ((#:g25 (foo)))
(or (eql #:g25 (bar))
(eql #:g25 (baz))))
~~~
情況經常是這樣，當需要在簡潔和高效兩種習慣用法之間擇一而從時，我們取中庸之道，方法是編寫宏將前者變換成為后者。
發音為 "inqueue" 的?`inq`?是?`in`?的引用變形，類似?`setq`?之于?`set`。表達式：
~~~
(inq operator + - *)
~~~
展開成：
~~~
(in operator '+ '- '*)
~~~
* * *
**[示例代碼 11.6] 使用條件求值的宏**
~~~
(defmacro in (obj &rest choices)
(let ((insym (gensym)))
'(let ((,insym ,obj))
(or ,@(mapcar #'(lambda (c) '(eql ,insym ,c))
choices)))))
(defmacro inq (obj &rest args)
'(in ,obj ,@(mapcar #'(lambda (a)
'',a)
args)))
(defmacro in-if (fn &rest choices)
(let ((fnsym (gensym)))
'(let ((,fnsym ,fn))
(or ,@(mapcar #'(lambda (c)
'(funcall ,fnsym ,c))
choices)))))
(defmacro >case (expr &rest clauses)
(let ((g (gensym)))
'(let ((,g ,expr))
(cond ,@(mapcar #'(lambda (cl) (>casex g cl))
clauses)))))
(defmacro >casex (g cl)
(let ((key (car cl)) (rest (cdr cl)))
(cond ((consp key) '((in ,g ,@key) ,@rest))
((inq key t otherwise) '(t ,@rest))
(t (error "bad >case clause")))))
~~~
* * *
和?`member`?的缺省行為一樣，`in`?和?`inq`?用?`eql`?來測試等價性。如果你想要使用其他的測試條件，或者某個一元函數來進行測試，那么可以改用更一般的?`in-if`。`in-if`?之于?`same`?好比是?`in`對?`member`?的關系。表達式:
~~~
(member x (list a b) :test #'equal)
~~~
也可以寫作:
~~~
(in-if #'(lambda (y) (equal x y)) a b)
~~~
而:
~~~
(some #'oddp (list a b))
~~~
就變成:
~~~
(in-if #'oddp a b)
~~~
把?`cond`?和?`in`?一起用的話，我們還能定義出一個有用的?`case`?變形。Common Lisp 的?`case`?宏假定它的鍵值都是常量。但有時可能需要?`case`?的行為，同時又希望求值其中的鍵。針對這類情況我們定義了?`>case`?，除了它會在比較之前先對每個子句里的鍵進行求值以外，其行為和?`case`?相同。(名字中的 > 意指通常用來表示求值過程的那個箭頭符號。) 因為?`>case`?使用了 in，只有它需要的那個鍵才會被求值。
由于鍵可以是 Lisp 表達式，無法判斷?`(x y)`?到底是個函數調用還是由兩個鍵組成的列表。為了避免這種二義性，鍵 (除了?`t`?和?`otherwise`?) 必須總是放在列表里給出，哪怕是只有一個。在?`case`?表達式里，由于會產生歧義，nil 不能作為子句的 car 出現。在?`>case`?表達式里，`nil`?作為子句的`car`?就不再有歧義了，但它的含義是該子句的其余部分將不會被求值。
為清晰起見，生成每一個?`>case`?子句展開式的代碼被定義在一個單獨的函數?`>casex`?里。注意到`>casex`?本身還用到了?`inq`。
### 11.4 迭代
有時，函數的麻煩之處并非在于它們的參數總是被求值，而是它們只能求值一次。因為函數的每個參數都將被求值剛好一次，如果我們想要定義一個操作符，它接受一些表達式體，并且在這些表達式上進行迭代操作，那唯一的辦法就是把它定義成宏。
最簡單的例子就是一個能夠按順序永無休止地求值其參數的宏：
~~~
(defmacro forever (&body body)
'(do ()
(nil)
,@body))
~~~
這不過是當你不給它任何循環關鍵字時，`loop`?宏的本分。你可能認為無限循環毫無用處(或者說用處不大)。但當它和?`block`?和?`return-from`?組合起來使用時，這類宏就變成了表達某種循環最自然的方式。這種循環只會在一些突發情況下才停下來。
* * *
**[示例代碼 11.7] 簡單的迭代宏**
~~~
(defmacro while (test &body body)
'(do ()
((not ,test))
,@body))
(defmacro till (test &body body)
'(do ()
(,test)
,@body))
(defmacro for ((var start stop) &body body)
(let ((gstop (gensym)))
'(do ((,var ,start (1+ ,var))
(,gstop ,stop))
((> ,var ,gstop))
,@body)))
~~~
* * *
[示例代碼 11.7] 中給出了一些最簡單的迭代宏。其中，`while`?我們之前已經見過了 (7.4 節)，其主體將在測試表達式返回真時求值。與之對應的是?`till`?，它是在測試表達式返回假時求值。最后是for ，同樣，在前面也有過一面之緣( 9.6 節)，它在給定的數字區間上做迭代操作。
我們定義這些宏，讓它們展開成?`do`?，用這個辦法，使得在宏的主體里能使用?`go`?和?`return`?。正如?`do`?從?`block`?和?`tagbody`?那里繼承了這些權力，`do`?也把這種權利傳給了?`while`、`till`?和`for`。正如 9.7 節上解釋的，`do`?內部隱含?`block`?里的?`nil`?標簽將被 [示例代碼 11.7] 中的宏所捕捉。雖然與其說這是個 bug，不如說它是個特性，但至少應該明確提出來。
當你需要定義更強大的迭代結構時，宏是必不可少的。[示例代碼 11.8] 里包括了兩個?`dolist`?的一般化；兩者都在求值主體時綁定一組變量到一個列表中相繼的子序列上。例如，給定兩個參數，`do-tuples/o`?將成對迭代：
~~~
> (do-tuples/o (x y) '(a b c d)
(princ (list x y)))
(A B)(B C)(C D)
NIL
~~~
給定相同的參數，`do-tuples/c`?將會做同樣的事，然后折回到列表的開頭：
* * *
**[示例代碼 11.8] 迭代子序列的宏**
~~~
(defmacro do-tuples/o (parms source &body body)
(if parms
(let ((src (gensym)))
'(prog ((,src ,source))
(mapc #'(lambda ,parms ,@body)
,@(map0-n #'(lambda (n)
'(nthcdr ,n ,src))
(- (length source)
(length parms))))))))
(defmacro do-tuples/c (parms source &body body)
(if parms
(with-gensyms (src rest bodfn)
(let ((len (length parms)))
'(let ((,src ,source))
(when (nthcdr ,(1- len) ,src)
(labels ((,bodfn ,parms ,@body))
(do ((,rest ,src (cdr ,rest)))
((not (nthcdr ,(1- len) ,rest))
,@(mapcar #'(lambda (args)
'(,bodfn ,@args))
(dt-args len rest src))
nil)
(,bodfn ,@(map1-n #'(lambda (n)
'(nth ,(1- n)
,rest))
len))))))))))
(defun dt-args (len rest src)
(map0-n #'(lambda (m)
(map1-n #'(lambda (n)
(let ((x (+ m n)))
(if (>= x len)
'(nth ,(- x len) ,src)
'(nth ,(1- x) ,rest))))
len))
(- len 2)))
~~~
* * *
~~~
> (do-tuples/c (x y) '(a b c d)
(princ (list x y)))
(A B)(B C)(C D)(D A)
NIL
~~~
兩個宏都返回?`nil`?，除非在主體中有顯式的?`return`?。
在需要處理某種路徑表示的程序里，會經常用到這類迭代結構。后綴?`/o`?和?`/c`?被用來表明這兩個版本的迭代控制結構是分別用于遍歷開放和封閉的路徑的。舉個例子，如果`points`?是一個點的列表而?`(drawline x y)`?在?`x`?和?`y`?之間畫線，那么畫一條從起點到終點的路徑我們寫成:
~~~
(do-tuples/o (x y) points (drawline x y))
~~~
假如?`points`?是一個多邊形的節點列表，為了畫出它的輪廓，我們這樣寫:
~~~
(do-tuples/c (x y) points (drawline x y))
~~~
作為第一個實參給出的形參列表的長度是任意的，相應的迭代就會按照那個長度的組合進行。如果只給一個參數，兩者都會退化成?`dolist`?：
~~~
> (do-tuples/o (x) '(a b c) (princ x))
ABC
NIL
> (do-tuples/c (x) '(a b c) (princ x))
ABC
NIL
~~~
`do-tuples/c`?的定義比?`do-tuples/o`?更復雜一些，因為它要在搜索到列表結尾時折返回來。如果有`n`?個參數，`do-tuples/c`?必須在返回之前多做?`n-1`?次迭代：
~~~
> (do-tuples/c (x y z) '(a b c d)
(princ (list x y z)))
(A B C)(B C D)(C D A)(D A B)
NIL
> (do-tuples/c (w x y z) '(a b c d)
(princ (list w x y z)))
(A B C D)(B C D A)(C D A B)(D A B C)
NIL
~~~
前一個對?`do-tuples/c`?調用的展開式顯示在 [示例代碼 11.9] 中。生成過程的困難之處是那些展示折返到列表開頭的調用序列。這些調用 (在本例中有兩個) 由?`dt-args`?生成。
* * *
**[示例代碼 11.9] 一個?`do-tuples/c`?調用的展開**
~~~
(do-tuples/c (x y z) '(a b c d)
(princ (list x y z)))
~~~
展開成：
~~~
(let ((#:g2 '(a b c d)))
(when (nthcdr 2 #:g2)
(labels ((#:g4 (x y z)
(princ (list x y z))))
(do ((#:g3 #:g2 (cdr #:g3)))
((not (nthcdr 2 #:g3))
(#:g4 (nth 0 #:g3)
(nth 1 #:g3)
(nth 0 #:g2))
(#:g4 (nth 1 #:g3)
(nth 0 #:g2)
(nth 1 #:g2))
nil)
(#:g4 (nth 0 #:g3)
(nth 1 #:g3)
(nth 2 #:g3))))))
~~~
* * *
### 11.5 多值迭代
內置?`do`?宏早在多重返回值之前就已經有了。幸運的是，`do`?可以繼續進化以適應新的形勢，因為`Lisp`?的進化掌握在程序員的手中。[示例代碼 11.10] 包含一個支持多值的?`do*`?版本。在?`mvdo*`里，每個初值語句可綁定多個變量：
~~~
> (mvdo* ((x 1 (1+ x))
((y z) (values 0 0) (values z x)))
((> x 5) (list x y z))
(princ (list x y z)))
(1 0 0)(2 0 2)(3 2 3)(4 3 4)(5 4 5)
(6 5 6)
~~~
這類迭代非常有用，例如，在交互式圖形程序里經常需要處理諸如坐標和區域這樣的多值數據。
* * *
**[示例代碼 11.10]?`do*`?的多值綁定版本**
~~~
(defmacro mvdo* (parm-cl test-cl &body body)
(mvdo-gen parm-cl parm-cl test-cl body))
(defun mvdo-gen (binds rebinds test body)
(if (null binds)
(let ((label (gensym)))
'(prog nil
,label
(if ,(car test)
(return (progn ,@(cdr test))))
,@body
,@(mvdo-rebind-gen rebinds)
(go ,label)))
(let ((rec (mvdo-gen (cdr binds) rebinds test body)))
(let ((var/s (caar binds)) (expr (cadar binds)))
(if (atom var/s)
'(let ((,var/s ,expr)) ,rec)
'(multiple-value-bind ,var/s ,expr ,rec))))))
(defun mvdo-rebind-gen (rebinds)
(cond ((null rebinds) nil)
((< (length (car rebinds)) 3)
(mvdo-rebind-gen (cdr rebinds)))
(t
(cons (list (if (atom (caar rebinds))
'setq
'multiple-value-setq)
(caar rebinds)
(third (car rebinds)))
(mvdo-rebind-gen (cdr rebinds))))))
~~~
* * *
假設我們想要寫一個簡單的交互式游戲，游戲的目標是避免被兩個追蹤者擠成碎片。如果兩個追蹤者同時碰到你，那么你就輸了；如果它們自己撞到一起，你就是贏家。[示例代碼 11.11] 顯示了該游戲的主循環是如何用?`mvdo*`?寫成的。
也有可能寫出一個?`mvdo`?，并行綁定其局部變量：
~~~
> (mvdo ((x 1 (1+ x))
((y z) (values 0 0) (values z x)))
((> x 5) (list x y z))
(princ (list x y z)))
(1 0 0)(2 0 1)(3 1 2)(4 2 3)(5 3 4)
(6 4 5)
~~~
`do`?的定義中需要用到?`psetq`?的原因在第 7.7 節里曾解釋過。為了定義?`mvdo`?，需要一個多值版本的?`psetq`?。
由于 Common Lisp 沒有提供這種操作符，所以我們必須自己寫一個，如 [示例代碼 11.12] 所示。新的宏的工作方式如下：
* * *
**[示例代碼 11.11]：一個碰撞游戲**
~~~
> (let ((w 0) (x 1) (y 2) (z 3))
(mvpsetq (w x) (values 'a 'b) (y z) (values w x))
(list w x y z))
(A B 0 1)
(mvdo* (((px py) (pos player) (move player mx my))
((x1 y1) (pos obj1) (move obj1 (- px x1)
(- py y1)))
((x2 y2) (pos obj2) (move obj2 (- px x2)
(- py y2)))
((mx my) (mouse-vector) (mouse-vector))
(win nil (touch obj1 obj2))
(lose nil (and (touch obj1 player)
(touch obj2 player))))
((or win lose) (if win 'win 'lose))
(clear)
(draw obj1)
(draw obj2)
(draw player))
~~~
> `(pos obj)`?返回代表?`obj`?位置的兩個值?`x`?，`y`?。開始的時候三個對象的位置是隨機的。
>
> `(move obj dx dy)`?根據類型和向量?`<dx, dy>`?來移動對象?`obj`。返回的兩個值?`x`?，`y`?代表其新位置。
>
> `(mouse-vector)`?返回代表當前鼠標移動位置的兩個值?`mx`，`my`?。
>
> `(touch obj1 obj2)`?返回真，如果?`obj1`?碰上了?`obj2`。
>
> `(clear)`?清空游戲區域。
>
> `(draw obj)`?在當前位置繪制?`obj`。
* * *
`mvpsetq`?的定義依賴于三個工具函數：`mklist`?( 4.3 節)，`group`?(4.3 節)，以及在這里定義的`shuffle`?，用來交錯兩個列表：
~~~
> (shuffle '(a b c) '(1 2 3 4))
(A 1 B 2 C 3 4)
~~~
借助?`mvpsetq`?，我們就可以定義?`mvdo`?了，如 [示例代碼 11.13] 所示。和?`condlet`?一樣，這個宏使用了?`mappend`?來代替?`mapcan`?以避免修改最初的宏調用。【注 1】這種?`mappend-mklist`?寫法可以把一棵樹壓扁一層：
~~~
> (mappend #'mklist '((a b c) d (e (f g) h) ((i)) j))
(A B C D E (F G) H (I) J)
~~~
為了有助于理解這個相當長的宏，[示例代碼 11.14] 中含有一個展開示例。
### 11.6 需要宏的原因
宏并不是保護參數免于求值的唯一方式。另一種方法是把它封裝在閉包里。條件求值和重復求值的相似之處在于這兩個問題在本質上都不需要宏。例如，我們可以將?`if`?寫成函數：
~~~
(defun fnif (test then &optional else)
(if test
(funcall then)
(if else (funcall else))))
~~~
我們可以把?`then`?和?`else`?參數表達成閉包，通過這種方式來保護它們，所以下面的表達式：
~~~
(if (rich) (go-sailing) (rob-bank))
~~~
可以改成：
~~~
(fnif (rich)
#'(lambda () (go-sailing))
#'(lambda () (rob-bank)))
~~~
* * *
**[示例代碼 11.12] psetq 的多值版本**
~~~
(defmacro mvpsetq (&rest args)
(let* ((pairs (group args 2))
(syms (mapcar #'(lambda (p)
(mapcar #'(lambda (x) (gensym))
(mklist (car p))))
pairs)))
(labels ((rec (ps ss)
(if (null ps)
'(setq
,@(mapcan #'(lambda (p s)
(shuffle (mklist (car p))
s))
pairs syms))
(let ((body (rec (cdr ps) (cdr ss))))
(let ((var/s (caar ps))
(expr (cadar ps)))
(if (consp var/s)
'(multiple-value-bind ,(car ss)
,expr
,body)
'(let ((,@(car ss) ,expr))
,body)))))))
(rec pairs syms))))
(defun shuffle (x y)
(cond ((null x) y)
((null y) x)
(t (list* (car x) (car y)
(shuffle (cdr x) (cdr y))))))
~~~
* * *
如果我們要的只是條件求值，那么不用宏也一樣可以。它們只是讓程序更清晰罷了。不過，當我們需要拆開參數?`form`，或者為作為參數傳入的變量綁定值時，就只能靠宏了。
同樣的道理也適用于那些用于迭代的宏。盡管只有宏才提供唯一的手段，可以用來定義帶有表達式體的迭代控制結構，其實用函數來做迭代也是可能的，只要循環體被包裝在那個函數里。【注 2】例如內置函數?`mapc`?就是與?`dolist`?對應的函數式版本。表達式:
~~~
(dolist (b bananas)
(peel b)
(eat b))
~~~
和:
~~~
(mapc #'(lambda (b)
(peel b)
(eat b))
bananas)
~~~
有相同的副作用。(盡管前者返回 nil ，而后者返回 bananas 列表)。或者，我們也可以把?`forever`實現成函數:
~~~
(defun forever (fn)
(do ()
(nil)
(funcall fn)))
~~~
* * *
**[示例代碼 11.13] do 的多值綁定版本**
~~~
(defmacro mvdo (binds (test &rest result) &body body)
(let ((label (gensym))
(temps (mapcar #'(lambda (b)
(if (listp (car b))
(mapcar #'(lambda (x)
(gensym))
(car b))
(gensym)))
binds)))
'(let ,(mappend #'mklist temps)
(mvpsetq ,@(mapcan #'(lambda (b var)
(list var (cadr b)))
binds
temps))
(prog ,(mapcar #'(lambda (b var) (list b var))
(mappend #'mklist (mapcar #'car binds))
(mappend #'mklist temps))
,label
(if ,test
(return (progn ,@result)))
,@body
(mvpsetq ,@(mapcan #'(lambda (b)
(if (third b)
(list (car b)
(third b))))
binds))
(go ,label)))))
~~~
* * *
**[示例代碼 11.14] mvdo 調用的展開**?(mvdo ((x 1 (1+ x)) ((y z) (values 0 0) (values z x))) ((> x 5) (list x y z)) (princ (list x y z)))
展開成：
~~~
(let (#:g2 #:g3 #:g4)
(mvpsetq #:g2 1
(#:g3 #:g4) (values 0 0))
(prog ((x #:g2) (y #:g3) (z #:g4))
#:g1
(if (> x 5)
(return (progn (list x y z))))
(princ (list x y z))
(mvpsetq x (1+ x)
(y z) (values z x))
(go #:g1)))
~~~
* * *
不過，前提是我們愿意傳給它閉包而非表達式體。
然而，迭代控制結構通常要做的工作會比簡單的迭代更多，也就是比?`forever`?更復雜：它們通常會把綁定和迭代合二為一。使用函數的話，綁定操作會很有局限。如果想把變量綁定到列表的后繼元素上，那么用某種映射函數就可以。但如果需求比這個更復雜，你就不得不寫一個宏了。
備注：
【注1】譯者注：原文為?`mapcar`，按照?`condlet`?來看應該是一個錯誤。
【注2】寫一個不需要其參數封裝在函數里的迭代函數也并非不可能。我們可以寫一個函數在作為其參數傳遞的表達式上調用?`eval`?。對于 "為什么調用?`eval`?通常是有問題的"，可參見 21.2 節的解釋。
- 封面
- 譯者序
- 前言
- 第 1 章 可擴展語言
- 第 2 章 函數
- 第 3 章 函數式編程
- 第 4 章 實用函數
- 第 5 章 函數作為返回值
- 第 6 章 函數作為表達方式
- 第 7 章 宏
- 第 8 章 何時使用宏
- 第 9 章 變量捕捉
- 第 10 章 其他的宏陷阱
- 第 11 章 經典宏
- 第 12 章 廣義變量
- 第 13 章 編譯期計算
- 第 14 章 指代宏
- 第 15 章 返回函數的宏
- 第 16 章 定義宏的宏
- 第 17 章 讀取宏（read-macro）
- 第 18 章 解構
- 第 19 章 一個查詢編譯器
- 第 20 章 續延(continuation)
- 第 21 章 多進程
- 第 22 章 非確定性
- 第 23 章 使用 ATN 分析句子
- 第 24 章 Prolog
- 第 25 章 面向對象的 Lisp
- 附錄： 包(packages)