▼ 编程语言要素
► 6  续文传递风格
On this page:
6.1 写出续文传递风格的程序
6.2 尾式
6.3 转换为续文传递风格
6.4 建模计算效果
    contents   ← prev  up  next → 

6 续文传递风格

在传递续文的解释器，我们把解释器中的所有主要过程调用重写成尾调用。这样，我们 保证任何时候，不论执行的程序多大或多复杂，解释器只使用有限的控制上下文。这种性质 叫做迭代性控制行为。

我们通过给每个过程多传一个续文参数实现这一目标。这种编程风格 叫做续文传递风格 (continuation-passing style) 或 CPS，且不限 于解释器。

本章，我们介绍一种系统性的方法，将任一过程转换为具有迭代性控制行为的等效过程。实 现这一点需要将过程转换为续文传递风格。

6.1 写出续文传递风格的程序

除了写解释器，CPS 还有别的作用。我们考虑“老熟人”阶乘程序：

(define fact
  (lambda (n)
    (if (zero? n) 1 (* n (fact (- n 1))))))

阶乘的传递续文版本是：

(define fact
  (lambda (n)
    (fact/k n (end-cont))))
 
(define fact/k
  (lambda (n cont)
    (if (zero? n)
      (apply-cont cont 1)
      (fact/k (- n 1) (fact1-cont n cont)))))

其中，

(apply-cont (end-cont) val) = val

 

(apply-cont (fact1-cont n cont) val) = val

= (apply-cont cont (* n val))

在这一版内，fact/k 和 apply-cont 中的所有调用都在末尾，因此不产生控制 上下文。

我们可以用数据结构实现这些续文：

(define-datatype continuation continuation?
  (end-cont)
  (fact1-cont
   (n integer?)
   (cont continuation?)))
 
(define apply-cont
  (lambda (cont val)
    (cases continuation cont
      (end-cont () val)
      (fact1-cont (saved-n saved-cont)
        (apply-cont saved-cont (* saved-n val))))))

我们还能以多种方式转换这一程序，比如寄存它，如 所示。

我们甚至能将其转为跳跃式，如 所示。如果用普通的指令式语言， 我们自然能将跳床替换为适当的循环。

但是，本章我们主要关心，用过程表示法（如）时会发生什么。回忆 一下，在过程表示法中，续文用它在 apply-cont 中的动作表示。过程表示为：

(define end-cont
  (lambda ()
    (lambda (val) val)))
 
(define fact1-cont
  (lambda (n saved-cont)
    (lambda (val)
      (apply-cont saved-cont (* n val)))))
 
(define apply-cont
  (lambda (cont val)
    (cont val)))

