第 15 章 返回函數(shù)的宏

第 15 章 返回函數(shù)的宏

第五章已經(jīng)介紹了如何編寫(xiě)返回函數(shù)的函數(shù)。宏的應(yīng)用使得組合操作符這項(xiàng)工作的難度大幅降低。本章將說(shuō)明如何用宏來(lái)構(gòu)造抽象結(jié)構(gòu)，這些結(jié)構(gòu)和第 5 章里定義的那些抽象是等價(jià)的，但是用宏會(huì)更清晰和高效。

15.1 函數(shù)的構(gòu)造

若?f?和?g?均為函數(shù)，則?f ○g(x) = f(g(x))。 第 5.4 節(jié)曾介紹過(guò) 把?○?實(shí)現(xiàn)為 Lisp 函數(shù)的方法，這個(gè)函數(shù)名叫?compose：

[示例代碼 15.1] 通用的用于構(gòu)造函數(shù)的宏

> (funcall (compose #'list #'1+) 2)
(3)

(defmacro fn (expr) '#',(rbuild expr))

(defun rbuild (expr)
  (if (or (atom expr) (eq (car expr) 'lambda))
    expr
    (if (eq (car expr) 'compose)
      (build-compose (cdr expr))
      (build-call (car expr) (cdr expr)))))

(defun build-call (op fns)
  (let ((g (gensym)))
    '(lambda (,g)
      (,op ,@(mapcar #'(lambda (f)
            '(,(rbuild f) ,g))
          fns)))))

(defun build-compose (fns)
  (let ((g (gensym)))
    '(lambda (,g)
      ,(labels ((rec (fns)
            (if fns
              '(,(rbuild (car fns))
                ,(rec (cdr fns)))
              g)))
        (rec fns)))))

在本節(jié)中，我們將思考如何用宏來(lái)定義更好的函數(shù)構(gòu)造器。[示例代碼 15.1] 中是一個(gè)名為?fn?的通用函數(shù)構(gòu)造器，它能夠根據(jù)復(fù)合函數(shù)的描述來(lái)構(gòu)造它們。它的參數(shù)應(yīng)該是一個(gè)形如(operator . arguments)?的表達(dá)式。

operator?可以是一個(gè)函數(shù)或宏的名字，也可以是會(huì)被區(qū)別對(duì)待的?compose .Arguments?可以是接受一個(gè)參數(shù)的函數(shù)或宏的名字，或者是可作為?fn?參數(shù)的表達(dá)式。例如，

(fn (and integerp oddp))

產(chǎn)生一個(gè)等價(jià)于:

#'(lambda (x) (and (integerp x) (oddp x)))

的函數(shù)。

如果把?compose?用作操作符(operator)，我們就得到一個(gè)所有參數(shù)復(fù)合后得到的函數(shù)，但不需要像 compose 被定義為函數(shù)時(shí)那樣的顯式?funcall?調(diào)用。例如，

(fn (compose list 1+ truncate))

展開(kāi)成：

#'(lambda (#:g1) (list (1+ (truncate #:g1))))

后者允許對(duì)?list?和?1+?這種簡(jiǎn)單函數(shù)進(jìn)行內(nèi)聯(lián)編譯。fn?宏接受一般意義上的操作符名稱；-?表達(dá)式也是允許的，就像:

(fn (compose (lambda (x) (+ x 3)) truncate))

可以展開(kāi)成:

#'(lambda (#:g2) ((lambda (x) (+ x 3)) (truncate #:g2)))

毫無(wú)疑問(wèn)，這里由λ–表達(dá)式表示的函數(shù)會(huì)被內(nèi)聯(lián)編譯，要是換成用?sharp-quoted?的λ–表達(dá)式作為參數(shù)，傳給?compose?，那就只得通過(guò)?funcall?調(diào)用了。

第 5.4 節(jié)還展示了另外三個(gè)函數(shù)構(gòu)造器的定義：fif?，fint?，以及?fun。這些函數(shù)現(xiàn)在被統(tǒng)一到了通用的?fn?宏。使用?and?操作符將產(chǎn)生一個(gè)參數(shù)操作符的交集：

> (mapcar (fn (and integerp oddp))
  '(c 3 p 0))
(NIL T NIL NIL)

而?or?操作符則產(chǎn)生并集：

> (mapcar (fn (or integerp symbolp))
  '(c 3 p 0.2))
(T T T NIL)

并且?if?產(chǎn)生的函數(shù)，其函數(shù)體是條件執(zhí)行的：

> (map1-n (fn (if oddp 1+ identity)) 6)
(2 2 4 4 6 6)

不過(guò)，我們可用的函數(shù)不僅僅限于上面三個(gè)：

> (mapcar (fn (list 1- identity 1+))
  '(1 2 3))
((0 1 2) (1 2 3) (2 3 4))

并且?fn?表達(dá)式里的參數(shù)本身也可以是表達(dá)式：

> (remove-if (fn (or (and integerp oddp)
      (and consp cdr)))
  '(1 (a b) c (d) 2 3.4 (e f g)))
(C (D) 2 3.4)

這里雖然?fn?把?compose?作為一種特殊情況單獨(dú)處理，但是這樣做并沒(méi)有增加這個(gè)宏的功能。如果你把嵌套的參數(shù)傳給?fn?，那就可以得到函數(shù)的復(fù)合。例如，

(fn (list (1+ truncate)))

展開(kāi)成：

#'(lambda (#:g1)
  (list ((lambda (#:g2) (1+ (truncate #:g2))) #:g1)))

這相當(dāng)于：

(compose #'list #'1+ #'truncate)

fn?宏把?compose?單獨(dú)處理的目的，只是為了提高這種調(diào)用的可讀性。

15.2 在?cdr?上做遞歸

第 5.5 和 5.6 節(jié)顯示了如何編寫(xiě)構(gòu)造遞歸函數(shù)的函數(shù)。接下來(lái)兩節(jié)將介紹指代宏是如何給我們?cè)谀抢锒x的函數(shù)提供一個(gè)更清晰的接口的。

第 5.5 節(jié)顯示了如何定義一個(gè)稱為?lrec?的扁平列表遞歸器。通過(guò)?lrec?，我們可以將下面這個(gè)函數(shù)：

(defun our-every (fn lst)
  (if (null lst)
    t
    (and (funcall fn (car lst))
      (our-every fn (cdr lst)))))

而把 oddp 的調(diào)用表示成：

(lrec #'(lambda (x f) (and (oddp x) (funcall f)))
  t)

在這里，宏可以讓我們事半功倍。為了表達(dá)一個(gè)遞歸函數(shù)，最起碼應(yīng)該說(shuō)清楚哪幾件事情呢？如果用 it 來(lái)指代當(dāng)前列表的 car，并用 rec 指代遞歸調(diào)用，那么我們就可以把它表示成：

(alrec (and (oddp it) rec) t)

[示例代碼 15.2] 中定義的宏，就允許我們這樣做。

> (funcall (alrec (and (oddp it) rec) t)
  '(1 3 5))
T

這個(gè)新宏把第二個(gè)參數(shù)給出的表達(dá)式轉(zhuǎn)化成傳遞給 lrec 的函數(shù)，用這種方式實(shí)現(xiàn)其功能。由于第二個(gè)參數(shù)可能會(huì)通過(guò)指代引用 it 或 rec ，因此，在宏展開(kāi)式里，函數(shù)的主體所處的作用域必須含有為這些符號(hào)建立的綁定。

事實(shí)上，[示例代碼 15.2] 中有兩個(gè)不同版本的 alrec。前例中使用的版本需要用到符號(hào)宏(symbol macro，見(jiàn)第7.11 節(jié))。由于只有較新的 Common Lisp 版本才支持符號(hào)宏【注1】，所以[示例代碼 15.2] 里也提供了一個(gè)相形之下不那么方便的?alrec?版本，其中?rec?被定義成一個(gè)局部函數(shù)。代價(jià)是，rec 作為函數(shù)將不得不被包在括號(hào)里：

(alrec (and (oddp it) (rec)) t)

在支持?symbol-macrolet?的 Common Lisp 實(shí)現(xiàn)里，推薦用最初的版本。

Common Lisp 有獨(dú)立的函數(shù)名字空間，這使得通過(guò)這些遞歸構(gòu)造器定義有名函數(shù)略有不便：

(setf (symbol-function 'our-length)
  (alrec (1+ rec) 0))

[示例代碼 15.2] 中最后一個(gè)宏的目的就是為了把這一過(guò)程變得更抽象一些。借助?on-cdrs?，我們可以只需這樣寫(xiě)：

[示例代碼 15.2] 遞歸列表的宏

(defun our-length (lst)
  (on-cdrs (1+ rec) 0 lst))

(defun our-every (fn lst)
  (on-cdrs (and (funcall fn it) rec) t lst))

(defmacro alrec (rec &optional base)
  "cltl2 version"
  (let ((gfn (gensym)))
    '(lrec #'(lambda (it ,gfn)
        (symbol-macrolet ((rec (funcall ,gfn)))
          ,rec))
      ,base)))

(defmacro alrec (rec &optional base)
  "cltl1 version"
  (let ((gfn (gensym)))
    '(lrec #'(lambda (it ,gfn)
        (labels ((rec () (funcall ,gfn)))
          ,rec))
      ,base)))

(defmacro on-cdrs (rec base &rest lsts)
  '(funcall (alrec ,rec #'(lambda () ,base)) ,@lsts))

[示例代碼 15.3] 用 on-cdrs 定義的 Common Lisp 函數(shù)

(defun our-copy-list (lst)
  (on-cdrs (cons it rec) nil lst))

(defun our-remove-duplicates (lst)
  (on-cdrs (adjoin it rec) nil lst))

(defun our-find-if (fn lst)
  (on-cdrs (if (funcall fn it) it rec) nil lst))

(defun our-some (fn lst)
  (on-cdrs (or (funcall fn it) rec) nil lst))

[示例代碼 15.3] 用這個(gè)新宏定義了幾個(gè)已有的 Common Lisp 函數(shù)。通過(guò)使用?on-cdrs?的表達(dá)方式，這些函數(shù)化簡(jiǎn)成了它們最根本的形式，同時(shí)，若非這樣處理，我們恐怕很難注意到它們間的共同點(diǎn)。

[示例代碼 15.4] 中有一些新的實(shí)用工具，我們可以很方便地用?on-cdrs?來(lái)定義它們。前三個(gè)分別是：unions?，intersections，和?differences?，它們分別實(shí)現(xiàn)了集合的并、交、以及差的操作。雖然 Common Lisp 的內(nèi)置函數(shù)已經(jīng)實(shí)現(xiàn)了這些操作，但它們每次只能用于兩個(gè)列表。這樣的話，如果我們想要找到三個(gè)列表的并集就必須這樣寫(xiě)：

> (union '(a b) (union '(b c) '(c d)))
(A B C D)

新的?unions?的行為和?union?相似，但前者能接受任意數(shù)量的參數(shù)，這樣我們只需說(shuō)：

> (unions '(a b) '(b c) '(c d))
(D C A B)

和 union 一樣，unions 并不保持初始列表中的元素順序。

在 Common Lisp 的?intersection?和更通用的?intersections?之間也有著同樣的關(guān)系。在這個(gè)函數(shù)的定義里，為了改善效率，在最開(kāi)始的地方加入了對(duì)于宏參數(shù)的?null?測(cè)試；如果集合中存在空集，它將短路掉整個(gè)計(jì)算過(guò)程。

(defun unions (&rest sets)
  (on-cdrs (union it rec) (car sets) (cdr sets)))

[示例代碼 15.4] 用 on-cdrs 定義的新實(shí)用工具

(defun intersections (&rest sets)
  (unless (some #'null sets)
    (on-cdrs (intersection it rec) (car sets) (cdr sets))))

(defun differences (set &rest outs)
  (on-cdrs (set-difference rec it) set outs))

(defun maxmin (args)
  (when args
    (on-cdrs (multiple-value-bind (mx mn) rec
        (values (max mx it) (min mn it)))
      (values (car args) (car args))
      (cdr args))))

Common Lisp 也有一個(gè)稱為?set-difference?的函數(shù)，它接受兩個(gè)列表，并返回屬于第一個(gè)集合但不屬于第二個(gè)集合的元素：

> (set-difference '(a b c d) '(a c))
(D B)

我們的新版本處理多重參數(shù)的方式和?-?同出一轍。例如，(differences x y z)?就等價(jià)于?(set-difference x (unions y z))?，只是不像后者那樣需要做?cons。

> (differences '(a b c d e) '(a f) '(d))
(B C E)

這些集合操作符僅僅是作為例子。對(duì)于它們沒(méi)有實(shí)際的需要，因?yàn)閮?nèi)置的?reduce?已經(jīng)能處理上面這些例子所示的列表遞歸的簡(jiǎn)單情況。例如，不用:

(unions ...)

的話，你也可以說(shuō):

((lambda (&rest args) (reduce #'union args)) ...)

雖然如此，在一般情況下?on-cdrs?比?reduce?的功能更強(qiáng)。

因?yàn)?rec?指向的是一個(gè)調(diào)用而非一個(gè)值，所以我們可以用?on-cdrs?來(lái)創(chuàng)建返回多值的函數(shù)。[示例代碼 15.4] 中最后一個(gè)函數(shù)，maxmin?，利用這種可能性在一次列表遍歷中同時(shí)找出最大和最小的元素：

> (maxmin '(3 4 2 8 5 1 6 7))
8
1

后面章節(jié)中的代碼也可以用上?on-cdrs?。例如，compile-cmds?(第 23.4 節(jié))

(defun compile-cmds (cmds)
  (if (null cmds)
    'regs
    '(,@(car cmds) ,(compile-cmds (cdr cmds)))))

可以簡(jiǎn)單地定義成：

(defun compile-cmds (cmds)
  (on-cdrs '(,@it ,rec) 'regs cmds))

15.3 在子樹(shù)上遞歸

宏在列表上進(jìn)行的遞歸操作，在子樹(shù)上也一樣可以用遞歸的方式完成。本節(jié)里，我們用宏來(lái)給 5.6 節(jié)里定義的樹(shù)遞歸器定義更加清晰的接口。

在5.6 節(jié)里我們定義了兩個(gè)樹(shù)遞歸構(gòu)造器，分別名為?ttrav?和?trec?。前者總是遍歷完整棵樹(shù)；后者功能更為復(fù)雜，但它允許你控制遞歸停止的時(shí)機(jī)。借助這些函數(shù)，我們可以把?our-copy-tree?:

(defun our-copy-tree (tree)
  (if (atom tree)
    tree
    (cons (our-copy-tree (car tree))
      (if (cdr tree) (our-copy-tree (cdr tree))))))

表達(dá)成

(ttrav #'cons)

而一個(gè)對(duì)?rfind-if:

(defun rfind-if (fn tree)
  (if (atom tree)
    (and (funcall fn tree) tree)
    (or (rfind-if fn (car tree))
      (and (cdr tree) (rfind-if fn (cdr tree))))))

的調(diào)用，例如?oddp?，可以表達(dá)成：

(trec #'(lambda (o l r) (or (funcall l) (funcall r)))
  #'(lambda (tree) (and (oddp tree) tree)))

Anaphoric?宏可以為?trec?做出一個(gè)更好的接口，就像前一節(jié)中它們對(duì)?lrec?所做的那樣。要滿足一般的需求，這個(gè)宏將必須能夠同時(shí)指代引用到三個(gè)東西：當(dāng)前所在樹(shù)，我們稱之為 it；遞歸下降左子樹(shù)，我們稱之為?left?；以及遞歸下降右子樹(shù)，我們稱之為?right?。有了這些約定以后，我們就應(yīng)該可以像下面這樣，用新宏來(lái)表達(dá)前面的函數(shù)：

(atrec (cons left right))

(atrec (or left right) (and (oddp it) it))

[示例代碼 15.5] 包含有這個(gè)宏的定義。

在沒(méi)有?symbol-macrolet?的?Lisp?版本中，我們可以用 [示例代碼 15.5] 中的第二個(gè)定義來(lái)定義atrec。這個(gè)版本將?left?和?right?定義成局部函數(shù)，所以?our-copy-tree?就必須寫(xiě)成：

(atrec (cons (left) (right)))

出于便利，我們也定義了一個(gè)?on-trees?宏，跟前一節(jié)里的?on-cdrs?相似。[示例代碼 15.6] 顯示了用?on-trees?定義的四個(gè)在 5.6 節(jié)里定義的函數(shù)。

正如第 5 章里提到的，那一章里的遞歸生成器構(gòu)造的函數(shù)將不是尾遞歸的。用?on-cdrs?或?on-trees?定義出的函數(shù)不一定是最高效的實(shí)現(xiàn)。和底層的?trec?和?lrec?一樣，這些宏主要用于原型設(shè)計(jì)以及效率不是關(guān)鍵的那部分程序里面。盡管如此，本章和第 5 章的核心思路是：我們可以先編寫(xiě)函數(shù)生成器，然后為它們?cè)O(shè)計(jì)出簡(jiǎn)潔清爽的宏接口。同樣的技術(shù)也一樣可以用在構(gòu)造那些能夠產(chǎn)生特別高效代碼的函數(shù)生成器上。

15.4 惰性求值

惰性求值就是說(shuō)，只有當(dāng)你需要表達(dá)式值的時(shí)候，才去求值它。使用惰性求值的方式之一是構(gòu)造一種叫?delay?的對(duì)象。Delay?是某個(gè)表達(dá)式的值的替代物。它代表著一個(gè)承諾，即：如果今后需要的話，就要給出表達(dá)式的值。同時(shí)，由于這個(gè)承諾本身是個(gè) Lisp 對(duì)象，因而它代表的值所有的功用，它都責(zé)無(wú)旁貸，一肩挑起。所以，一旦有需要，delay?就能返回表達(dá)式的值。

[示例代碼 15.5] 在樹(shù)上做遞歸的宏

(defmacro atrec (rec &optional (base 'it))
  "cltl2 version"
  (let ((lfn (gensym)) (rfn (gensym)))
    '(trec #'(lambda (it ,lfn ,rfn)
        (symbol-macrolet ((left (funcall ,lfn))
            (right (funcall ,rfn)))
          ,rec))
      #'(lambda (it) ,base))))

(defmacro atrec (rec &optional (base 'it))
  "cltl1 version"
  (let ((lfn (gensym)) (rfn (gensym)))
    '(trec #'(lambda (it ,lfn ,rfn)
        (labels ((left () (funcall ,lfn))
            (right () (funcall ,rfn)))
          ,rec))
      #'(lambda (it) ,base))))

(defmacro on-trees (rec base &rest trees)
  '(funcall (atrec ,rec ,base) ,@trees))

[示例代碼 15.6] 用 on-trees 定義的函數(shù)

(defun our-copy-tree (tree)
  (on-trees (cons left right) it tree))

(defun count-leaves (tree)
  (on-trees (+ left (or right 1)) 1 tree))

(defun flatten (tree)
  (on-trees (nconc left right) (mklist it) tree))

(defun rfind-if (fn tree)
  (on-trees (or left right)
    (and (funcall fn it) it)
    tree))

Scheme 內(nèi)置了對(duì) delay 的支持。Scheme 的操作符 force 和 delay 就是為此服務(wù)的。用 Common Lisp 的話，可以用 [示例代碼 15.7] 中的方法來(lái)實(shí)現(xiàn)這兩個(gè)操作符。其中，把 delay 表示成了一個(gè)由兩部分構(gòu)成的結(jié)構(gòu)體。第一個(gè)字段代表 delay 是否已經(jīng)被求值了，如果是的話就被賦予這個(gè)值。第二個(gè)字段則是一個(gè)閉包，調(diào)用它就能得到該 delay 所代表的值。宏 delay 接受一個(gè)表達(dá)式，并返回一個(gè)代表該表達(dá)式值的 delay：

> (let ((x 2))
  (setq d (delay (1+ x))))
#S(DELAY ...)

若要調(diào)用 delay 里的閉包，就得 force 這個(gè) delay。函數(shù) force 接受任意對(duì)象：對(duì)于普通對(duì)象它就是 identity 函數(shù)，但對(duì)于 delay，它是對(duì) delay 所代表的值的請(qǐng)求。

[示例代碼 15.7] force 和 delay 的實(shí)現(xiàn)

> (force 'a)
A

(defconstant unforced (gensym))

(defstruct delay forced closure)

(defmacro delay (expr)
  (let ((self (gensym)))
    '(let ((,self (make-delay :forced unforced)))
      (setf (delay-closure ,self)
        #'(lambda ()
          (setf (delay-forced ,self) ,expr)))
      ,self)))

(defun force (x)
  (if (delay-p x)
    (if (eq (delay-forced x) unforced)
      (funcall (delay-closure x))
      (delay-forced x))
    x))

> (force d)
3

無(wú)論何時(shí)，只要需要處理的對(duì)象有可能是 delay ，就應(yīng)該用 force 對(duì)付它。例如，如果我們正在排序的列表可能含有 delay ，那么就要用：

(sort lst #'(lambda (x y) (> (force x) (force y))))

像這樣直接用 delay 顯得有些笨拙。要是在實(shí)際應(yīng)用中，它們可能會(huì)藏身于另一個(gè)抽象層之下。

備注：

【注1】 譯者注：這些問(wèn)題現(xiàn)在已經(jīng)不復(fù)存在，幾乎所有的現(xiàn)行 Common Lisp 實(shí)現(xiàn)(除了GCL，GNU Common Lisp) 都支持 ANSI Common Lisp 標(biāo)準(zhǔn)。和 CLTL2 相比，幾乎沒(méi)有變化。