第 15 章 返回函数的宏

第五章已经介绍了如何编写返回函数的函数。宏的应用使得组合操作符这项工作的难度大幅降低。本章将说明如何用宏来构造抽象结构，这些结构和第 5 章里定义的那些抽象是等价的，但是用宏会更清晰和高效。

15.1 函数的构造

若 f 和 g 均为函数，则 f ○g(x) = f(g(x))。 第 5.4 节曾介绍过 把 ○ 实现为 Lisp 函数的方法，这个函数名叫 compose：

[示例代码 15.1] 通用的用于构造函数的宏

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

在本节中，我们将思考如何用宏来定义更好的函数构造器。[示例代码 15.1] 中是一个名为 fn 的通用函数构造器，它能够根据复合函数的描述来构造它们。它的参数应该是一个形如(operator . arguments) 的表达式。

operator 可以是一个函数或宏的名字，也可以是会被区别对待的 compose .Arguments 可以是接受一个参数的函数或宏的名字，或者是可作为 fn 参数的表达式。例如，

(fn (and integerp oddp))

产生一个等价于:

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

的函数。

如果把 compose 用作操作符(operator)，我们就得到一个所有参数复合后得到的函数，但不需要像 compose 被定义为函数时那样的显式 funcall 调用。例如，

(fn (compose list 1+ truncate))

展开成：

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

后者允许对 list 和 1+ 这种简单函数进行内联编译。fn 宏接受一般意义上的操作符名称；- 表达式也是允许的，就像:

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

可以展开成:

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

毫无疑问，这里由λ–表达式表示的函数会被内联编译，要是换成用 sharp-quoted 的λ–表达式作为参数，传给 compose ，那就只得通过 funcall 调用了。

第 5.4 节还展示了另外三个函数构造器的定义：fif ，fint ，以及 fun。这些函数现在被统一到了通用的 fn 宏。使用 and 操作符将产生一个参数操作符的交集：

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

而 or 操作符则产生并集：

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

并且 if 产生的函数，其函数体是条件执行的：

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

不过，我们可用的函数不仅仅限于上面三个：

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

并且 fn 表达式里的参数本身也可以是表达式：

> (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 作为一种特殊情况单独处理，但是这样做并没有增加这个宏的功能。如果你把嵌套的参数传给 fn ，那就可以得到函数的复合。例如，

(fn (list (1+ truncate)))

展开成：

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

这相当于：

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

fn 宏把 compose 单独处理的目的，只是为了提高这种调用的可读性。

15.2 在 cdr 上做递归

第 5.5 和 5.6 节显示了如何编写构造递归函数的函数。接下来两节将介绍指代宏是如何给我们在那里定义的函数提供一个更清晰的接口的。

第 5.5 节显示了如何定义一个称为 lrec 的扁平列表递归器。通过 lrec ，我们可以将下面这个函数：

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

而把 oddp 的调用表示成：

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

在这里，宏可以让我们事半功倍。为了表达一个递归函数，最起码应该说清楚哪几件事情呢？如果用 it 来指代当前列表的 car，并用 rec 指代递归调用，那么我们就可以把它表示成：

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

[示例代码 15.2] 中定义的宏，就允许我们这样做。

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

这个新宏把第二个参数给出的表达式转化成传递给 lrec 的函数，用这种方式实现其功能。由于第二个参数可能会通过指代引用 it 或 rec ，因此，在宏展开式里，函数的主体所处的作用域必须含有为这些符号建立的绑定。

事实上，[示例代码 15.2] 中有两个不同版本的 alrec。前例中使用的版本需要用到符号宏(symbol macro，见第7.11 节)。由于只有较新的 Common Lisp 版本才支持符号宏【注1】，所以[示例代码 15.2] 里也提供了一个相形之下不那么方便的 alrec 版本，其中 rec 被定义成一个局部函数。代价是，rec 作为函数将不得不被包在括号里：

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

在支持 symbol-macrolet 的 Common Lisp 实现里，推荐用最初的版本。

Common Lisp 有独立的函数名字空间，这使得通过这些递归构造器定义有名函数略有不便：

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

[示例代码 15.2] 中最后一个宏的目的就是为了把这一过程变得更抽象一些。借助 on-cdrs ，我们可以只需这样写：

[示例代码 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 函数

(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] 用这个新宏定义了几个已有的 Common Lisp 函数。通过使用 on-cdrs 的表达方式，这些函数化简成了它们最根本的形式，同时，若非这样处理，我们恐怕很难注意到它们间的共同点。

[示例代码 15.4] 中有一些新的实用工具，我们可以很方便地用 on-cdrs 来定义它们。前三个分别是：unions ，intersections，和 differences ，它们分别实现了集合的并、交、以及差的操作。虽然 Common Lisp 的内置函数已经实现了这些操作，但它们每次只能用于两个列表。这样的话，如果我们想要找到三个列表的并集就必须这样写：

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

新的 unions 的行为和 union 相似，但前者能接受任意数量的参数，这样我们只需说：

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

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

在 Common Lisp 的 intersection 和更通用的 intersections 之间也有着同样的关系。在这个函数的定义里，为了改善效率，在最开始的地方加入了对于宏参数的 null 测试；如果集合中存在空集，它将短路掉整个计算过程。

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

[示例代码 15.4] 用 on-cdrs 定义的新实用工具

(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 也有一个称为 set-difference 的函数，它接受两个列表，并返回属于第一个集合但不属于第二个集合的元素：

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

我们的新版本处理多重参数的方式和 - 同出一辙。例如，(differences x y z) 就等价于 (set-difference x (unions y z)) ，只是不像后者那样需要做 cons。

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

这些集合操作符仅仅是作为例子。对于它们没有实际的需要，因为内置的 reduce 已经能处理上面这些例子所示的列表递归的简单情况。例如，不用:

(unions ...)

的话，你也可以说:

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

虽然如此，在一般情况下 on-cdrs 比 reduce 的功能更强。

因为 rec 指向的是一个调用而非一个值，所以我们可以用 on-cdrs 来创建返回多值的函数。[示例代码 15.4] 中最后一个函数，maxmin ，利用这种可能性在一次列表遍历中同时找出最大和最小的元素：

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

后面章节中的代码也可以用上 on-cdrs 。例如，compile-cmds (第 23.4 节)

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

可以简单地定义成：

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

15.3 在子树上递归

宏在列表上进行的递归操作，在子树上也一样可以用递归的方式完成。本节里，我们用宏来给 5.6 节里定义的树递归器定义更加清晰的接口。

在5.6 节里我们定义了两个树递归构造器，分别名为 ttrav 和 trec 。前者总是遍历完整棵树；后者功能更为复杂，但它允许你控制递归停止的时机。借助这些函数，我们可以把 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))))))

