第十三章 跳转

Scheme的一个显著标志是它支持跳转或者nonlocal control。特别是Scheme允许程序控制跳转到程序的任意位置，相比之下条件语句和函数调用的限制要更多一些。Scheme的nonlocal control操作符是一个名为call-with-current-continuation的过程。下面我们会看到如何用这个操作符创建一些惊人的控制效果。

13.1 call-with-current-continuation

call-with-current-continuation用current-continuation来调用它的参数（一个只有一个参数的过程）【在调用时传入参数current-continuation，译者注】。这就是这个操作符名字的解释了。但是由于这个名字太长，故通常缩写为call/cc[1]。

一个程序执行到任意一点的当前续延【即current-continuation，译者注】是该程序的后半部分【即将要被执行的部分，译者注】。因此在程序：

  1. (+ 1 (call/cc
  2.        (lambda (k)
  3.          (+ 2 (k 3)))))

中，“后边部分”——从call/cc程序的角度来看，是如下的带有一个“洞”的程序（“洞”用[]表示）：

  1. (+ 1 [])

也就是说，该程序的“续延”是一个把1和填到这个“洞”里的东西加起来的程序。

这就是call/cc参数被调用的情况。记住call/cc的参数是过程：

  1. (lambda (k)
  2.   (+ 2 (k 3)))

这个过程的把“续延”（现在绑定在k上）apply到参数3上。这就是这个续延与众不同之处。“续延”调用突然放弃了它自己的计算并把当前的计算换成了k中保存的程序。也就是说，这个程序中加2的操作被放弃了，然后k的参数3直接被发送到了那个带“洞”的程序：

  1. (+ 1 [])

然后程序就简单的变成：

  1. (+ 1 3)

然后返回4。即：

  1. (+ 1 (call/cc
  2.        (lambda (k)
  3.          (+ 2 (k 3)))))