[!ht]
(define n 'uninitialized)
(define cont 'uninitialized)
(define val 'uninitialized)
 
(define fact
  (lambda (arg-n)
    (set! cont (end-cont))
    (set! n arg-n)
    (fact/k)))
 
(define fact/k
  (lambda ()
    (if (zero? n)
      (begin
        (set! val 1)
        (apply-cont))
      (begin
        (set! cont (fact1-cont n cont))
        (set! n (- n 1))
        (fact/k)))))
 
(define apply-cont
  (lambda ()
    (cases continuation cont
      (end-cont () val)
      (fact1-cont (saved-n saved-cont)
        (set! cont saved-cont)
        (set! val (* saved-n val))
        (apply-cont)))))

寄存后的 fact/k

我们还可以更进一步，将程序中所有调用续文构造器的地方替换为其定义。因为定义在行内 展开，这一转换叫做内联 (inlining)。我们还要内联 apply-cont 的调用， 不再写 (apply-cont cont val)，而是直接写 (cont val)。

(define n 'uninitialized)
(define cont 'uninitialized)
(define val 'uninitialized)
(define pc 'uninitialized)
 
(define fact
  (lambda (arg-n)
    (set! cont (end-cont))
    (set! n arg-n)
    (set! pc fact/k)
    (trampoline!)
    val))
 
(define trampoline!
  (lambda ()
    (if (procedure? pc)
      (begin
        (pc)
        (trampoline!)))))
 
 
(define fact/k
  (lambda ()
    (if (zero? n)
      (begin
        (set! val 1)
        (set! pc apply-cont))
      (begin
        (set! cont (fact1-cont n cont))
        (set! n (- n 1))
        (set! pc fact/k)))))
 
(define apply-cont
  (lambda ()
    (cases continuation cont
      (end-cont
        ()
        (set! pc #f))
      (fact1-cont
        (n saved-cont)
        (set! cont saved-cont)
        (set! val (* n val))
        (set! pc apply-cont)))))

寄存后的跳跃式 fact/k

如果我们按这种方式内联所有用到续文的地方，我们得到：

(define fact
  (lambda (n)
    (fact/k n (lambda (val) val))))
 
(define fact/k
  (lambda (n cont)
    (if (zero? n)
      (cont 1)
      (fact/k (- n 1) (lambda (val) (cont (* n val)))))))

fact/k 的定义可以读作：

若 n 为 0，将 1 传给续文；否则，求 n-1 的 fact，求值所在的续文，取 其结果 val，然后将 (* n val) 的值传给当前续文。

过程 fact/k 具有性质 (fact/k n g) = (g n!)。对 n 使用归纳法很容易证明这条性质。第一步，当 n = 0，我们计算：

(fact/k 0 g) = (g 1) = (g (fact 0))

归纳步骤中，对某个 n，设 (fact/k n g) = (g n!)，试证明 (fact/k (n + 1) g) = (g (n + 1)!)。要证明它，我们计算：

(fact/k n + 1 g)

= (fact/k n (lambda (val) (g (* n + 1 val))))

= ((lambda (val) (g (* n + 1 val)))   （根据归纳假设）

   (fact n))

= (g (* n + 1 (fact n)))

= (g (fact n + 1))

归纳完毕。

像辅助过程和上下文参数一样，这里的 g 是上下文参数；性质 (fact/k n g) = (g n!) 作为独立规范，遵循我们的原则避免神秘小工具。

现在，我们用同样的方式转换计算斐波那契数列的 fib。我们从下面的过程开始：

(define fib
  (lambda (n)
    (if ( << /span> n 2)
      1
      (+
        (fib (- n 1))
        (fib (- n 2))))))

这里我们两次递归调用 fib，所以我们需要一个 end-cont 和两个续文构造器， 二者各对应一个参数，就像处理传递续文的解释器中的差值表达式那样。

(define fib
  (lambda (n)
    (fib/k n (end-cont))))
 
(define fib/k
  (lambda (n cont)
    (if ( << /span> n 2)
      (apply-cont cont 1)
      (fib/k (- n 1) (fib1-cont n cont)))))

(apply-cont (end-cont) val) = val

 

(apply-cont (fib1-cont n cont) val1)

= (fib/k (- n 2) (fib2-cont val1 cont))

 

(apply-cont (fib2-cont val1 cont) val2)

= (apply-cont cont (+ val1 val2))

在过程表示法中，我们有：

(define end-cont
  (lambda ()
    (lambda (val) val)))
 
(define fib1-cont
  (lambda (n cont)
    (lambda (val1)
      (fib/k (- n 2) (fib2-cont val1 cont)))))
 
(define fib2-cont
  (lambda (val1 cont)
    (lambda (val2)
      (apply-cont cont (+ val1 val2)))))
 
(define apply-cont
  (lambda (cont val)
    (cont val)))

如果我们内联所有使用这些过程的地方，可得：

(define fib
  (lambda (n)
    (fib/k n (lambda (val) val))))
 
(define fib/k
  (lambda (n cont)
    (if ( << /span> n 2)
      (cont 1)
      (fib/k (- n 1)
        (lambda (val1)
          (fib/k (- n 2)
            (lambda (val2)
              (cont (+ val1 val2)))))))))

类似阶乘，我们可以把这个定义读作：

若 n < 2，将 1 传给续文。否则，处理 n-1，求值所在的续文，取其结果 val1，然后处理 val2，求值所在的续文，取其结果 val2，然后将 (+ val1 val2) 的值传给当前续文。

用推导 fact 的方式，很容易得出，对任意 g，(fib/k n g) = (g (fib n))。这里有个假想的例子，推广了这一想法：

(lambda (x)
  (cond
   ((zero? x) 17)
   ((= x 1) (f x))
   ((= x 2) (+ 22 (f x)))
   ((= x 3) (g 22 (f x)))
   ((= x 4) (+ (f x) 33 (g y)))
   (else (h (f x) (- 44 y) (g y)))))

变成：

(lambda (x cont)
  (cond
   ((zero? x) (cont 17))
   ((= x 1) (f x cont))
   ((= x 2) (f x (lambda (v1) (cont (+ 22 v1)))))
   ((= x 3) (f x (lambda (v1) (g 22 v1 cont))))
   ((= x 4) (f x (lambda (v1)
                   (g y (lambda (v2)
                          (cont (+ v1 33 v2))))))
   (else (f x (lambda (v1)
                (g y (lambda (v2)
                       (h v1 (- 44 y) v2 cont)))))))))

其中，过程 f、g 和 h 都以类似方式转换。

  • 在 (zero? x) 这一行，我们将 17 返回给续文。

  • 在 (= x 1) 这一行，我们按尾递归的方式调用 f。

  • 在 (= x 2) 这一行，我们在加法的操作数位置调用 f。

  • 在 (= x 3) 这一行，我们在过程调用的操作数位置调用 f。

  • 在 (= x 4) 这一行，有两个过程调用在加法的操作数位置。

  • 在 else 这一行，有两个过程调用在另一个过程调用内的操作数位置。

从这些例子中浮现出一种模式。

CPS 秘方

要将程序转换为续文传递风格：

  1. 给每个过程传一个额外参数（通常是 cont 或 k）。

  2. 不论过程返回常量还是变量，都将返回值传给续文，就像上面的 (cont 17)。

  3. 过程调用在尾部时，用同样的续文 cont 调用过程。

  4. 过程调用在操作数位置时，在新的续文中求过程调用的值，这个续文给调用结果命 名，继续进行计算。

这些规则虽不正式，但足以解释这种模式。

\textnormal{[}{\star}\textnormal{]} 考虑，为什么移除 fact/k 定义中的 (set! pc fact/k) 和 apply-cont 中定义的 (set! pc apply-cont)，程序仍能正常运行？

\textnormal{[}{\star}\textnormal{]} 用归纳法证明：对任意 g，(fib/k n g) = (g (fib n))，归纳 变量为 n。

\textnormal{[}{\star}\textnormal{]} 把下面每个 Scheme 表达式重写为续文传递风格。假设所有未知函数都已经重写成 CPS 风 格。

  1. (lambda (x y) (p (+ 8 x) (q y)))

  2. (lambda (x y u v) (+ 1 (f (g x y) (+ u v))))

  3. (+ 1 (f (g x y) (+ u (h v))))

  4. (zero? (if a (p x) (p y)))

  5. (zero? (if (f a) (p x) (p y)))

  6. (let ((x (let ((y 8)) (p y)))) x)

  7. (let ((x (if a (p x) (p y)))) x)

\textnormal{[}{\star}{\star}\textnormal{]}  把下面的所有过程重写为续文传递风格。表示每个过程的续文时，先用数据结构表示法，然 后用过程表示法，然后用内联过程表示法。最后，写出寄存版本。照传递续文的解释器那样定义 end-cont，验证你实现的这四个版本是尾调用：

(apply-cont (end-cont) val)

= (begin

    (eopl:printf "计算结束.~%")

    (eopl:printf "这句话只能出现一次.~%")

    val)

  1. remove-first（1.2.3 节）

  2. list-sum（1.3 节）

  3. occurs-free?（1.2.4 节）

  4. subst（1.2.5 节）

\textnormal{[}{\star}\textnormal{]} 当我们把表达式重写为CPS时，我们就为表达式中的过程选择了一种求值顺序。把前面的每 个例子重写为CPS，且使过程调用从右向左求值。

\textnormal{[}{\star}\textnormal{]} 在 (lambda (x y) (+ (f (g x)) (h (j y)))) 中，过程调用有多少种不同的求值顺 序？对每种求值顺序，写出对应的 CPS 表达式。

\textnormal{[}{\star}{\star}\textnormal{]}  写出、fig-5.5 和 fig-5.6 中解释器的过 程表示和内联过程表示。

\textnormal{[}{\star}{\star}{\star}\textnormal{]}  写出异常解释器的过程表示和内联过程表示。这极富挑战性，因为我们实际上有 两个观测器，apply-cont 和 apply-handler。提示：考虑修改 cps-recipe的秘方，给每个过程添加两个参数，一个表示 apply-cont 中 续文的行为，一个表示 apply-handler 中续文的行为。

有时，我们能发现更巧妙的方式表示续文。我们重新考虑用过程表示续文的 fact。其 中，我们有两个续文构造器，写作：

(define end-cont
  (lambda ()
    (lambda (val) val)))
 
(define fact1-cont
  (lambda (n cont)
    (lambda (val) (cont (* n val)))))
 
(define apply-cont
  (lambda (cont val)
    (cont val)))

在这个系统中，所有续文都用某个数乘以参数。end-cont 将其参数乘 1，若 cont 将参数乘 k，那么 (fact1 n cont) 将其值乘 k * n。

所以每个续文都形如 (lambda (val) (* k val))。这意味着我们可以用每个续文 仅有的自由变量——数字 k——表示它。用这种表示方式，我们有：

(define end-cont
  (lambda ()
    1))
 
(define fact1-cont
  (lambda (n cont)
    (* cont n)))
 
(define apply-cont
  (lambda (cont val)
    (* cont val)))

如果我们在 fact/k 的原始定义中内联这些过程，并使用性质 (* cont 1) = cont，可得：

(define fact
  (lambda (n)
    (fact/k n 1)))
 
(define fact/k
  (lambda (n cont)
    (if (zero? n)
      cont
      (fact/k (- n 1) (* cont n)))))

但是这和 fact-iter（fact-iter）完全相同！所以我们明白了， 累加器通常只是续文的一种表示方式。这令人印象深刻。相当一 部分经典的程序优化问题原来是这一思想的特例。

\textnormal{[}{\star}\textnormal{]} 乘法的什么性质使这种程序优化成为可能？

\textnormal{[}{\star}\textnormal{]}  给 list-sum 设计一种简便的续文表示方式，就像上面的 fact/k 那样。

6.2 尾式

要写出程序来做续文传递风格变换，我们需要找出输入和输出语言。我们选择 LETREC 作为 输入语言，并补充多参数过程和多声明的 letrec 表达式。 其语法如 所示，我们称之为 CPS-IN。为了区分这种语言和输出语言 的表达式，我们把这些叫做输入表达式 (input expression)。

要定义 CPS 变换算法的可能输出，我们要找出 CPI-IN 的子集，在这个集合中，过程调用 不产生任何控制上下文。

回忆传递续文的解释器中的原则：

不是过程调用，而是操作数的求值导致控制上下文扩大。

那么，在

(define fact
  (lambda (n)
    (if (zero? n) 1 (* n (fact (- n 1))))))

中，是 fact 的调用位置作为操作数导致了控制上下文的产生。相反，在

(define fact-iter
  (lambda (n)
    (fact-iter-acc n 1)))
 
(define fact-iter-acc
  (lambda (n a)
    (if (zero? n) a (fact-iter-acc (- n 1) (* n a)))))

中， 过程调用都不在操作数位置。我们说这些调用在尾端 (tail position)，因 为它们的值就是整个调用的结果。我们称之为尾调用 (tail call)。

[!ht]
\begin{align*}\mathit{Program} &::= \mathit{InpExp} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{a-program (exp1)} \\[5pt] \mathit{InpExp} &::= \mathit{Number} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{const-exp (num)} \\[5pt] \mathit{InpExp} &::= (- \mathit{InpExp} , \mathit{InpExp}) \\[-3pt] &\mathrel{\phantom{::=}} \fbox{diff-exp (exp1 exp2)} \\[5pt] \mathit{InpExp} &::= (zero? \mathit{InpExp}) \\[-3pt] &\mathrel{\phantom{::=}} \fbox{zero?-exp (exp1)} \\[5pt] \mathit{InpExp} &::= if \mathit{InpExp} then \mathit{InpExp} else \mathit{InpExp} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{if-exp (exp1 exp2 exp3)} \\[5pt] \mathit{InpExp} &::= \mathit{Identifier} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{var-exp (var)} \\[5pt] \mathit{InpExp} &::= let \mathit{Identifier} = \mathit{InpExp} in \mathit{InpExp} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{let-exp (var exp1 body)} \\[5pt] \mathit{InpExp} &::= letrec \{\mathit{Identifier}\ }(\{\mathit{Identifier}\}^{*(,)}) = \mathit{InpExp}\^{*} in \mathit{InpExp} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{letrec-exp (p-names b-varss p-bodies letrec-body)} \\[5pt] \mathit{InpExp} &::= proc (\mathit{\{Identifier\}^{*(,)}}) \mathit{InpExp} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{proc-exp (vars body)} \\[5pt] \mathit{InpExp} &::= (\mathit{InpExp} \{\mathit{InpExp}\}^{*}) \\[-3pt] &\mathrel{\phantom{::=}} \fbox{call-exp (rator rands)}\end{align*}

CPS-IN的语法

再回忆一下原则尾调用不扩大续文：

尾调用不扩大续文

若 exp_1 的值作为 exp_2 的值返回，则 exp_1 和exp_2 应在同样的续文中执行。

若所有过程调用和所有包含过程调用的子表达式都在尾端，我们称一个表达式 为尾式 (tail form)。这个条件表明所有过程调用都不会产生控制上下文。

因此，在 Scheme 中，

(if (zero? x) (f y) (g z))

是尾式，

(if b
  (if (zero? x) (f y) (g z))
  (h u))

也是尾式，但

(+
  (if (zero? x) (f y) (g z))
  37)

不是。因为 if 表达式包含一个不在尾端的过程调用。

通常，要判定语言的尾端，我们必须理解其含义。处于尾端的子表达式具有如下性质：该表 达式求值后，其值随即成为整个表达式的值。一个表达式可能有多个尾端。例如，if 表达式可能选择真值分支，也可能选择假值分支。对尾端的子表达式，不需要保存信息，因 此也就不会产生控制上下文。

CPS-IN 中的尾端如 所示。尾端每个子表达式的值都可能成为整个表 达式的值。在传递续文的解释器中，操作数位置的子表达式会产生新的续文。尾端的子表达 式在原表达式的续文中求值，如tail-call-explain所述。

[!t]

zero?(O)

-(O,O)

if O then T else T

let Var = O in T

letrec \{Var \ (\{Var\}^{*(,)}) \ = \ T\}^{*} in T

proc (\{Var\}^{*(,)}) = T

(O O ... O)

CPS-IN 中的尾端和操作数位置。尾端记为 T。操作数位置 记为 O。

我们根据这种区别设计 CPS 转换算法的目标语言 CPS-OUT。这种语言的语法 如 所示。这套语法定义了 CPS-IN 的子集，但略有不同。生成式的 名字总以 cps- 开头，这样它们不会与 CPS-IN 中生成式的名字混淆。

新的语法有两个非终结符，\mathit{SimpleExp} 和 \mathit{TfExp}。这种设计中， \mathit{SimpleExp} 表达式不包含任何过程调用，\mathit{TfExp} 表达式一定是 尾式。

因为 \mathit{SimpleExp} 表达式不包含任何过程调用，它们大致可以看成只有一行的 简单代码，对我们来说，它们简单到不需使用控制堆栈。简单表达式包括 proc 表达 式，因为 proc 表达式直接返回一个过程值，但过程的主体必须是尾式。

尾表达式的传递续文解释器如 所示。由于这种语言的过程取多个参 数，我们用 中的 extend-env* 创建多个绑定，并用类似方式 扩展 extend-env-rec，得到 extend-env-rec*。

在这个解释器中，所有递归调用都在（Scheme 的）尾端，所以运行解释器不会在 Scheme 中产生控制上下文（不全是这样：过程 value-of-simple-exp（）会在 Scheme 中产生控制上下文， 但这可以避免（参见））。

更重要的是，解释器不会产生新的续文。过程 value-of/k 取一个续文参数，原封不 动地传给每个递归调用。所以，我们可以很容易地移除续文参数。

当然，没有通用的方式判断一个过程的控制行为是否是迭代式的。考虑

(lambda (n)
  (if (strange-predicate? n)
    (fact n)
    (fact-iter n)))

只有 strange-predicate? 对所有足够大的 n 都返回假时，这个过程才是迭代 式的。但即使能查看 strange-predicate? 的代码，也可能无法判断这一条件的真假。 因此，我们最多只能寄希望于程序中的过程调用不产生控制上下文，而不论其是否执行。


\begin{align*}\mathit{Program} &::= \mathit{TfExp} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{cps-a-program (exp1)} \\[5pt] \mathit{SimpleExp} &::= \mathit{Number} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{cps-const-exp (num)} \\[5pt] \mathit{SimpleExp} &::= \mathit{Identifier} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{cps-var-exp (var)} \\[5pt] \mathit{SimpleExp} &::= (- \mathit{SimpleExp} , \mathit{SimpleExp}) \\[-3pt] &\mathrel{\phantom{::=}} \fbox{cps-diff-exp (simple1 simple2)} \\[5pt] \mathit{SimpleExp} &::= (zero? \mathit{SimpleExp}) \\[-3pt] &\mathrel{\phantom{::=}} \fbox{cps-zero?-exp (simple1)} \\[5pt] \mathit{SimpleExp} &::= proc (\mathit{\{Identifier\}^{*(,)}}) \mathit{TfExp} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{cps-proc-exp (vars body)} \\[5pt] \mathit{TfExp} &::= \mathit{SimpleExp} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{simple-exp->exp (simple-exp1)} \\[5pt] \mathit{TfExp} &::= let \mathit{Identifier} = \mathit{SimpleExp} in \mathit{TfExp} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{cps-let-exp (var simple1 body)} \\[5pt] \mathit{TfExp} &::= letrec \{\mathit{Identifier}\ }(\{\mathit{Identifier}\}^{*(,)}) = \mathit{TfExp}\^{*} in \mathit{TfExp} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{cps-letrec-exp (p-names b-varss p-bodies body)} \\[5pt] \mathit{TfExp} &::= if \mathit{SimpleExp} then \mathit{TfExp} else \mathit{TfExp} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{cps-if-exp (simple1 body1 body2)} \\[5pt] \mathit{TfExp} &::= (\mathit{SimpleExp} \{\mathit{SimpleExp}\}^{*}) \\[-3pt] &\mathrel{\phantom{::=}} \fbox{call-exp (rator rands)}\end{align*}

CPS-OUT 的语法

value-of/k : \mathit{TfExp} \times \mathit{Env} \times \mathit{Cont} \to \mathit{FinalAnswer}
(define value-of/k
  (lambda (exp env cont)
    (cases tfexp exp
      (simple-exp->exp (simple)
        (apply-cont cont
          (value-of-simple-exp simple env)))
      (cps-let-exp (var rhs body)
        (let ((val (value-of-simple-exp rhs env)))
          (value-of/k body
            (extend-env (list var) (list val) env)
            cont)))
      (cps-letrec-exp (p-names b-varss p-bodies letrec-body)
        (value-of/k letrec-body
          (extend-env-rec** p-names b-varss p-bodies env)
          cont))
      (cps-if-exp (simple1 body1 body2)
        (if (expval->bool (value-of-simple-exp simple1 env))
          (value-of/k body1 env cont)
          (value-of/k body2 env cont)))
      (cps-call-exp (rator rands)
        (let ((rator-proc
                (expval->proc
                  (value-of-simple-exp rator env)))
               (rand-vals
                 (map
                   (lambda (simple)
                     (value-of-simple-exp simple env))
                   rands)))
          (apply-procedure/k rator-proc rand-vals cont))))))
 
apply-procedure/k : \mathit{Proc} \times \mathit{ExpVal} \times \mathit{Cont} \to \mathit{ExpVal}
(define apply-procedure/k
  (lambda (proc1 args cont)
    (cases proc proc1
      (procedure (vars body saved-env)
        (value-of/k body
          (extend-env* vars args saved-env)
          cont)))))

CPS-OUT 中的尾式解释器

\textnormal{[}{\star}\textnormal{]} 写出 value-of-simple-exp，完成 中的解释器。

\textnormal{[}{\star}\textnormal{]} 判断下列表达式是否是简单的。

  1. -((f -(x,1)),1)

  2. (f -(-(x,y),1))

  3. if zero?(x) then -(x,y) else -(-(x,y),1)

  4. let x = proc (y) (y x) in -(x,3)

  5. let f = proc (x) x in (f 3)

\textnormal{[}{\star}\textnormal{]} 用上面cps-recipe的 CPS 秘方，把下列 CPS-IN 表达式翻译为续文传递风格。 用 中的解释器运行转换后的程序，测试它们，确保原程序和转换后 的版本对所有输入都给出同样的结果。

  1. removeall。

    letrec

     removeall(n,s) =

      if null?(s)

      then emptylist

      else if number?(car(s))

           then if equal?(n,car(s))

                then (removeall n cdr(s))

                else cons(car(s),

                          (removeall n cdr(s)))

           else cons((removeall n car(s)),

                     (removeall n cdr(s)))

  2. occurs-in?。

    letrec

     occurs-in?(n,s) =

      if null?(s)

      then 0

      else if number?(car(s))

           then if equal?(n,car(s))

                then 1

                else (occurs-in? n cdr(s))

           else if (occurs-in? n car(s))

                then 1

                else (occurs-in? n cdr(s))

  3. remfirst。它使用前面例子中的 occurs-in?。

    letrec

     remfirst(n,s) =

      letrec

       loop(s) =

        if null?(s)

        then emptylist

        else if number?(car(s))

             then if equal?(n,car(s))

                  then cdr(s)

                  else cons(car(s),(loop cdr(s)))

             else if (occurs-in? n car(s))

                  then cons((remfirst n car(s)),

                            cdr(s))

                  else cons(car(s),

                            (remfirst n cdr(s)))

      in (loop s)

  4. depth。

    letrec

     depth(s) =

      if null?(s)

      then 1

      else if number?(car(s))

           then (depth cdr(s))

           else if less?(add1((depth car(s))),

                         (depth cdr(s)))

                then (depth cdr(s))

                else add1((depth car(s)))

  5. depth-with-let。

    letrec

     depth(s) =

      if null?(s)

      then 1

      else if number?(car(s))

           then (depth cdr(s))

           else let dfirst = add1((depth car(s)))

                    drest = (depth cdr(s))

                in if less?(dfirst,drest)

                   then drest

                   else dfirst

  6. map。

    letrec

     map(f, l) = if null?(l)

                 then emptylist

                 else cons((f car(l)),

                           (map f cdr(l)))

     square(n) = *(n,n)

    in (map square list(1,2,3,4,5))

  7. fnlrgtn。n-list 类似 s-list（s-list），只不过其中的元素不 是符号，而是数字。fnlrgtn 取一 n-list，一个数字 n，返回列表中（从左向 右数）第一个大于 n 的数字。一旦找到结果，就不再检查列表中剩余元素。例如，

    (fnlrgtn list(1,list(3,list(2),7,list(9)))

     6)

    返回 7。

  8. every。这个过程取一谓词，一个列表，当且仅当谓词对列表中所有元素都为 真时，返回真。

    letrec

     every(pred, l) =

      if null?(l)

      then 1

      else if (pred car(l))

           then (every pred cdr(l))

           else 0

    in (every proc(n) greater?(n,5) list(6,7,8,9))

\textnormal{[}{\star}\textnormal{]} 补充 value-of-program 和 apply-cont，完成 中的解释 器。

\textnormal{[}{\star}\textnormal{]} 观察前一道练习中的解释器可知，cont 只有一个值。根据这一观察完全移除 cont 参数。

\textnormal{[}{\star}\textnormal{]}  寄存 中的解释器。

\textnormal{[}{\star}\textnormal{]}  把 中的解释器转换为跳跃式。

\textnormal{[}{\star}{\star}\textnormal{]} 修改 CPS-OUT 的语法，把简单 diff-exp 和 zero?-exp 的参数限制为常量和变 量。这样，语言中的 value-of-simple-exp 就不必递归。

\textnormal{[}{\star}{\star}\textnormal{]} 写出 Scheme 过程 tail-form?，它取一 CPS-IN 程序的语法树，语法 如 所示，判断同一字符串是否是 中语法定义 的尾式。

6.3 转换为续文传递风格

本节，我们开发算法，将任意程序从 CPS-IN 转换为 CPS-OUT。

就像传递续文的解释器一样，我们的翻译器跟随语法。也像传递续文的解释器一样， 我们的翻译器再取一个表示续文的参数。多出的这个参数是一个表示续文的简单表达式。

像之前那样，我们首先给出例子，然后提出规范，最后写出程序。 展示了与前一节类似的 Scheme 例子，只是更加详细。

[!ht]
(lambda (x)
  (cond
    ((zero? x) 17)
    ((= x 1) (f (- x 13) 7))
    ((= x 2) (+ 22 (- x 3) x))
    ((= x 3) (+ 22 (f x) 37))
    ((= x 4) (g 22 (f x)))
    ((= x 5) (+ 22 (f x) 33 (g y)))
    (else (h (f x) (- 44 y) (g y)))))

变换为

(lambda (x k)
  (cond
    ((zero? x) (k 17))
    ((= x 1) (f (- x 13) 7 k))
    ((= x 2) (k (+ 22 (- x 3) x)))
    ((= x 3) (f x (lambda (v1) (k (+ 22 v1 37)))))
    ((= x 4) (f x (lambda (v1) (g 22 v1 k))))
    ((= x 5) (f x (lambda (v1)
                    (g y (lambda (v2)
                           (k (+ 22 v1 33 v2))))))
      (else (f x (lambda (v1)
                   (g y (lambda (v2)
                          (h v1 (- 44 y) v2 k)))))))))

CPS 变换示例（Scheme）

第一种情况是常量。常量直接传给续文，就像上面 (zero? x) 这一行。

(cps-of-exp n K) = (K n)

其中，K 表示续文，是一个 simple-exp。

同样，变量直接传给续文。

(cps-of-exp var K) = (K var)

当然，我们算法的输入输出都是抽象语法树，所以我们应该用抽象语法构造器，而不是具体 语法，就像：

(cps-of-exp (const-exp n) K)

= (make-send-to-cont K (cps-const-exp n))

 

(cps-of-exp (var-exp var) K)

= (make-send-to-cont K (cps-var-exp var))

其中：

make-send-to-cont : \mathit{SimpleExp} \times \mathit{SimpleExp} \to \mathit{TfExp}
(define make-send-to-cont
  (lambda (k-exp simple-exp)
    (cps-call-exp k-exp (list simple-exp))))

我们需要 list，因为在 CPS-OUT 中，每个调用表达式都取一个操作数列表。

但是在规范中，我们仍然使用具体语法，因为具体语法通常更容易读懂。

过程呢？我们转换 中那样的 (lambda (x) ...) 过程时，为其 新增一个参数 k，然后转换主体，并将主体的值传给续文 k。我们 在 中正是这样做的。所以

proc (var_1, ..., var_n) exp

变成：

proc (var_1, ..., var_n, k) (cps-of-exp exp k)

就像图中那样。但是，这还没完。我们的目标是生成代码，求 proc 表达式的值，并 将结果传给续文 K。所以 proc 表达式的完整规范为：

(cps-of-exp <var_1, ..., var_n) exp>> K)

= (K  <var_1, ..., var_n, k) (cps-of-exp exp k)>>)

其中，k 是新变量，K 表示续文，是任意简单表达式。

有操作数的表达式呢？我们暂时给语言添加任意多个操作数的求和表达式。要添加这种表达 式，我们给 CPS-IN 的语法添加生成式：

\begin{align*}\mathit{InpExp} &::= +(\mathit{\{InpExp\}^{*(,)}}) \\[-3pt] &\mathrel{\phantom{::=}} \fbox{sum-exp (exps)}\end{align*}

给 CPS-OUT 的语法添加生成式：

\begin{align*}\mathit{SimpleExp} &::= +(\mathit{\{SimpleExp\}^{*(,)}}) \\[-3pt] &\mathrel{\phantom{::=}} \fbox{cps-sum-exp (simple-exps)}\end{align*}

这个新生成式仍保持性质：简单表达式内不会出现过程调用。

(cps-of-exp \textnormal{\guillemotleft}+(exp_1, ..., exp_n)\textnormal{\guillemotright} K) 可能是什么呢？可能 exp_1, \dots, exp_n 都是简单的，就像 中的 (= x 2)。那 么，整个表达式都是简单的，我们可以将它的值接传给续文。设 simp 为一简单表达式， 那么有：

(cps-of-exp <<+(< /span>simp_1, ..., simp_n)>> K)

= (K  <<+(< /span>simp_1, ..., simp_n)>>)

如果操作数不是简单的呢？那么求值续文需要给其值命名，然后继续求和，就像上面 (= x 3) 这行。其中的第二个是首个复杂操作数。那么我们的 CPS 转换器应具有性质：

(cps-of-exp <<+(< /span>simp_1, exp_2, simp_3, ..., simp_n)>> K)

= (cps-of-exp exp_2

     <var_2) (K +(simp_1, var_2, simp_3, ..., simp_n))>>)

如果 exp_2 只是一个过程调用，那么输出和图中相同。但 exp_2 可能更复杂，所 以我们递归调用 cps-of-exp 处理 exp_2 和更大的续文：

proc (var_2) (K +(simp_1, var_2, simp_3, ..., simp_n))

而求和表达式中，还有另一种复杂操作数，就像 (= x 5) 这种。所以，不是直接使用 续文

proc (var_2) (K +(simp_1, var_2, ..., simp_n))

我们还要递归处理更大的参数。我们可以把这条规则总结为：

(cps-of-exp <<+(< /span>simp_1, exp_2, exp_3, ..., exp_n)>> K)

= (cps-of-exp exp_2

     <var_2)

       (cps-of-exp <<+(< /span>simp_1, var_2, exp_3, ..., exp_n))>> K)

cps-of-exp 的每个递归调用都保证会终止。第一个调用会终止是因为 exp_2 比 原表达式小。第二个调用会终止是还是因为其参数也比原来的小：var_2 总是比 exp_2 小。

例如，查看 (= x 5) 这一行，并使用 CPS-IN 的语法，我们有：

(cps-of-exp <<+((f x), 33, (g y))>> K)

= (cps-of-exp <<(f x)>>

     <v1)

       (cps-of-exp <<+(v1, 33, (g y))>> K)>>)

= (cps-of-exp <<(f x)>>

     <v1)

       (cps-of-exp <<(g y)> >

          <v2

            (cps-of-exp <<+(v1, 33, v2)>> K)))

= (cps-of-exp <<(f x)>>

     <v1)

       (cps-of-exp <<(g y)> >

          <v2

            (K  <<+(v1, 33, v2)>>)))

= (f x

   proc (v1)

    (g y

     proc (v2)

      (K  <<+(v1, 33, v2)>>)))

过程调用与之类似。如果操作符和操作数都是简单的，那么我们添加续文参数，直接调用过 程，就像 (= x 2) 这行。

(cps-of-exp <<(< /span>simp_0 simp_1 ... simp_n)>> K)

= (simp_0 simp_1 ... simp_n K)

另一方面，如果某个操作数是复杂的，那么我们必须先求它的值，像 (= x 4) 这行。

(cps-of-exp <<(< /span>simp_0 simp_1 exp_2 exp_3 ... exp_n)>> K)

= (cps-of-exp exp_2

     <var_2)

       (cps-of-exp <<(< /span> simp_0 simp_1 var_2 exp_3 ... exp_n)>> K)>>)

而且，像之前那样，cps-of-exp 的第二个调用递归进入过程调用之中，为每个复杂参 数调用 cps-of-exp，直到所有参数都是简单参数。

写成 CPS-IN 的例子 (= x 5) 可用这些规则处理如下：

(cps-of-exp <<(h (f x) -(44,y) (g y))>> K)

= (cps-of-exp <<(f x)>>

     <

       (cps-of-exp <<(h v1 -(44,y) (g y))>> K)>>)

= (f x

   proc (v1)

    (cps-of-exp <<(h v1 -(44,y) (g y))>> K))

= (f x

   proc (v1)

    (cps-of-exp <<(g y)>>

       <

         (cps-of-exp <<(h v1 -(44,y) v2)>> K)))

= (f x

   proc (v1)

    (g y

     proc (v2)

      (cps-of-exp <<(h v1 -(44,y) v2)>> K)))

= (f x

   proc (v1)

    (g y

     proc (v2)

      (h v1 -(44,y) v2 K)))

求和表达式和过程调用的规范遵循同样的模式：找出第一个复杂操作数，递归处理那个操作 数和修改过的操作数列表。这对任何求值操作数的表达式都有效。如果 complex-exp 是某个需要求值操作数的 CPS-IN 表达式，那么我们有：

(cps-of-exp (complex-exp simp_0 simp_1 exp_2 exp_3 ... exp_n) K)

= (cps-of-exp exp_2

     <var_2)

       (cps-of-exp

         (complex-exp simp_0 simp_1 exp_2 exp_3 ... exp_n)

         K)>>)

