第 11 章 經(jīng)典宏

本章介紹如何定義幾種最常用的宏。它們可以大致歸為三類 帶有一定重疊。第一組宏創(chuàng)建上下文(context)。任何令其參數(shù)在一個(gè)新的上下文環(huán)境里求值的操作符都必須被定義成宏。本章的前兩節(jié)描述兩種基本類型的上下文，并且展示如何定義它們。

接下來的三個(gè)小節(jié)將描述帶有條件和重復(fù)求值的宏。一個(gè)操作符，如果其參數(shù)求值的次數(shù)少于一次或者多于一次，那么也同樣必須被定義成宏。在做條件求值和重復(fù)求值的操作符之間沒有明顯區(qū)別：在本章中，有些例子兼具這兩項(xiàng)功能(綁定操作也是如此)。最后一節(jié)解釋了條件求值和重復(fù)求值之間的另一種相似性：

在某些場(chǎng)合，它們都可以用函數(shù)來完成。

11.1 創(chuàng)建上下文

這里的上下文有兩層意思。一類上下文指的是詞法環(huán)境。special form let?創(chuàng)建一個(gè)新的詞法環(huán)境；let?主體中的表達(dá)式將在一個(gè)可能包含新變量的環(huán)境中被求值。如果在?toplevel?下，把?x設(shè)置成?a?，那么:

