第 11 章 經(jīng)典宏

第 11 章 經(jīng)典宏

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

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

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

11.1 創(chuàng)建上下文

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

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

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

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

---

[示例代碼 11.1] let 的宏實現(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?定義為一個宏。一個?our-let?展開到一個函數(shù)應(yīng)用:

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

展開成:

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

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

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

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

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

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

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

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

注意到展開器使用?mappend?代替?mapcan?來從綁定語句中解出變量名。這是因為?mapcan?是破壞性的，根據(jù)第 10.3 節(jié)里的警告，它比較危險，會修改參數(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?了。它的主體和一個新打開的文件一起求值，其時，該文件已經(jīng)綁定到了用戶給定的變量：

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

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

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

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

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

> (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)生了一個錯誤。但是在返回到?toplevel?之后，我們注意到它的第二個參作為整體，form toplevel?數(shù)仍然被求值了：

> x
B

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

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

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

我們可以通過宏把所有這些維護(hù)操作都藏起來。[示例代碼 11.4] 定義了一個宏，它讓我們在更高的抽象層面上管理數(shù)據(jù)庫。使用?with-db?，我們只需說：

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

而且調(diào)用?with-db?也更安全，因為它會展開成?unwind-protect?而不是簡單的?prog1?。

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

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

---

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

宏和函數(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 條件求值

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

(if t
  'phew
  (/ x 0))

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

我們可以通過編寫宏，將調(diào)用展開到已有的操作符上來創(chuàng)造這類新操作符。[示例代碼 11.5] 中的兩個宏是許多可能的?if?變形中的兩個。if3?的定義顯示了應(yīng)如何定義一個三值邏輯的條件選擇。這個宏不再將?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)))))

---

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

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

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

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

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

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

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

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

后者更抽象，但效率要差些。該?member?表達(dá)式在兩個地方導(dǎo)致了毫無必要的開銷。它需要構(gòu)造點對，因為它必須將所有備選對象連結(jié)成一個列表以便?member?進(jìn)行查找。并且為了把備選項做成列表形式它們?nèi)家磺笾?，盡管某些值可能根本不需要。如果?(foo)?和?(bar)?的值相等，那么就不需要求值?(baz)?了。不管它在建模上多么抽象，使用?member?都不是好方法。我們可以通過宏來得到更有效率的抽象：in?把?member?的抽象與?or?的效率結(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)需要在簡潔和高效兩種習(xí)慣用法之間擇一而從時，我們?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?來測試等價性。如果你想要使用其他的測試條件，或者某個一元函數(shù)來進(jìn)行測試，那么可以改用更一般的?in-if。in-if?之于?same?好比是?in對?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?一起用的話，我們還能定義出一個有用的?case?變形。Common Lisp 的?case?宏假定它的鍵值都是常量。但有時可能需要?case?的行為，同時又希望求值其中的鍵。針對這類情況我們定義了?>case?，除了它會在比較之前先對每個子句里的鍵進(jìn)行求值以外，其行為和?case?相同。(名字中的 > 意指通常用來表示求值過程的那個箭頭符號。) 因為?>case?使用了 in，只有它需要的那個鍵才會被求值。

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

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

11.4 迭代

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

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

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

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

---

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

我們定義這些宏，讓它們展開成?do?，用這個辦法，使得在宏的主體里能使用?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] 中的宏所捕捉。雖然與其說這是個 bug，不如說它是個特性，但至少應(yīng)該明確提出來。

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

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

給定相同的參數(shù)，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?。

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

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

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

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

作為第一個實參給出的形參列表的長度是任意的，相應(yīng)的迭代就會按照那個長度的組合進(jìn)行。如果只給一個參數(shù)，兩者都會退化成?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ù)雜一些，因為它要在搜索到列表結(jié)尾時折返回來。如果有n?個參數(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

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

---

[示例代碼 11.9] 一個?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)有了。幸運的是，do?可以繼續(xù)進(jìn)化以適應(yīng)新的形勢，因為Lisp?的進(jìn)化掌握在程序員的手中。[示例代碼 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)

這類迭代非常有用，例如，在交互式圖形程序里經(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è)我們想要寫一個簡單的交互式游戲，游戲的目標(biāo)是避免被兩個追蹤者擠成碎片。如果兩個追蹤者同時碰到你，那么你就輸了；如果它們自己撞到一起，你就是贏家。[示例代碼 11.11] 顯示了該游戲的主循環(huán)是如何用?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 節(jié)里曾解釋過。為了定義?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)?根據(jù)類型和向量?<dx, dy>?來移動對象?obj。返回的兩個值?x?，y?代表其新位置。

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

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

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

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

---

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

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

借助?mvpsetq?，我們就可以定義?mvdo?了，如 [示例代碼 11.13] 所示。和?condlet?一樣，這個宏使用了?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)

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

11.6 需要宏的原因

宏并不是保護(hù)參數(shù)免于求值的唯一方式。另一種方法是把它封裝在閉包里。條件求值和重復(fù)求值的相似之處在于這兩個問題在本質(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ù)傳入的變量綁定值時，就只能靠宏了。

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

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

和:

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

有相同的副作用。(盡管前者返回 nil ，而后者返回 bananas 列表)?；蛘?，我們也可以把?forever實現(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)))

---

不過，前提是我們愿意傳給它閉包而非表達(dá)式體。

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

備注：

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

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