上面的例子叫做“‘退出’续延”，用来退出某个计算过程（这里是(+ 2 [])的计算）。这是一个很有用的功能，但是Scheme的续延可以用来返回到前面放弃计算的地方，然后多次调用它们。程序的“后半部分”意味着一个续延不论我们调用的次数和时间都存在，这也让call/cc更加强大和令人迷惑。看一个简单的例子，在解释器里输入以下代码：

  1. (define r #f)
  3. (+ 1 (call/cc
  4.        (lambda (k)
  5.          (set! r k)
  6.          (+ 2 (k 3)))))
  7. =>  4

后面的表达式和刚才一样返回了4，不同之处在于这次我们把续延k保存到了全局变量r里。

现在我们在r中永久保存了这个续延。如果我们以一个数字为参数调用它，就会返回数字加1后的结果：

  1. (r 5)
  2. =>  6

注意r会放弃它自己的续延，打个比方我们把对r的调用放在一个上下文中：

  1. (+ 3 (r 5))
  2. =>  6

因此call/cc提供的续延是一种“放弃”的续延。

13.2 “退出”续延

“退出”续延是call/cc最简单的用法，而且在退出函数或循环时非常有用。考虑一个过程list-product接收一个数字列表并把所有的数乘起来。一个直观的递归定义可以这样写：

  1. (define list-product
  2.   (lambda (s)
  3.     (let recur ((s s))
  4.       (if (null? s) 1
  5.           (* (car s) (recur (cdr s)))))))

这个方法有一个问题。如果列表中有一个数是0，而且0后面还有很多元素，那么结果是可以预知的。如果这样上面的代码会在得出结果前产生很多无意义的递归调用。这就是“退出”续延大显身手的时候。用call/cc，我们可以这样重写这个过程：

  1. (define list-product
  2.   (lambda (s)
  3.     (call/cc
  4.       (lambda (exit)
  5.         (let recur ((s s))
  6.           (if (null? s) 1
  7.               (if (= (car s) 0) (exit 0)
  8.                   (* (car s) (recur (cdr s))))))))))

如果遇到一个为0的元素，续延exit就会以参数0被调用，这样就防止了更多的调用recur。

13.3 树匹配

一个更加复杂的例子是把续延用于解决两个树是否有相同边缘（就是相同的元素（叶节点）有相同的顺序）的问题上。如：

  1. (same-fringe? '(1 (2 3)) '((1 2) 3))
  2. =>  #t
  4. (same-fringe? '(1 2 3) '(1 (3 2)))
  5. =>  #f

纯粹的函数式解决方案是把两个树都抹平然后看结果是否一样。

  1. (define same-fringe?
  2.   (lambda (tree1 tree2)
  3.     (let loop ((ftree1 (flatten tree1))
  4.                (ftree2 (flatten tree2)))
  5.       (cond ((and (null? ftree1) (null? ftree2)) #t)
  6.             ((or (null? ftree1) (null? ftree2)) #f)
  7.             ((eqv? (car ftree1) (car ftree2))
  8.              (loop (cdr ftree1) (cdr ftree2)))
  9.             (else #f)))))
  11. (define flatten
  12.   (lambda (tree)
  13.     (cond ((null? tree) '())
  14.           ((pair? (car tree))
  15.            (append (flatten (car tree))
  16.                    (flatten (cdr tree))))
  17.           (else
  18.            (cons (car tree)
  19.                  (flatten (cdr tree)))))))

然而，这样会遍历整个树来进行抹平操作，而且还要再做一遍这样的操作【遍历被抹平后生成的列表，译者注】才能找到不匹配的元素。退一步讲，即使最好的抹平算法也需要cons（直接修改输入的树是不可以的）

我们可以用call/cc来解决这个问题，不需要遍历，也不需要用cons来拼接。每个树会被map到一个生成器——一个带有内部状态的过程，按照叶节点在树中出现的顺序从左到右连续的输出叶节点。

  1. (define tree->generator
  2.   (lambda (tree)
  3.     (let ((caller '*))
  4.       (letrec
  5.           ((generate-leaves
  6.             (lambda ()
  7.               (let loop ((tree tree))
  8.                 (cond ((null? tree) 'skip)
  9.                       ((pair? tree)
  10.                        (loop (car tree))
  11.                        (loop (cdr tree)))
  12.                       (else
  13.                        (call/cc
  14.                         (lambda (rest-of-tree)
  15.                           (set! generate-leaves
  16.                             (lambda ()
  17.                               (rest-of-tree 'resume)))
  18.                           (caller tree))))))
  19.               (caller '()))))
  20.         (lambda ()
  21.           (call/cc
  22.            (lambda (k)
  23.              (set! caller k)
  24.              (generate-leaves))))))))

当一个tree->generator创建的生成器被调用时，这个生成器会把调用的续延存在caller中，这样它就知道当找到叶节点时把它发送给谁。然后它调用一个内部定义的函数generate-leaves，该函数会从左到右循环遍历这个树。当循环到一个叶节点时，该函数就使用caller来返回该叶节点作为生成器的结果，但是它会记住后续的循环（被call/cc捕获为一个续延）并保存到generate-leaves变量，下次生成器被调用时，循环从刚才终端的地方恢复，这样它可以寻找下一个叶节点。

注意generate-leaves做的最后一件事情，在循环结束后，它返回一个空列表给caller。由于空列表不是一个合法的叶节点，我们可以用它来告诉生成器没有叶节点需要生成了。

过程same-fringe?把树作为参数来创建生成器，然后交替调用这两个生成器。只要一找到两个不同的叶节点就会返回失败。

  1. (define same-fringe?
  2.   (lambda (tree1 tree2)
  3.     (let ((gen1 (tree->generator tree1))
  4.           (gen2 (tree->generator tree2)))
  5.       (let loop ()
  6.         (let ((leaf1 (gen1))
  7.               (leaf2 (gen2)))
  8.           (if (eqv? leaf1 leaf2)
  9.               (if (null? leaf1) #t (loop))
  10.               #f))))))

很容易看到每个树只被遍历了最多一次，在遇到不匹配的情况时，只会遍历最左边的那个不匹配节点【？】。而且没有用到cons。

13.4 协程

上面用到的生成器是一些有趣而普遍的过程概念。每次生成器被调用时，它都恢复计算，而且当它返回前会把它的续延保存在一个内部变量中这样这个生成器可以再次恢复。我们可以对生成器进行推广，这样他们可以相互恢复其他的生成器，并且互相传递结果。这样的过程叫协程。

我们将会看到一个协程作为一元过程，其主体可以包含resume调用，resume是一个两参数的过程，可以被一个协程用来继续执行另一个协程（带着一个转换值）。宏coroutine定义一个这样的协程过程，一个变量名作为协程的初始参数，内容作为协程。

  1. (define-macro coroutine
  2.   (lambda (x . body)
  3.     `(letrec ((+local-control-state (lambda (,x) ,@body))
  4.               (resume
  5.                 (lambda (c v)
  6.                  (call/cc
  7.                   (lambda (k)
  8.                     (set! +local-control-state k)
  9.                     (c v))))))
  10.        (lambda (v)
  11.          (+local-control-state v)))))

调用这个宏可以创建一个协程（我们叫为A），这个协程可以有一个参数。A有一个内部变量叫做+local-control-state来保存任意时刻这个协程接下来的计算。当调用resume时——也就是调用另一个协程B时——当前协程会更新它的+local-control-state变量为之后的计算，然后停止，然后跳到恢复了的协程B，当协程A之后恢复时，它的计算会从它+local-control-state变量里存放的续延开始。

13.4.1 用协程进行树匹配

用协程会进一步简化树匹配的操作。匹配过程被编写为一个协程，该协程依赖另外两个协程提供各自的叶节点。

  1. (define make-matcher-coroutine
  2.   (lambda (tree-cor-1 tree-cor-2)
  3.     (coroutine dont-need-an-init-arg
  4.       (let loop ()
  5.         (let ((leaf1 (resume tree-cor-1 'get-a-leaf))
  6.               (leaf2 (resume tree-cor-2 'get-a-leaf)))
  7.           (if (eqv? leaf1 leaf2)
  8.               (if (null? leaf1) #t (loop))
  9.               #f))))))

叶生成器协程会记住把它的节点返回给谁：

  1. (define make-leaf-gen-coroutine
  2.   (lambda (tree matcher-cor)
  3.     (coroutine dont-need-an-init-arg
  4.       (let loop ((tree tree))
  5.         (cond ((null? tree) 'skip)
  6.               ((pair? tree)
  7.                (loop (car tree))
  8.                (loop (cdr tree)))
  9.               (else
  10.                (resume matcher-cor tree))))
  11.       (resume matcher-cor '()))))

现在过程same-fringe?可以这样写：

  1. (define same-fringe?
  2.   (lambda (tree1 tree2)
  3.     (letrec ((tree-cor-1
  4.               (make-leaf-gen-coroutine
  5.                tree1
  6.                matcher-cor))
  7.              (tree-cor-2
  8.               (make-leaf-gen-coroutine
  9.                tree2
  10.                matcher-cor))
  11.              (matcher-cor
  12.               (make-matcher-coroutine
  13.                tree-cor-1
  14.                tree-cor-2)))
  15.       (matcher-cor 'start-ball-rolling))))

不幸的是Scheme的letrec语句如果想解析它引入的词法变量的相互递归调用，必须得把这个引用包围在一个lambda里。所以我们得这么写：

  1. (define same-fringe?
  2.   (lambda (tree1 tree2)
  3.     (letrec ((tree-cor-1
  4.               (make-leaf-gen-coroutine
  5.                tree1
  6.                (lambda (v) (matcher-cor v))))
  7.              (tree-cor-2
  8.               (make-leaf-gen-coroutine
  9.                tree2
  10.                (lambda (v) (matcher-cor v))))
  11.              (matcher-cor
  12.               (make-matcher-coroutine
  13.                (lambda (v) (tree-cor-1 v))
  14.                (lambda (v) (tree-cor-2 v)))))
  15.       (matcher-cor 'start-ball-rolling))))

注意在这个版本的same-fringe里完全没有调用call/cc的痕迹。宏coroutine帮助我们处理了所有的协程。

[1]: 如果你的Scheme没有call/cc这个缩写，那么在你的初始化代码里加入(define call/cc call-with-current-continuation)，这样可以减少敲击键盘造成的手部劳损：）