(let ((x 'b)) (list x))

將必定返回?(b)?，因?yàn)閷?duì)?list?的調(diào)用被放在一個(gè)新環(huán)境里，它包含一個(gè)新的?x?，其值為?b?。

通常會(huì)把帶有表達(dá)式體的操作符定義成宏。除了類似?prog1?和?progn?的情況外，這類操作符的目地通常都是讓它的主體在某個(gè)新的上下文環(huán)境中被求值。如果要用創(chuàng)建上下文的代碼把主體包裹起來，就需要用到宏，即使這個(gè)上下文環(huán)境里不包含新的詞法變量。

[示例代碼 11.1] let 的宏實(shí)現(xiàn)

(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?定義為一個(gè)宏。一個(gè)?our-let?展開到一個(gè)函數(shù)應(yīng)用:

(our-let ((x 1) (y 2))
  (+ x y))

展開成:

((lambda (x y) (+ x y)) 1 2)

[示例代碼 11.2] 包含三個(gè)新的創(chuàng)建詞法環(huán)境的宏。第 7.5 節(jié)使用了?when-bind?作為參數(shù)列表解構(gòu)的示例，所以這個(gè)宏已經(jīng)在第 7.5 節(jié)介紹過了。更一般的?when-bind*?接受一個(gè)由成對(duì)的 (symbol expression)?form?所組成的列表 就和?let 的第一個(gè)參數(shù)的形式相同。如果任何expression返回nil，那么整個(gè)when-bind表達(dá)式就返回nil。同樣，它的主體在每個(gè)符號(hào)像在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?本身就是用來編寫宏的。許多宏在定義的開頭就會(huì)用?gensym?生成一些符號(hào)，有時(shí)需要生成符號(hào)的數(shù)量還比較多。宏?with-redraw?(第 8.3 節(jié)) 就必須生成五個(gè)：

(defmacro with-redraw ((var objs) &body body)
  (let ((gob (gensym))
      (x0 (gensym)) (y0 (gensym))
      (x1 (gensym)) (y1 (gensym)))
    ...))

這樣的定義可以通過使用?with-gensyms?得以簡(jiǎn)化，后者將整個(gè)變量列表綁定到?gensym?上。借助這個(gè)新的宏，我們只需寫成：

(defmacro with-redraw ((var objs) &body body)
  (with-gensyms (gob x0 y0 x1 y1)
    ...))

這個(gè)新的宏將被廣泛用于后續(xù)的章節(jié)中。

如果我們需要綁定某些變量，然后依據(jù)某些條件，來求值一組表達(dá)式中的一個(gè)，我們只需在?let?里使用一個(gè)條件判斷：

(let ((sun-place 'park) (rain-place 'library))
  (if (sunny)
    (visit sun-place)
    (visit rain-place)))

不幸的是，對(duì)于相反的情形沒有簡(jiǎn)便的寫法，就是說我們總是想要求值相同的代碼，但在綁定的那里必須隨某些條件而變。

[示例代碼 11.3] 包含一個(gè)處理類似情況的宏。從它的名字就能看出，condlet?行為就好像它是cond?和?let?的后代一樣。它接受一個(gè)綁定語(yǔ)句的列表，接著是一個(gè)代碼主體。每個(gè)綁定語(yǔ)句是否生效都要視其對(duì)應(yīng)的測(cè)試表達(dá)式而定；第一個(gè)測(cè)試表達(dá)式為真的綁定語(yǔ)句所構(gòu)造的綁定環(huán)境將會(huì)勝出，代碼主體將在這個(gè)綁定環(huán)境中被求值。有的變量只出現(xiàn)在某些語(yǔ)句中，卻在其它語(yǔ)句里沒有出現(xiàn)，如果最后被選中的語(yǔ)句里沒有為它們指定綁定的話，它們將會(huì)被綁定到?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?定義的一般化。后者將其主體做成一個(gè)函數(shù)，然后被應(yīng)用到初值 (initial value) 形式的求值結(jié)果上。condlet?展開后的代碼用?labels?定義了一個(gè)本地函數(shù)，然后一個(gè) cond 語(yǔ)句來決定哪一組初值將被求值并傳給該函數(shù)。

注意到展開器使用?mappend?代替?mapcan?來從綁定語(yǔ)句中解出變量名。這是因?yàn)?mapcan?是破壞性的，根據(jù)第 10.3 節(jié)里的警告，它比較危險(xiǎn)，會(huì)修改參數(shù)列表結(jié)構(gòu)。

11.2?with-?宏

除了詞法環(huán)境以外還有另一種上下文。廣義上來講，上下文是世界的狀態(tài)，包括特殊變量的值，數(shù)據(jù)結(jié)構(gòu)的內(nèi)容，以及 Lisp 之外事物的狀態(tài)。構(gòu)造這種類型上下文的操作符也必須被定義成宏，除非它們的代碼主體要被打包進(jìn)閉包里。

構(gòu)造上下文的宏的名字經(jīng)常以?with-?開始。這類宏中，用得最多恐怕要算?with-open-file?了。它的主體和一個(gè)新打開的文件一起求值，其時(shí)，該文件已經(jīng)綁定到了用戶給定的變量：

(with-open-file (s "dump" :direction :output)
  (princ 99 s))

該表達(dá)式求值完畢以后，文件 "dump" 將自動(dòng)關(guān)閉，它的內(nèi)容將是兩個(gè)字符 "99"。

很明顯，這個(gè)操作符應(yīng)該定義成宏，因?yàn)樗壎?s?。其實(shí)，只要一個(gè)操作符需要讓?form?在新的上下文中進(jìn)行求值，那就應(yīng)當(dāng)把它定義為宏。在?CLTL2?中新加入的?ignore-errors?宏，使它的參數(shù)就像在一個(gè)?progn?里求值一樣。不管什么地方出了錯(cuò)，整個(gè)?ignore-errors form?會(huì)直接返回nil?。(在讀取用戶的輸入時(shí)，可能就有這種需要。所以這還是有點(diǎn)用的。) 盡管?ignore-errors?沒有創(chuàng)建任何變量，但它還是必須定義成宏，因?yàn)樗膮?shù)是在一個(gè)新的上下文里求值的。

一般而言，創(chuàng)建上下文的宏將被展開成一個(gè)代碼塊；附加的表達(dá)式可能被放在主體之前、之后，或者前后都有。如果是出現(xiàn)在主體之后，其目的可能是為了在結(jié)束時(shí)，讓系統(tǒng)的狀態(tài)保持一致 去做某些清理工作。