其中，var_2 是一个新变量。

处理求和表达式和过程调用的唯一不同之处是在所有参数都简单时。在这种情况下，我们要 把每个参数转换为 CPS-OUT 中的 simple-exp，并用转换结果生成一个尾式。

我们可以把这种行为封装到过程 cps-of-exps 中，如 所示。 它的参数是输入表达式的列表和过程 builder。它用 中的 list-index，找出列表中第一个复杂表达式的位置。如果有这样的复杂表达式，那么 它转换该表达式，转换所在的续文给表达式的结果命名（绑定到 var 的标识符），然 后递归处理修改后的表达式列表。

如果不存在复杂表达式，那么我们用 builder 处理表达式列表。但这些表达式虽是简 单的，它们仍属于 CPS-IN 的语法。因此，我们用过程 cps-of-simple-exp 把每个表 达式转换为 CPS-OUT 的语法。然后，我们把 \mathit{SimpleExp} 的列表传给 builder（list-set 如 所述）。

过程 inp-exp-simple? 取一 CPS-IN 表达式，判断表示它的字符串能否解析为 \mathit{SimpleExp}。它使用 中的过程 every?。若 lst 中的所有元素满足 pred，(every? pred lst) 返回 #t， 否则返回#f。

cps-of-simple-exp 的代码直截了当，如 所示。它还将 proc-exp 的主体翻译做 CPS 变换。若要使输出为 \mathit{SimpleExp}，这是必 要的。

