第 16 章 定義宏的宏

第 16 章 定義宏的宏

代碼中的模式通常預(yù)示著需要新的抽象。這一規(guī)則對(duì)于宏代碼本身也一樣適用。如果幾個(gè)宏的定義在形式上比較相似，我們就可能寫一個(gè)編寫宏的宏來(lái)產(chǎn)生它們。本章展示三個(gè)宏定義宏的例子：一個(gè)用來(lái)定義縮略語(yǔ)，另一個(gè)用來(lái)定義訪問宏，第三個(gè)則用來(lái)定義在 14.1 節(jié)中介紹的那種指代宏。

16.1 縮略語(yǔ)

宏最簡(jiǎn)單的用法就是作為縮略語(yǔ)。一些 Common Lisp 操作符的名字相當(dāng)之長(zhǎng)。它們中最典型的 (盡管不是最長(zhǎng)的) 是 destructuring-bind ，長(zhǎng)達(dá) 18 個(gè)字符。Steele 原則(4.3 節(jié)) 的一個(gè)直接推論是，常用的操作符應(yīng)該取個(gè)簡(jiǎn)短的名字。("我們認(rèn)為加法的成本較低，部分原因是由于我們只要用一個(gè)字符 '+' 就可以表示它。") 內(nèi)置的 destructuring-bind 宏引入了一個(gè)新的抽象層，但它在簡(jiǎn)潔上作出的貢獻(xiàn)被它的長(zhǎng)名字抹殺了：

(let ((a (car x)) (b (cdr x))) ...)
(destructuring-bind (a . b) x ...)

和打印出來(lái)的文本相似，程序在每行的字符數(shù)不超過 70 的時(shí)候，是最容易閱讀的。當(dāng)單個(gè)名字的長(zhǎng)度達(dá)到這個(gè)長(zhǎng)度的四分之一時(shí)，我們就開始覺得不便了。

幸運(yùn)的是，在像 Lisp 這樣的語(yǔ)言里你完全沒有必要逆來(lái)順受設(shè)計(jì)者的每個(gè)決定。只要定義了:

(defmacro dbind (&rest args)
  '(destructuring-bind ,@args))

你就再也不沒必要用那個(gè)長(zhǎng)長(zhǎng)的名字了。對(duì)于名字更長(zhǎng)也更常用的multiple-value-bind 也是一樣的道理。

(defmacro mvbind (&rest args)
  '(multiple-value-bind ,@args))

注意到 dbind 和 mvbind 的定義是何等的相似。確實(shí)，使用這種 rest 和逗號(hào)-at 的慣用法，就已經(jīng)能為任意一個(gè)函數(shù)【注1】、宏，或者?special form?定義其縮略語(yǔ)了。既然我們可以讓一個(gè)宏幫我們代勞，為什么還老是照著?mvbind?的模樣寫出一個(gè)又一個(gè)的定義呢？

為了定義一個(gè)定義宏的宏，我們通常會(huì)要用到嵌套的反引用。嵌套反引用的難以理解是出了名的。盡管最終我們會(huì)對(duì)那些常見的情況了如指掌，但你不能指望隨便挑一個(gè)反引用表達(dá)式，都能看一眼，就能立即說出它可以產(chǎn)生什么。這不能歸罪于 Lisp。就像一個(gè)復(fù)雜的積分，沒人能看一眼就得出積分的結(jié)果，但是我們不能因?yàn)檫@個(gè)就把問題歸咎于積分的表示方法。道理是一樣的。難點(diǎn)在于問題本身，而非表示問題的方法。

盡管如此，正如在我們?cè)谧龇e分的時(shí)候，我們同樣也可以把對(duì)反引用的分析拆成多個(gè)小一些的步驟，讓每一步都可以很容易地完成。假設(shè)我們想要寫一個(gè) abbrev 宏，它允許我們僅用:

(abbrev mvbind multiple-value-bind)

[示例代碼 16.1] 自動(dòng)定義縮略語(yǔ)

(defmacro abbrev (short long)
  '(defmacro ,short (&rest args)
    '(,',long ,@args)))

(defmacro abbrevs (&rest names)
  '(progn
    ,@(mapcar #'(lambda (pair)
        '(abbrev ,@pair))
      (group names 2))))

來(lái)定義 mvbind 。[示例代碼 16.1] 給出了一個(gè)這個(gè)宏的定義。它是怎樣寫出來(lái)的呢？這個(gè)宏的定義可以從一個(gè)示例展開式開始。一個(gè)展開式是：