例如，with-open-file?必須關(guān)閉它打開的文件。在這種情況下，典型的方法是將上下文創(chuàng)建的宏展開進(jìn)一個(gè)?unwind-protect?里。unwind-protect?的目的是確保特定表達(dá)式被求值，甚至當(dāng)執(zhí)行被中斷時(shí)。它接受一個(gè)或更多參數(shù)，這些參數(shù)按順序執(zhí)行。如果一切正常的話它將返回第一個(gè)參數(shù)的值，就像?prog1?。區(qū)別在于，即使當(dāng)出現(xiàn)錯(cuò)誤，或者拋出的異常中斷了第一個(gè)參數(shù)的求值，其余的參數(shù)也一樣會(huì)被求值。

> (setq x 'a)
A
> (unwind-protect
  (progn (princ "What error?")
    (error "This error."))
  (setq x 'b))
What error?
>>Error: This error.

unwind-protect?產(chǎn)生了一個(gè)錯(cuò)誤。但是在返回到?toplevel?之后，我們注意到它的第二個(gè)參作為整體，form toplevel?數(shù)仍然被求值了：

> x
B

因?yàn)?with-open-file?展開成了一個(gè)?unwind-protect?，所以即使對(duì)?with-open-file?的?body?求值時(shí)發(fā)生了錯(cuò)誤，它打開的文件還是會(huì)一如既往地被關(guān)閉。

上下文創(chuàng)建宏多數(shù)是為特定應(yīng)用而寫的。舉個(gè)例子，假設(shè)我們?cè)趯懸粋€(gè)程序，它會(huì)和多個(gè)遠(yuǎn)程數(shù)據(jù)庫(kù)打交道。程序在同一時(shí)刻只和一個(gè)數(shù)據(jù)庫(kù)通信，這個(gè)數(shù)據(jù)庫(kù)由全局變量 db 指定。在使用數(shù)據(jù)庫(kù)之前，我們必須對(duì)它加鎖，以確保沒有其他程序能同時(shí)使用它。完成操作后需要對(duì)其解鎖。如果想對(duì)數(shù)據(jù)庫(kù)?db?查詢?q?的值，或許會(huì)這樣說：

(let ((temp *db*))
  (setq *db* db)
  (lock *db*)
  (prog1 (eval-query q)
    (release *db*)
    (setq *db* temp)))

我們可以通過宏把所有這些維護(hù)操作都藏起來。[示例代碼 11.4] 定義了一個(gè)宏，它讓我們?cè)诟叩某橄髮用嫔瞎芾頂?shù)據(jù)庫(kù)。使用?with-db?，我們只需說：

(with-db db
  (eval-query q))

而且調(diào)用?with-db?也更安全，因?yàn)樗鼤?huì)展開成?unwind-protect?而不是簡(jiǎn)單的?prog1?。

[示例代碼 11.4] 中的兩個(gè)定義闡述了編寫此類宏的兩種可能方式。第一種是完全用宏，第二種把函數(shù)和宏結(jié)合起來。當(dāng)?with-?宏變得愈發(fā)復(fù)雜時(shí)，第二種方法更有實(shí)踐意義。

在 CLTL2 Common Lisp 中，dynamic-extent?聲明使得在為含主體的閉包分配空間時(shí)，可以更高效一些(?CLTL1?實(shí)現(xiàn)會(huì)忽略該聲明)。我們只有在?with-db-fn?調(diào)用期間才需要這個(gè)閉包，該聲明也正合乎這個(gè)要求，它允許編譯器從棧上為其分配空間。這些空間將在let 表達(dá)式退出時(shí)自動(dòng)回收，而不是之后由垃圾收集器回收。

[示例代碼 11.4] 一個(gè)典型的?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))))))

宏和函數(shù)結(jié)合使用：