表达成

(ttrav #'cons)

而一个对 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))))))

的调用，例如 oddp ，可以表达成：

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

Anaphoric 宏可以为 trec 做出一个更好的接口，就像前一节中它们对 lrec 所做的那样。要满足一般的需求，这个宏将必须能够同时指代引用到三个东西：当前所在树，我们称之为 it；递归下降左子树，我们称之为 left ；以及递归下降右子树，我们称之为 right 。有了这些约定以后，我们就应该可以像下面这样，用新宏来表达前面的函数：

(atrec (cons left right))

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

[示例代码 15.5] 包含有这个宏的定义。

在没有 symbol-macrolet 的 Lisp 版本中，我们可以用 [示例代码 15.5] 中的第二个定义来定义 atrec。这个版本将 left 和 right 定义成局部函数，所以 our-copy-tree 就必须写成：

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

出于便利，我们也定义了一个 on-trees 宏，跟前一节里的 on-cdrs 相似。[示例代码 15.6] 显示了用 on-trees 定义的四个在 5.6 节里定义的函数。

正如第 5 章里提到的，那一章里的递归生成器构造的函数将不是尾递归的。用 on-cdrs 或 on-trees 定义出的函数不一定是最高效的实现。和底层的 trec 和 lrec 一样，这些宏主要用于原型设计以及效率不是关键的那部分程序里面。尽管如此，本章和第 5 章的核心思路是：我们可以先编写函数生成器，然后为它们设计出简洁清爽的宏接口。同样的技术也一样可以用在构造那些能够产生特别高效代码的函数生成器上。

15.4 惰性求值

惰性求值就是说，只有当你需要表达式值的时候，才去求值它。使用惰性求值的方式之一是构造一种叫 delay 的对象。Delay 是某个表达式的值的替代物。它代表着一个承诺，即：如果今后需要的话，就要给出表达式的值。同时，由于这个承诺本身是个 Lisp 对象，因而它代表的值所有的功用，它都责无旁贷，一肩挑起。所以，一旦有需要，delay 就能返回表达式的值。

[示例代码 15.5] 在树上做递归的宏

(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 定义的函数

(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 内置了对 delay 的支持。Scheme 的操作符 force 和 delay 就是为此服务的。用 Common Lisp 的话，可以用 [示例代码 15.7] 中的方法来实现这两个操作符。其中，把 delay 表示成了一个由两部分构成的结构体。第一个字段代表 delay 是否已经被求值了，如果是的话就被赋予这个值。第二个字段则是一个闭包，调用它就能得到该 delay 所代表的值。宏 delay 接受一个表达式，并返回一个代表该表达式值的 delay：

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

若要调用 delay 里的闭包，就得 force 这个 delay。函数 force 接受任意对象：对于普通对象它就是 identity 函数，但对于 delay，它是对 delay 所代表的值的请求。

[示例代码 15.7] force 和 delay 的实现

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

无论何时，只要需要处理的对象有可能是 delay ，就应该用 force 对付它。例如，如果我们正在排序的列表可能含有 delay ，那么就要用：

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

像这样直接用 delay 显得有些笨拙。要是在实际应用中，它们可能会藏身于另一个抽象层之下。

备注：

【注1】 译者注：这些问题现在已经不复存在，几乎所有的现行 Common Lisp 实现(除了GCL，GNU Common Lisp) 都支持 ANSI Common Lisp 标准。和 CLTL2 相比，几乎没有变化。