我们可以用 cps-of-exps 生成求和表达式和过程调用的尾式。

[!ht]
cps-of-exps : \mathit{Listof(InpExp)} \times \mathit{(Listof(InpExp) \to TfExp)} \to \mathit{TfExp}
(define cps-of-exps
  (lambda (exps builder)
    (let cps-of-rest ((exps exps))
      cps-of-rest : \mathit{Listof(InpExp)} \to \mathit{TfExp}
      (let ((pos (list-index
                   (lambda (exp)
                     (not (inp-exp-simple? exp)))
                   exps)))
        (if (not pos)
          (builder (map cps-of-simple-exp exps))
          (let ((var (fresh-identifier 'var)))
            (cps-of-exp
              (list-ref exps pos)
              (cps-proc-exp (list var)
                (cps-of-rest
                  (list-set exps pos (var-exp var)))))))))))
 
inp-exp-simple? : \mathit{InpExp} \to \mathit{Bool}
(define inp-exp-simple?
  (lambda (exp)
    (cases expression exp
      (const-exp (num) #t)
      (var-exp (var) #t)
      (diff-exp (exp1 exp2)
        (and (inp-exp-simple? exp1) (inp-exp-simple? exp2)))
      (zero?-exp (exp1) (inp-exp-simple? exp1))
      (proc-exp (ids exp) #t)
      (sum-exp (exps) (every? inp-exp-simple? exps))
      (else #f))))

cps-of-exps

cps-of-sum-exp : \mathit{Listof(InpExp)} \times \mathit{SimpleExp} \to \mathit{TfExp}
(define cps-of-sum-exp
  (lambda (exps k-exp)
    (cps-of-exps exps
      (lambda (simples)
        (make-send-to-cont
          k-exp
          (cps-sum-exp simples))))))

[!ht]
cps-of-simple-exp : \mathit{InpExp} \to \mathit{SimpleExp}
用法 : 设 (inp-exp-simple? exp) = #f
(define cps-of-simple-exp
  (lambda (exp)
    (cases expression exp
      (const-exp (num) (cps-const-exp num))
      (var-exp (var) (cps-var-exp var))
      (diff-exp (exp1 exp2)
        (cps-diff-exp
          (cps-of-simple-exp exp1)
          (cps-of-simple-exp exp2)))
      (zero?-exp (exp1)
        (cps-zero?-exp (cps-of-simple-exp exp1)))
      (proc-exp (ids exp)
        (cps-proc-exp (append ids (list 'k%00))
          (cps-of-exp exp (cps-var-exp 'k%00))))
      (sum-exp (exps)
        (cps-sum-exp (map cps-of-simple-exp exps)))
      (else
        (report-invalid-exp-to-cps-of-simple-exp exp)))))

cps-of-simple-exp

cps-of-call-exp : \mathit{InpExp} \times \mathit{Listof(InpExp)} \times \mathit{SimpleExp} \to \mathit{TfExp}
(define cps-of-call-exp
  (lambda (rator rands k-exp)
    (cps-of-exps (cons rator rands)
      (lambda (simples)
        (cps-call-exp
          (car simples)
          (append (cdr simples) (list k-exp)))))))

现在，我们可以写出 CPS 翻译器的剩余部分 （–fig-6.12）。它跟随语法。当表达式总是 简单的，如常量、变量和过程，我们直接用 make-send-to-cont 生成代码。否则，我 们调用辅助过程，每个辅助过程都调用 cps-of-exps 求子表达式的值，用适当的生成 器构造 CPS 输出的最内部。一个例外是 cps-of-letrec-exp，它没有紧邻的子表达式， 所以它直接生成 CPS 输出。最后，我们调用 cps-of-exps 翻译整个程序，它取一生 成器，该生成器直接返回一个简单表达式。

在下面的练习中，用 CPS-OUT 的语法和解释器运行输出表达式，确保它们是尾式。

cps-of-exp : \mathit{InpExp} \times \mathit{SimpleExp} \to \mathit{TfExp}
(define cps-of-exp
  (lambda (exp k-exp)
    (cases expression exp
      (const-exp (num)
        (make-send-to-cont k-exp (cps-const-exp num)))
      (var-exp (var)
        (make-send-to-cont k-exp (cps-var-exp var)))
      (proc-exp (vars body)
        (make-send-to-cont k-exp
          (cps-proc-exp (append vars (list 'k%00))
            (cps-of-exp body (cps-var-exp 'k%00)))))
      (zero?-exp (exp1)
        (cps-of-zero?-exp exp1 k-exp))
      (diff-exp (exp1 exp2)
        (cps-of-diff-exp exp1 exp2 k-exp))
      (sum-exp (exps)
        (cps-of-sum-exp exps k-exp))
      (if-exp (exp1 exp2 exp3)
        (cps-of-if-exp exp1 exp2 exp3 k-exp))
      (let-exp (var exp1 body)
        (cps-of-let-exp var exp1 body k-exp))
      (letrec-exp (p-names b-varss p-bodies letrec-body)
        (cps-of-letrec-exp
          p-names b-varss p-bodies letrec-body k-exp))
      (call-exp (rator rands)
        (cps-of-call-exp rator rands k-exp)))))
 
cps-of-zero?-exp : \mathit{InpExp} \times \mathit{SimpleExp} \to \mathit{TfExp}
(define cps-of-zero?-exp
  (lambda (exp1 k-exp)
    (cps-of-exps (list exp1)
      (lambda (simples)
        (make-send-to-cont
          k-exp
          (cps-zero?-exp
            (car simples)))))))

cps-of-exp，第1部分

cps-of-diff-exp : \mathit{InpExp} \times \mathit{InpExp} \times \mathit{SimpleExp} \to \mathit{TfExp}
(define cps-of-diff-exp
  (lambda (exp1 exp2 k-exp)
    (cps-of-exps
      (list exp1 exp2)
      (lambda (simples)
        (make-send-to-cont
          k-exp
          (cps-diff-exp
            (car simples)
            (cadr simples)))))))
 
cps-of-if-exp : \mathit{InpExp} \times \mathit{InpExp} \times \mathit{SimpleExp} \to \mathit{TfExp}
(define cps-of-if-exp
  (lambda (exp1 exp2 exp3 k-exp)
    (cps-of-exps (list exp1)
      (lambda (simples)
        (cps-if-exp (car simples)
          (cps-of-exp exp2 k-exp)
          (cps-of-exp exp3 k-exp))))))
 
cps-of-let-exp : \mathit{Var} \times \mathit{InpExp} \times \mathit{InpExp} \times \mathit{SimpleExp} \to \mathit{TfExp}
(define cps-of-let-exp
  (lambda (id rhs body k-exp)
    (cps-of-exp
      (call-exp
        (proc-exp (list id) body)
        (list rhs))
      k-exp)))
 
cps-of-letrec-exp :
\phantom{x}\mathit{Listof(Var)} \times \mathit{Listof(Listof(Var))} \times \mathit{Listof(InpExp)} \times \mathit{InpExp} \times \mathit{SimpleExp} \to \mathit{TfExp}
(define cps-of-letrec-exp
  (lambda (p-names b-varss p-bodies letrec-body k-exp)
    (cps-letrec-exp
      p-names
      (map
        (lambda (b-vars) (append b-vars (list 'k%00)))
        b-varss)
      (map
        (lambda (p-body)
          (cps-of-exp p-body (cps-var-exp 'k%00)))
        p-bodies)
      (cps-of-exp letrec-body k-exp))))

cps-of-exp，第2部分

cps-of-program : \mathit{InpExp} \to \mathit{TfExp}
(define cps-of-program
  (lambda (pgm)
    (cases program pgm
      (a-program (exp1)
        (cps-a-program
          (cps-of-exps (list exp1)
            (lambda (new-args)
              (simple-exp->exp (car new-args)))))))))

cps-of-exp，第3部分

\textnormal{[}{\star}\textnormal{]}  我们的过程 cps-of-exps 迫使子表达式按从左向右的顺序求值。修改 cps-of-exps，使子表达式从右向左求值。

\textnormal{[}{\star}\textnormal{]} 修改 cps-of-call-exp，先从左向右求出操作数的值，再求操作符的值。

\textnormal{[}{\star}\textnormal{]} 有时，当我们生成 (K simp)，K 已经是一个 proc-exp。所以，不 是生成：

(proc (var_1) ... simp)

而应生成：

let var_1 = simp

in ...

那么，CPS 代码具有性质：形如

(proc (var) exp_1

 simp)

的子表达式若不在原表达式中，则不会出现在 CPS 代码中。

修改 make-send-to-cont，生成更好的代码。新的规则何时生效？

\textnormal{[}{\star}{\star}\textnormal{]}  观察可知，if 的规则导致续文 K 复制两次，所以在嵌套的 if 中，转换后 的代码尺寸呈指数增长。运行一个例子，验证这一观察。然后，修改转换，把 K 绑定 到新的变量，从而避免这种增长。

\textnormal{[}{\star}{\star}\textnormal{]}  给语言添加列表（）。记住：列表的参数不在尾端。

\textnormal{[}{\star}{\star}\textnormal{]}  扩展 CPS-IN，让 let 表达式声明任意数量的变量（）。

\textnormal{[}{\star}{\star}\textnormal{]} 由 cps-of-exps 引入的续文变量在续文中只会只会出现一次。修改 make-send-to-cont，不是生成 中的

let var_1 = simp_1

in T

而是生成 T[simp_1/var_1]。其中，符号 E_1[E_2/var] 意为，把表达式 E_1 中自由出现的所有变量 var 替换为 E_2。

\textnormal{[}{\star}{\star}\textnormal{]} 按当前方式，cps-of-let-exp 生成一个无用的 let 表达式（为什么？）。修改 这个过程，直接把 let 变量作为续文变量。那么，若 exp_1 是复杂的，

(cps-of-exp <var_1 = exp_1 in exp_2>> K)

= (cps-of-exp exp_1  <var_1) (cps-of-exp exp_2 K)>>)

\textnormal{[}{\star}\textnormal{]} 试想：有一个 Scheme 程序的 CPS 转换器，用它转换表达式中的第一个解释器，结 果会怎样？

\textnormal{[}{\star}{\star}\textnormal{]} 考虑 cps-of-exps 的变体。

(define cps-of-exps
  (lambda (exps builder)
    (let cps-of-rest ((exps exps) (acc '()))
      cps-of-rest : \mathit{Listof(InpExp)} \times \mathit{Listof(SimpleExp)} \to \mathit{TfExp}
      (cond
        ((null? exps) (builder (reverse acc)))
        ((inp-exp-simple? (car exps))
          (cps-of-rest (cdr exps)
            (cons
              (cps-of-simple-exp (car exps))
              acc)))
        (else
          (let ((var (fresh-identifier 'var)))
            (cps-of-exp (car exps)
              (cps-proc-exp (list var)
                (cps-of-rest (cdr exps)
                  (cons
                    (cps-of-simple-exp (var-exp var))
                    acc))))))))))

为什么 cps-of-exp 的这种变体比 中的更高效？

\textnormal{[}{\star}{\star}\textnormal{]} 调用 cps-of-exps 处理长度为 1 的表达式列表可以简化如下：

(cps-of-exps (list exp) builder)

= (cps-of-exp/ctx exp (lambda (simp) (builder (list simp))))

其中，

cps-of-exp/ctx : \mathit{InpExp} \times \mathit{(SimpleExp \rightarrow{} TfExp)} \to \mathit{TfExp}
(define cps-of-exp/ctx
  (lambda (exp context)
    (if (inp-exp-simple? exp)
      (context (cps-of-simple-exp exp))
      (let ((var (fresh-identifier 'var)))
        (cps-of-exp exp
          (cps-proc-exp (list var)
            (context (cps-var-exp var))))))))

这样，由于列表的参数数量已经确定，我们可以简化出现 (cps-of-exps (list ...)) 的地方。那么，诸如 cps-of-diff-exp 可以用 cps-of-exp/ctx 定义，而不需 要 cps-of-exps。

(define cps-of-diff-exp
  (lambda (exp1 exp2 k-exp)
    (cps-of-exp/ctx exp1
      (lambda (simp1)
        (cps-of-exp/ctx exp2
          (lambda (simp2)
            (make-send-to-cont k-exp
              (cps-diff-exp simp1 simp2))))))))

对 cps-of-call-exp 中用到的 cps-of-exps，我们可以用 cps-of-exp/ctx 处理 rator，但仍需使用 cps-of-exps 处理 rands。 删除翻译器中其他地方出现的 cps-of-exps。

\textnormal{[}{\star}{\star}{\star}\textnormal{]}  写一个翻译器，它取 cps-of-program 的输出，生成一个等价程序，其中所有的续文 都用传递续文的解释器中的数据结构表示。用列表表示那些用 define-datatype 生成的数 据结构。由于我们的语言不支持符号，你可以在首项位置使用整数标签，以此区分数据类型 的变体。

\textnormal{[}{\star}{\star}{\star}\textnormal{]}  写一个翻译器，它类似，但把所有过程表示为数据结构。

\textnormal{[}{\star}{\star}{\star}\textnormal{]}  写一个翻译器，它取 的输出，将其转换为 那样的寄存器程序。

\textnormal{[}{\star}{\star}\textnormal{]}  我们把程序转换为 CPS 时，不仅将程序中的控制上下文变为显式的，而且还确定了操作的 执行顺序，以及所有中间结果的名字。后者叫做序列化 (sequentialization)。如 果我们不关心能否获得迭代性控制行为，我们序列化程序时可将其转换为 A-normal form，或称ANF。这里是一个 ANF 程序的例子。

(define fib/anf
  (lambda (n)
    (if ( << /span> n 2)
      1
      (let ((val1 (fib/anf (- n 1))))
        (let ((val2 (fib/anf (- n 2))))
          (+ val1 val2))))))

CPS 程序传递命名中间结果的续文，从而序列化计算；ANF 程序用 let 表达式命名所 有中间结果，从而序列化计算。

重写 cps-of-exp，生成 ANF 程序而非 CPS 程序（对不在尾端的条件表达式， 用 中的方法处理）。然后，用修改后的 cps-of-exp 处理例 fib 的定义，验证其结果是否为 fib/anf。最后，验证对已经是 ANF 的输入程 序，你的翻译器产生的程序与输入只有绑定变量名不同。

\textnormal{[}{\star}\textnormal{]} 用几个例子验证：若采用 中的优化方法，对 ANF 转换器 （）的输入和输出程序进行 CPS 变换，所得结果相同。

6.4 建模计算效果

CPS 的另一重要应用是提供模型，将计算效果变为显式的。计算效果——像是打印或给变量赋 值——很难用表达式使用的方程推理建模。通过 CPS 变换，我们可以将这些效果变为 显式的，就像我们在传递续文的解释器中处理非局部控制流一样。

用 CPS 建模效果时，我们的基本原则是简单表达式不应有任何效果。简单表达式不应含有 过程调用也是基于这一原则，因为过程调用可能不终止（这当然是一种效果！）。

本节，我们研究三种效果：打印，存储器（用显式引用模型），以及非标准控制流。

我们首先考虑打印。打印当然是一种效果：

(f print(3) print(4))

和

(f 1 1)

即使返回同样的答案，也具有不同效果。效果还取决于参数的求值顺序。迄今为止，我们的 语言总是按从左向右的顺序求参数的值，但其他语言可能不是这样。

要建模这些想法，我们按照下面的方式修改 CPS 变换：

来看一个更复杂的例子。

(cps-of-exp <<(f print((g x)) print(4))>> K)

= (cps-of-exp <>

     <

       (cps-of-exp <<(f v1 print(4))>> K)>>)

= (cps-of-exp <<(g x)>>

     <

       (cps-of-exp <<(print v2)> >

          <

            (cps-of-exp <<(f v1 print(4))>> K)>>)>>)

= (g x

   proc (v2)

    (cps-of-exp <<(print v2)> >

       <

        (cps-of-exp <<(f v1 print(4))>> K)>>))

= (g x

   proc (v2)

    printk(v2);

    let v1 = 38

    in (cps-of-exp <<(f v1 print(4))>> K))

= (g x

   proc (v2)

    printk(v2);

    let v1 = 38

    in (cps-of-exp < >

          <

            (cps-of-exp <<(f v1 v3)>> K)>>))

= (g x

   proc (v2)

    printk(v2);

    let v1 = 38

    in printk(4);

       let v3 = 38

       in (cps-of-exp <<(f v1 v3)>> K))

= (g x

   proc (v2)

    printk(v2);

    let v1 = 38

    in printk(4);

       let v3 = 38

       in (f v1 v3 k))

这里，我们调用 g，调用所在的续文把结果命名为 v2。续文打印出 v2 的 值，把 38 传给下一续文，下一续文将 v1 绑定到实参 38，打印出 4，然后调用下一 续文，下一续文把 v2 绑定到实参（也是 38），然后用 v1，v3 和 K 调用 f。

我们按照同样的步骤建模显式引用（EXPLICIT-REFS：显式引用语言）。我们给 CPS-IN 和 CPS-OUT 添加新 的语法，给 CPS-OUT 的解释器添加代码，处理新的语法，给 cps-of-exp 添加代码， 将新的 CPS-IN 语法翻译为 CPS-OUT。对显式引用，我们需要添加创建引用，解引用和赋值 的语法。

\textnormal{[}{\star}{\star}\textnormal{]}  给 CPS-IN 添加 begin 表达式（）。CPS-OUT 应该不需要修改。

\textnormal{[}{\star}{\star}{\star}\textnormal{]}  给 CPS-IN 添加隐式引用（IMPLICIT-REFS：隐式引用语言）。用和显式引用相同的 CPS-OUT，确保翻译器 在适当的地方插入分配和解引用。提示：回忆一下，在隐式引用出现的地方，var-exp 不再是简单的，因为它需要读取存储器。

\textnormal{[}{\star}{\star}{\star}\textnormal{]} 如果一个变量不会出现在 set 表达式的左边，它是不可变的，因此可以视为简单的。 扩展前一题的解答，按简单表达式处理所有这样的变量。

最后是非局部控制流。我们来考虑 中的 letcc。letcc 表达式 letcc var in body 将当前续文绑定到变量 var。body 为 该绑定的作用域。续文的唯一操作是 throw。我们用语法 throw Expression to Expression，它需要求出两个子表达式的值。第二个表达式应返回一个续文，该续 文作用于第一个表达式的值。throw 当前的续文则被忽略。

我们首先按照本章的方式分析这些表达式。这些表达式一定是复杂的。letcc 的主体 部分在尾端，因为它的值就是整个表达式的值。由于 throw 中的两个位置都需求值， 且都不是 throw 的值（确实，throw 没有值，因为它不会返回到紧邻的续文）， 因此它们都在操作数位置。

现在，我们可以写出转换这两个表达式的规则。

(cps-of-exp <var in body>> K)

= let var = K

  in (cps-of-exp body var)

 

(cps-of-exp <simp_1 to simp_2>> K)

= (simp_2 simp_1)

我们仍用 cps-of-exps 处理 throw 可能含有的复杂参数。这里，K 如期望 的那样忽略。

这个例子中，我们不需要给给 CPS-OUT 添加语法，因为我们操作的正是控制结构。

\textnormal{[}{\star}\textnormal{]} 在 CPS 翻译器中实现 letcc 和 throw。

\textnormal{[}{\star}{\star}\textnormal{]} 在 CPS 翻译器中添加和实现异常中的 try/catch 和 throw。CPS-OUT 应该不需要添加任何东西，而 cps-of-exp 改取两个续文：一个成功续文，一个错误 续文。

    contents   ← prev  up  next →