(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 條件求值

有時(shí)我們需要讓宏調(diào)用中的某個(gè)參數(shù)僅在特定條件下才被求值。這超出了函數(shù)的能力，因?yàn)楹瘮?shù)總是會(huì)對(duì)它所有的參數(shù)進(jìn)行求值。不過諸如?if、and?和?cond?這樣內(nèi)置的操作符能夠使某些參數(shù)免于求值，除非其它參數(shù)返回某些特定的值。例如在下式中

(if t
  'phew
  (/ x 0))

第三個(gè)參數(shù)如果被求值的話將導(dǎo)致一個(gè)除零錯(cuò)誤。但由于只有前兩個(gè)參數(shù)將被求值，if?從整體上將總是安全地返回?phew?。

我們可以通過編寫宏，將調(diào)用展開到已有的操作符上來創(chuàng)造這類新操作符。[示例代碼 11.5] 中的兩個(gè)宏是許多可能的?if?變形中的兩個(gè)。if3?的定義顯示了應(yīng)如何定義一個(gè)三值邏輯的條件選擇。這個(gè)宏不再將?nil?當(dāng)成假，把除此之外的都作為真，而是考慮了三種真值類型：真，假，以及不確定，表示為??。它可能用于下面關(guān)于五歲小孩的描述：

(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)))))

這個(gè)新的條件選擇展開成一個(gè)?case。(那個(gè)?nil?鍵必須封裝在列表里，原因是單獨(dú)的?nil?鍵會(huì)有歧義。)

最后三個(gè)參數(shù)中只有一個(gè)會(huì)被求值，至于是哪一個(gè)，這取決于第一個(gè)參數(shù)的值。

nif 的意思是 "numericif" 。該宏的另一種實(shí)現(xiàn)出現(xiàn)在 7.2 節(jié)上。它接受數(shù)值表達(dá)式作為第一個(gè)參數(shù)，并根據(jù)這個(gè)表達(dá)式的符號(hào)來求值接下來三個(gè)參數(shù)中的一個(gè)。

> (mapcar #'(lambda (x)
    (nif x 'p 'z 'n))
  '(0 1 -1))
(Z P N)

[示例代碼 11.6] 包含了另外幾個(gè)使用條件求值的宏。宏?in?用來高效地測(cè)試集合的成員關(guān)系。要是你想要測(cè)試一個(gè)對(duì)象是否屬于某備選對(duì)象的集合，可以把這個(gè)查詢表達(dá)式表示成邏輯或：

(let ((x (foo)))
  (or (eql x (bar)) (eql x (baz))))

或者你也可以用集合的成員關(guān)系來表達(dá)：

(member (foo) (list (bar) (baz)))

后者更抽象，但效率要差些。該?member?表達(dá)式在兩個(gè)地方導(dǎo)致了毫無必要的開銷。它需要構(gòu)造點(diǎn)對(duì)，因?yàn)樗仨殞⑺袀溥x對(duì)象連結(jié)成一個(gè)列表以便?member?進(jìn)行查找。并且為了把備選項(xiàng)做成列表形式它們?nèi)家磺笾?，盡管某些值可能根本不需要。如果?(foo)?和?(bar)?的值相等，那么就不需要求值?(baz)?了。不管它在建模上多么抽象，使用?member?都不是好方法。我們可以通過宏來得到更有效率的抽象：in?把?member?的抽象與?or?的效率結(jié)合在了一起。等價(jià)的?in?表達(dá)式:

(in (foo) (bar) (baz))

跟?member?表達(dá)式的形態(tài)相同，但卻可以展開成：