(defmacro mvbind (&rest args)
  '(multiple-value-bind ,@args))

如果我們把 multiple-value-bind 從反引用里拉出來(lái)的話，就會(huì)讓推導(dǎo)變得更容易些，因?yàn)槲覀冎浪鼘⒊蔀樽罱K要得到的那個(gè)宏的參數(shù)。這樣就得到了等價(jià)的定義:

(defmacro mvbind (&rest args)
  (let ((name 'multiple-value-bind))
    '(,name ,@args)))

現(xiàn)在我們將這個(gè)展開式轉(zhuǎn)化成一個(gè)模板。我們先把反引用放在前面，然后把可變的表達(dá)式替換成變量。

'(defmacro ,short (&rest args)
  (let ((name ',long))
    '(,name ,@args)))

最后一步是通過把代表 name 的 ',long 從內(nèi)層反引用中消去，來(lái)簡(jiǎn)化表達(dá)式：

'(defmacro ,short (&rest args)
  '(,',long ,@args))

這就得到了 [示例代碼 16.1] 中定義的宏的主體。

[示例代碼 16.1] 中還有一個(gè) abbrevs ，它用于我們想要一次性定義多個(gè)縮略語(yǔ)的場(chǎng)合.

(abbrevs dbind destructuring-bind
  mvbind multiple-value-bind
  mvsetq multiple-value-setq)

abbrevs 的用戶無(wú)需插入多余的括號(hào)，因?yàn)?abbrevs 通過調(diào)用 group (4.3 節(jié)) 來(lái)將其參數(shù)兩兩分組。對(duì)于宏來(lái)說，為用戶節(jié)省邏輯上不必要的括號(hào)是件好事，而 group 對(duì)于多數(shù)這樣的宏來(lái)說都是有用的。

16.2 屬性

Lisp 提供多種方式將屬性和對(duì)象關(guān)聯(lián)在一起。如果問題中的對(duì)象可以表示成符號(hào)，那么最便利(盡管可能最低效) 的方式之一是使用符號(hào)的屬性表。為了描述對(duì)象 -- 具有值為 的屬性 -- 的這一事實(shí)，我們修改的屬性表：

(setf (get o p) v)

所以如果說 ball1 的 color 為 red ，我們用：

(setf (get 'ball1 'color) 'red)

如果我們打算經(jīng)常引用對(duì)象的某些屬性，我們可以定義一個(gè)宏來(lái)得到它：

(defmacro color (obj)
  '(get ,obj 'color))

然后在 get 的位置上使用 color 就可以了：

> (color 'ball1)
RED

由于宏調(diào)用對(duì) setf 是透明的(見第 12 章)，我們也可以用：

> (setf (color 'ball1) 'green)
GREEN

這種宏會(huì)有如下優(yōu)勢(shì)：它能把程序表示對(duì)象顏色的方式隱藏起來(lái)。屬性表的訪問速度比較慢；程序在將來(lái)的版本里，可能會(huì)出于速度考慮，將顏色表示成結(jié)構(gòu)體的一個(gè)字段，或者哈希表中的一個(gè)表項(xiàng)。如果通過類似 color 宏這樣的外部接口訪問數(shù)據(jù)，我們可以很輕易地對(duì)底層代碼做翻天覆地的改動(dòng)，就算是已經(jīng)成形的程序也不在話下。如果一個(gè)程序從屬性表改成用結(jié)構(gòu)體，那么在訪問宏的外部接口以上的程序可以原封不動(dòng)；甚至使用這個(gè)接口的代碼可以根本就對(duì)背后的重構(gòu)過程毫無(wú)察覺。

對(duì)于重量這個(gè)屬性，我們可以定義一個(gè)宏，它和為 color 寫的那個(gè)宏差不多：

(defmacro weight (obj)
  '(get ,obj 'weight))

和上節(jié)的情況相似，color 和 weight 的定義幾乎一模一樣。在這里 propmacro ([示例代碼 16.2]) 扮演了和 abbrev 相同的角色。

[示例代碼 16.2] 自動(dòng)定義訪問宏

(defmacro propmacro (propname)
  '(defmacro ,propname (obj)
    '(get ,obj ',',propname)))

(defmacro propmacros (&rest props)
  '(progn
    ,@(mapcar #'(lambda (p) '(propmacro ,p)
        props))))

一個(gè)用來(lái)定義宏的宏可以采用和任何其他宏相同的設(shè)計(jì)過程：先理解宏調(diào)用，然后分析預(yù)期的展開式，再想出來(lái)如何將前者轉(zhuǎn)化成后者。我們想要

(propmacro color)

被展開成

(defmacro color (obj)
  '(get ,obj 'color))

盡管這個(gè)展開式本身也是一個(gè) defmacro ，我們?nèi)匀荒軌驗(yàn)樗鲆粋€(gè)模板，先把它放到反引用里，然后把加了逗號(hào)的參數(shù)名放在color 的實(shí)例的位置上。如同前一節(jié)那樣，我們首先通過轉(zhuǎn)化，讓展開式已有的反引 用里面沒有 color 實(shí)例：

(defmacro color (obj)
  (let ((p 'color))
    '(get ,obj ',p)))

然后我們接下來(lái)構(gòu)造這個(gè)模板：

'(defmacro ,propname (obj)
  (let ((p ',propname))
    '(get ,obj ',p)))

再簡(jiǎn)化成：

'(defmacro ,propname (obj)
  '(get ,obj ',',propname))

對(duì)于需要把一組屬性名全部定義成宏的場(chǎng)合，還有 propmacros ([示例代碼 16.2])，它展開到一系列單獨(dú)的對(duì) propmacro 的調(diào)用。就像 abbrevs ，這段不長(zhǎng)的代碼事實(shí)上是一個(gè)定義定義宏的宏的宏。

雖然本章針對(duì)的是屬性表，但這里的技術(shù)是通用的。對(duì)于以任何形式保存的數(shù)據(jù)，我們都可以用它定義適用的數(shù)據(jù)訪問宏。

16.3 指代宏

第14.1節(jié)已經(jīng)給出了幾種指代宏的定義。當(dāng)你使用類似 aif 或者 aand 這樣的宏時(shí)，在一些參數(shù)求值的過程中，符號(hào) it 將被綁定到其他參數(shù)返回的值上。所以，無(wú)需再用:

(let ((res (complicated-query)))
  (if res
    (foo res)))

只要說

(aif (complicated-query)
  (foo it))

就可以了，而:

(let ((o (owner x)))
  (and o (let ((a (address o)))
      (and a (city a)))))

則可以簡(jiǎn)化成:

(aand (owner x) (address it) (city it))

第 14.1 節(jié)給出了七個(gè)指代宏：aif ，awhen ，awhile ，acond ，alambda ，ablock 和 aand。這七個(gè)絕不是唯一有用的這種類型的指代宏。事實(shí)上，我們可以為任何 Common Lisp 函數(shù)或宏定義出對(duì)應(yīng)的指代變形。這些宏中有許多的情況會(huì)和 mapcon 很像：很少用到，可一旦需要就是不可替代的。

例如，我們可以定義 a+ ，讓它和 aand 一樣，使 it 總是綁定到上個(gè)參數(shù)返回的值上。下面的函數(shù)用來(lái)計(jì)算 在Massachusetts 的晚餐開銷：

(defun mass-cost (menu-price)
  (a+ menu-price (* it .05) (* it 3)))

Massachusetts 的餐飲稅是 5%，而顧客經(jīng)常按照這個(gè)稅的三倍來(lái)計(jì)算小費(fèi)。按照這個(gè)公式計(jì)算的話，

在 Dolphin 海鮮餐廳吃烤鱈魚的費(fèi)用共計(jì)：

> (mass-cost 7.95)
9.54

不過這里還包括了沙拉和一份烤土豆。

[示例代碼 16.3] a+ 和 alist 的定義

(defmacro a+ (&rest args)
  (a+expand args nil))

(defun a+expand (args syms)
  (if args
    (let ((sym (gensym)))
      '(let* ((,sym ,(car args))
          (it ,sym))
        ,(a+expand (cdr args)
          (append syms (list sym)))))
    '(+ ,@syms)))

(defmacro alist (&rest args)
  (alist-expand args nil))

(defun alist-expand (args syms)
  (if args
    (let ((sym (gensym)))
      '(let* ((,sym ,(car args))
          (it ,sym))
        ,(alist-expand (cdr args)
          (append syms (list sym)))))
    '(list ,@syms)))

[示例代碼 16.3] 中定義的 a+ ，依賴于一個(gè)遞歸函數(shù) a+expand ，來(lái)生成其展開式。a+expand 的一般策略是對(duì)宏調(diào)用中的參數(shù)列表不斷地求 cdr，同時(shí)生成一系列嵌套的 let 表達(dá)式；每一個(gè) let 都將 it 綁定到不同的參數(shù)上，但同時(shí)也把每個(gè)參數(shù)綁定到一個(gè)不同的生成符號(hào)上。展開函數(shù)聚集出一個(gè)這些生成符號(hào)的列表，并且當(dāng)?shù)竭_(dá)參數(shù)列表的結(jié)尾時(shí)，它就返回一個(gè)以這些生成符號(hào)作為參數(shù)的+ 表達(dá)式。所以表達(dá)式:

(a+ menu-price (* it .05) (* it 3))

得到了展開式：

(let* ((#:g2 menu-price) (it #:g2))
  (let* ((#:g3 (* it 0.05)) (it #:g3))
    (let* ((#:g4 (* it 3)) (it #:g4))
      (+ #:g2 #:g3 #:g4))))

[示例代碼 16.3] 中還定義了一個(gè)類似的 alist ：

> (alist 1 (+ 2 it) (+ 2 it))
(1 3 5)

歷史重演了，a+ 和 alist 的定義幾乎完全一樣。如果我們想要定義更多像它們那樣的宏，這些宏也將在很大程度上大同小異。為什么不寫一個(gè)程序，讓它幫助我們產(chǎn)生這些宏呢？[示例代碼 16.4] 中的 defanaph 將達(dá)到這個(gè)目的。借助defanaph ，宏 a+ 和alist 的定義過程可以簡(jiǎn)化成:

(defanaph a+)
(defanaph alist)

這樣定義出的 a+ 和 alist 展開式將和 [示例代碼 16.3] 中的代碼產(chǎn)生的展開式相同。這個(gè)用來(lái)定義宏的defanaph 宏將為任何其參數(shù)按照正常函數(shù)求值規(guī)則來(lái)求值的東西創(chuàng)建出指代變形來(lái)。這就是說，defanaph 將適用于任何參數(shù)全部被求值，并且是從左到右求值的東西上。所以你不能用這個(gè)版本的 defanaph 來(lái)定義 aand 或 awhile ，但你可以用它給任何函數(shù)定義出其指代版本。

正如 a+ 調(diào)用 a+expand 來(lái)生成其展開式，defanaph 所定義的宏也調(diào)用 anaphex 來(lái)做這個(gè)事情。通用展開器 anaphex 跟 a+expand 的唯一不同之處在于其接受作為參數(shù)的函數(shù)名使其出現(xiàn)在最終的展開式里。事實(shí)上，a+ 現(xiàn)在可以定義成：

[示例代碼 16.4] 自動(dòng)定義指代宏

(defmacro a+ (&rest args)
  (anaphex args '(+)))

(defmacro defanaph (name &optional calls)
  (let ((calls (or calls (pop-symbol name))))
    '(defmacro ,name (&rest args)
      (anaphex args (list ',calls)))))

(defun anaphex (args expr)
  (if args
    (let ((sym (gensym)))
      '(let* ((,sym ,(car args))
          (it ,sym))
        ,(anaphex (cdr args)
          (append expr (list sym)))))
    expr))

(defun pop-symbol (sym)
  (intern (subseq (symbol-name sym) 1)))

無(wú)論 anaphex 還是 a+expand 都不需要被定義成單獨(dú)的函數(shù)：anaphex 可以用 labels 或 alambda 定義在 defanaph 里面。這里把展開式生成器拆成分開的函數(shù)只是出于澄清的理由。

默認(rèn)情況下，defanaph 通過將其參數(shù)前面的第一個(gè)字母(假設(shè)是一個(gè) a ) 拉出來(lái)以決定在最后的展開式里調(diào)用什么。(這個(gè)操作是由 pop-symbol 完成的。) 如果用戶更喜歡另外指定一個(gè)名字，它可以作為一個(gè)可選參數(shù)。盡管defanaph 可以為所有函數(shù)和某些宏定義出其 anaphoric 變形，但它有一些令人討厭的局限：

1. 它只能工作在其參數(shù)全部求值的操作符上。

2. 在宏展開中，it 總被綁定在前一個(gè)參數(shù)上。在某些場(chǎng)合, 例如 awhen 我們想要 it 始終綁在第一個(gè)參數(shù)的值上。

3. 它無(wú)法工作在像 setf 這種期望其第一個(gè)參數(shù)是廣義變量的宏上。

讓我們考慮一下如何在一定程度上打破這些局限。第一個(gè)問題的一部分可以通過解決第二個(gè)問題來(lái)解決。

為了給類似 aif 的宏生成展開式，我們需要對(duì) anaphex 加以修改，讓它在宏調(diào)用中只替換第一個(gè)參數(shù)：

(defun anaphex2 (op args)
  '(let ((it ,(car args)))
    (,op it ,@(cdr args))))

這個(gè)非遞歸版本的 anaphex 不需要確保宏展開式將 it 綁定到當(dāng)前參數(shù)前面的那個(gè)參數(shù)上，所以它可以生成的展開式?jīng)]有必要對(duì)宏調(diào)用中的所有參數(shù)求值。只有第一個(gè)參數(shù)是必須被求值的，以便將 it 綁定到它的值上。所以 aif 可以被定義成：

(defmacro aif (&rest args)
  (anaphex2 'if args))

這個(gè)定義和 14.1 節(jié)上原來(lái)的定義相比，唯一的區(qū)別在于: 之前那個(gè)版本里，如果你傳給 aif 參數(shù)的個(gè)數(shù)不對(duì)的話，那程序會(huì)報(bào)錯(cuò)；如果調(diào)用宏的方法是正確的話，這兩個(gè)版本將生成相同的展開式。

至于第三個(gè)問題，也就是 defanaph 無(wú)法工作在廣義變量上的問題，可以通過在展開式中使用 _f (12.4 節(jié)) 來(lái)解決。像 setf 這樣的操作符可以被下面定義的 anaphex2 的變種來(lái)處理：

(defun anaphex3 (op args)
  '(_f (lambda (it) (,op it ,@(cdr args))) ,(car args)))

這個(gè)展開器假設(shè)宏調(diào)用必須帶有一個(gè)以上的參數(shù)，其中第一個(gè)參數(shù)將是一個(gè)廣義變量。使用它我們可以這樣定義 asetf：【注2】【注3】

[示例代碼 16.5] 更一般的 defanaph

(defmacro asetf (&rest args)
  (anaphex3 '(lambda (x y) (declare (ignore x)) y) args))

(defmacro defanaph (name &key calls (rule :all))
  (let* ((opname (or calls (pop-symbol name)))
      (body (case rule
          (:all '(anaphex1 args '(,opname)))
          (:first '(anaphex2 ',opname args))
          (:place '(anaphex3 ',opname args)))))
    '(defmacro ,name (&rest args)
      ,body)))

(defun anaphex1 (args call)
  (if args
    (let ((sym (gensym)))
      '(let* ((,sym ,(car args))
          (it ,sym))
        ,(anaphex1 (cdr args)
          (append call (list sym)))))
    call))

(defun anaphex2 (op args)
  '(let ((it ,(car args))) (,op it ,@(cdr args))))

(defun anaphex3 (op args)
  '(_f (lambda (it) (,op it ,@(cdr args))) ,(car args)))

[示例代碼 16.5] 顯示了所有三個(gè)展開器函數(shù)在單獨(dú)一個(gè)宏 defanaph 的控制下拼接在一起的結(jié)果。用戶可以通過可選的 rule 關(guān)鍵字參數(shù)來(lái)設(shè)置目標(biāo)宏展開的類型，這個(gè)參數(shù)指定了在宏調(diào)用中參數(shù)所采用的求值規(guī)則。如果這個(gè)參數(shù)是：

：all (默認(rèn)值) 宏展開將采用alist 模型。宏調(diào)用中所有參數(shù)都將被求值，同時(shí)it 總是被綁定在前一個(gè)參數(shù)的值上。

：first 宏展開將采用aif 模型。只有第一個(gè)參數(shù)是必須求值的，并且it 將被綁定在這個(gè)值上。

：place 宏展開將采用asetf 模型。第一個(gè)參數(shù)被按照廣義變量來(lái)對(duì)待，而it 將被綁定在它的初始值上。

使用新的 defanaph ，前面的一些例子將被定義成下面這樣：

(defanaph alist)
(defanaph aif :rule first)
(defanaph asetf :rule :place)

asetf 的一大優(yōu)勢(shì)是它可以定義出一大類基于廣義變量而不必?fù)?dān)心多重求值問題的宏。例如，我們可以將incf 定義成：

(defmacro incf (place &optional (val 1))
  '(asetf ,place (+ it ,val)))

再比如說 pull ( 12.4 節(jié))：

(defmacro pull (obj place &rest args)
  '(asetf ,place (delete ,obj it ,@args)))

備注：

【注1】盡管這種縮略語(yǔ)不能傳遞給 apply 或者funcall。

【注2】譯者注：這里給出的 asetf 采用了原書勘誤中給出的形式。未勘誤的版本里用 'setf 代替了 '(lambda (x y) (declare (ignore x) y))。這個(gè)版本也是有效的,但其中的 setf 是不必要的,真正的廣義變量賦值操作是由背后的 _f 宏完成的。比較一下后面給出 incf 宏在一個(gè)普通調(diào)用 (incf a 1) 下兩種 asetf 產(chǎn)生的展開式就可以了解這點(diǎn)了。

【注3】譯者注：本書中所有忽略了某些形參的函數(shù)定義都由譯者添加了類似 (declare (ignore char)) 的聲明以免編譯器報(bào)警。