(let ((#:g25 (foo)))
  (or (eql #:g25 (bar))
    (eql #:g25 (baz))))

情況經(jīng)常是這樣，當(dāng)需要在簡(jiǎn)潔和高效兩種習(xí)慣用法之間擇一而從時(shí)，我們?nèi)≈杏怪?，方法是編寫宏將前者變換成為后者。

發(fā)音為 "inqueue" 的?inq?是?in?的引用變形，類似?setq?之于?set。表達(dá)式：

(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?來測(cè)試等價(jià)性。如果你想要使用其他的測(cè)試條件，或者某個(gè)一元函數(shù)來進(jìn)行測(cè)試，那么可以改用更一般的?in-if。in-if?之于?same?好比是?in對(duì)?member?的關(guān)系。表達(dá)式:

(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?一起用的話，我們還能定義出一個(gè)有用的?case?變形。Common Lisp 的?case?宏假定它的鍵值都是常量。但有時(shí)可能需要?case?的行為，同時(shí)又希望求值其中的鍵。針對(duì)這類情況我們定義了?>case?，除了它會(huì)在比較之前先對(duì)每個(gè)子句里的鍵進(jìn)行求值以外，其行為和?case?相同。(名字中的 > 意指通常用來表示求值過程的那個(gè)箭頭符號(hào)。) 因?yàn)?>case?使用了 in，只有它需要的那個(gè)鍵才會(huì)被求值。

由于鍵可以是 Lisp 表達(dá)式，無法判斷?(x y)?到底是個(gè)函數(shù)調(diào)用還是由兩個(gè)鍵組成的列表。為了避免這種二義性，鍵 (除了?t?和?otherwise?) 必須總是放在列表里給出，哪怕是只有一個(gè)。在?case?表達(dá)式里，由于會(huì)產(chǎn)生歧義，nil 不能作為子句的 car 出現(xiàn)。在?>case?表達(dá)式里，nil?作為子句的car?就不再有歧義了，但它的含義是該子句的其余部分將不會(huì)被求值。

為清晰起見，生成每一個(gè)?>case?子句展開式的代碼被定義在一個(gè)單獨(dú)的函數(shù)?>casex?里。注意到>casex?本身還用到了?inq。

11.4 迭代

有時(shí)，函數(shù)的麻煩之處并非在于它們的參數(shù)總是被求值，而是它們只能求值一次。因?yàn)楹瘮?shù)的每個(gè)參數(shù)都將被求值剛好一次，如果我們想要定義一個(gè)操作符，它接受一些表達(dá)式體，并且在這些表達(dá)式上進(jìn)行迭代操作，那唯一的辦法就是把它定義成宏。

最簡(jiǎn)單的例子就是一個(gè)能夠按順序永無休止地求值其參數(shù)的宏：

(defmacro forever (&body body)
  '(do ()
    (nil)
    ,@body))

這不過是當(dāng)你不給它任何循環(huán)關(guān)鍵字時(shí)，loop?宏的本分。你可能認(rèn)為無限循環(huán)毫無用處(或者說用處不大)。但當(dāng)它和?block?和?return-from?組合起來使用時(shí)，這類宏就變成了表達(dá)某種循環(huán)最自然的方式。這種循環(huán)只會(huì)在一些突發(fā)情況下才停下來。

[示例代碼 11.7] 簡(jiǎn)單的迭代宏

(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] 中給出了一些最簡(jiǎn)單的迭代宏。其中，while?我們之前已經(jīng)見過了 (7.4 節(jié))，其主體將在測(cè)試表達(dá)式返回真時(shí)求值。與之對(duì)應(yīng)的是?till?，它是在測(cè)試表達(dá)式返回假時(shí)求值。最后是for ，同樣，在前面也有過一面之緣( 9.6 節(jié))，它在給定的數(shù)字區(qū)間上做迭代操作。

我們定義這些宏，讓它們展開成?do?，用這個(gè)辦法，使得在宏的主體里能使用?go?和?return?。正如?do?從?block?和?tagbody?那里繼承了這些權(quán)力，do?也把這種權(quán)利傳給了?while、till?和for。正如 9.7 節(jié)上解釋的，do?內(nèi)部隱含?block?里的?nil?標(biāo)簽將被 [示例代碼 11.7] 中的宏所捕捉。雖然與其說這是個(gè) bug，不如說它是個(gè)特性，但至少應(yīng)該明確提出來。

當(dāng)你需要定義更強(qiáng)大的迭代結(jié)構(gòu)時(shí)，宏是必不可少的。[示例代碼 11.8] 里包括了兩個(gè)?dolist?的一般化；兩者都在求值主體時(shí)綁定一組變量到一個(gè)列表中相繼的子序列上。例如，給定兩個(gè)參數(shù)，do-tuples/o?將成對(duì)迭代：

> (do-tuples/o (x y) '(a b c d)
  (princ (list x y)))
(A B)(B C)(C D)
NIL

給定相同的參數(shù)，do-tuples/c?將會(huì)做同樣的事，然后折回到列表的開頭：

[示例代碼 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

兩個(gè)宏都返回?nil?，除非在主體中有顯式的?return?。

在需要處理某種路徑表示的程序里，會(huì)經(jīng)常用到這類迭代結(jié)構(gòu)。后綴?/o?和?/c?被用來表明這兩個(gè)版本的迭代控制結(jié)構(gòu)是分別用于遍歷開放和封閉的路徑的。舉個(gè)例子，如果points?是一個(gè)點(diǎn)的列表而?(drawline x y)?在?x?和?y?之間畫線，那么畫一條從起點(diǎn)到終點(diǎn)的路徑我們寫成:

(do-tuples/o (x y) points (drawline x y))

假如?points?是一個(gè)多邊形的節(jié)點(diǎn)列表，為了畫出它的輪廓，我們這樣寫:

(do-tuples/c (x y) points (drawline x y))

作為第一個(gè)實(shí)參給出的形參列表的長(zhǎng)度是任意的，相應(yīng)的迭代就會(huì)按照那個(gè)長(zhǎng)度的組合進(jìn)行。如果只給一個(gè)參數(shù)，兩者都會(huì)退化成?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?更復(fù)雜一些，因?yàn)樗谒阉鞯搅斜斫Y(jié)尾時(shí)折返回來。如果有n?個(gè)參數(shù)，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

前一個(gè)對(duì)?do-tuples/c?調(diào)用的展開式顯示在 [示例代碼 11.9] 中。生成過程的困難之處是那些展示折返到列表開頭的調(diào)用序列。這些調(diào)用 (在本例中有兩個(gè)) 由?dt-args?生成。

[示例代碼 11.9] 一個(gè)?do-tuples/c?調(diào)用的展開

(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 多值迭代

內(nèi)置?do?宏早在多重返回值之前就已經(jīng)有了。幸運(yùn)的是，do?可以繼續(xù)進(jìn)化以適應(yīng)新的形勢(shì)，因?yàn)?code>Lisp?的進(jìn)化掌握在程序員的手中。[示例代碼 11.10] 包含一個(gè)支持多值的?do*?版本。在?mvdo*里，每個(gè)初值語(yǔ)句可綁定多個(gè)變量：

> (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)

這類迭代非常有用，例如，在交互式圖形程序里經(jīng)常需要處理諸如坐標(biāo)和區(qū)域這樣的多值數(shù)據(jù)。

*[示例代碼 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))))))

假設(shè)我們想要寫一個(gè)簡(jiǎn)單的交互式游戲，游戲的目標(biāo)是避免被兩個(gè)追蹤者擠成碎片。如果兩個(gè)追蹤者同時(shí)碰到你，那么你就輸了；如果它們自己撞到一起，你就是贏家。[示例代碼 11.11] 顯示了該游戲的主循環(huán)是如何用?mvdo*?寫成的。

也有可能寫出一個(gè)?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 節(jié)里曾解釋過。為了定義?mvdo?，需要一個(gè)多值版本的?psetq?。

由于 Common Lisp 沒有提供這種操作符，所以我們必須自己寫一個(gè)，如 [示例代碼 11.12] 所示。新的宏的工作方式如下：

[示例代碼 11.11]：一個(gè)碰撞游戲

> (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?位置的兩個(gè)值?x?，y?。開始的時(shí)候三個(gè)對(duì)象的位置是隨機(jī)的。

(move obj dx dy)?根據(jù)類型和向量?<dx, dy>?來移動(dòng)對(duì)象?obj。返回的兩個(gè)值?x?，y?代表其新位置。

(mouse-vector)?返回代表當(dāng)前鼠標(biāo)移動(dòng)位置的兩個(gè)值?mx，my?。

(touch obj1 obj2)?返回真，如果?obj1?碰上了?obj2。

(clear)?清空游戲區(qū)域。

(draw obj)?在當(dāng)前位置繪制?obj。

mvpsetq?的定義依賴于三個(gè)工具函數(shù)：mklist?( 4.3 節(jié))，group?(4.3 節(jié))，以及在這里定義的shuffle?，用來交錯(cuò)兩個(gè)列表：

> (shuffle '(a b c) '(1 2 3 4))
(A 1 B 2 C 3 4)

借助?mvpsetq?，我們就可以定義?mvdo?了，如 [示例代碼 11.13] 所示。和?condlet?一樣，這個(gè)宏使用了?mappend?來代替?mapcan?以避免修改最初的宏調(diào)用?！咀?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)

為了有助于理解這個(gè)相當(dāng)長(zhǎng)的宏，[示例代碼 11.14] 中含有一個(gè)展開示例。

11.6 需要宏的原因

宏并不是保護(hù)參數(shù)免于求值的唯一方式。另一種方法是把它封裝在閉包里。條件求值和重復(fù)求值的相似之處在于這兩個(gè)問題在本質(zhì)上都不需要宏。例如，我們可以將?if?寫成函數(shù)：

(defun fnif (test then &optional else)
  (if test
    (funcall then)
    (if else (funcall else))))

我們可以把?then?和?else?參數(shù)表達(dá)成閉包，通過這種方式來保護(hù)它們，所以下面的表達(dá)式：

(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))))))

如果我們要的只是條件求值，那么不用宏也一樣可以。它們只是讓程序更清晰罷了。不過，當(dāng)我們需要拆開參數(shù)?form，或者為作為參數(shù)傳入的變量綁定值時(shí)，就只能靠宏了。

同樣的道理也適用于那些用于迭代的宏。盡管只有宏才提供唯一的手段，可以用來定義帶有表達(dá)式體的迭代控制結(jié)構(gòu)，其實(shí)用函數(shù)來做迭代也是可能的，只要循環(huán)體被包裝在那個(gè)函數(shù)里。【注 2】例如內(nèi)置函數(shù)?mapc?就是與?dolist?對(duì)應(yīng)的函數(shù)式版本。表達(dá)式:

(dolist (b bananas)
  (peel b)
  (eat b))

和:

(mapc #'(lambda (b)
    (peel b)
    (eat b))
    bananas)

有相同的副作用。(盡管前者返回 nil ，而后者返回 bananas 列表)。或者，我們也可以把?forever實(shí)現(xiàn)成函數(shù):

(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 調(diào)用的展開?(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)))

不過，前提是我們?cè)敢鈧鹘o它閉包而非表達(dá)式體。

然而，迭代控制結(jié)構(gòu)通常要做的工作會(huì)比簡(jiǎn)單的迭代更多，也就是比?forever?更復(fù)雜：它們通常會(huì)把綁定和迭代合二為一。使用函數(shù)的話，綁定操作會(huì)很有局限。如果想把變量綁定到列表的后繼元素上，那么用某種映射函數(shù)就可以。但如果需求比這個(gè)更復(fù)雜，你就不得不寫一個(gè)宏了。

備注：

【注1】譯者注：原文為?mapcar，按照?condlet?來看應(yīng)該是一個(gè)錯(cuò)誤。

【注2】寫一個(gè)不需要其參數(shù)封裝在函數(shù)里的迭代函數(shù)也并非不可能。我們可以寫一個(gè)函數(shù)在作為其參數(shù)傳遞的表達(dá)式上調(diào)用?eval?。對(duì)于 "為什么調(diào)用?eval?通常是有問題的"，可參見 21.2 節(jié)的解釋。