柯里化的前生今世（八）：尾调用与CPS

关于

在上一篇中&＃xff0c;我们介绍了continuation的概念&＃xff0c;还介绍了Lisp中威力强大的call/cc&＃xff0c;它提供了first-class continuation&＃xff0c;最后我们用call/cc实现了python中的generator和yield。

call/cc赋予了我们很强的表达能力&＃xff0c;Lisp中的异常处理机制也很人性化。
例如&＃xff0c;Common Lisp: Condition_system&＃xff0c;
由于call/cc可以捕捉到异常处的continuation&＃xff0c;
我们就可以手动调用这个continuation&＃xff0c;
让程序从错误的位置以给定状态重新开始执行&＃xff0c;
甚至结合REPL还可以询问用户&＃xff0c;让用户输入这个状态。

其他语言的try/catch是无法做到这一点的&＃xff0c;
我们拿到错误时&＃xff0c;出现错误的那个环境已经被丢弃了&＃xff0c;无法恢复&＃xff0c;
那么除了提示用户程序崩溃了就没有别的办法了。

call/cc这么强大&＃xff0c;更坚定了我们实现它的想法&＃xff0c;
本文就从实现的角度来看call/cc。

尾调用

In computer science, a tail call is a subroutine call performed as the final action of a procedure. 

如果在某个函数的末尾调用了另一个函数&＃xff0c;这个调用就称为尾调用。
我们举个例子吧&＃xff0c;

(define (f a)(display a)(g 2))(define (g b)(display b))(f 1)

我们看到&＃xff0c;函数f的末尾调用了函数g&＃xff0c;(g 2)。

尾调用有什么好处呢&＃xff1f;
一个基本的事实是&＃xff0c;如果g是f的尾调用&＃xff0c;g就可以不返回到f中&＃xff0c;
而直接返回到f该返回的地方。

因为g是f的尾调用&＃xff0c;g后面没有其他调用了&＃xff0c;
(g 2)调用结束后就可以不必返回到f的函数体中了&＃xff0c;而是直接返回到(f 1)处。
因此&＃xff0c;调用g的时候&＃xff0c;调用栈可以不增加&＃xff0c;而是直接废弃f的调用环境即可。

注意&＃xff0c;我们上面提到的是『不必返回到f的函数体中』&＃xff0c;
因为不是每个语言都可以做到这一点&＃xff0c;
这个语言特性&＃xff0c;称为尾调用优化&＃xff08;tail call optimization&＃xff09;。

调用栈和调用图

调用栈对我们来说是一个耳熟能详的名词&＃xff0c;
可是我们有没有考虑过&＃xff0c;为什么调用构成了一个『栈』呢&＃xff1f;
有这么多的数据结构&＃xff0c;为什么不是一个队列&＃xff0c;不是一个树&＃xff0c;不是一个图呢&＃xff1f;

是因为函数的调用和返回机制&＃xff0c;恰好可以用帧&＃xff08;frame&＃xff09;的压栈和弹栈来描述。
可是&＃xff0c;尾调用优化&＃xff0c;开始动摇了这一点&＃xff0c;
为了能返回到调用者该返回的地方&＃xff0c;调用栈有的时候可能会弹出两次&＃xff0c;或者弹出更多次。

进一步&＃xff0c;我们再来看call/cc的场景&＃xff0c;它使得程序可以直接跳转到之前的某个状态&＃xff0c;
根本上改变了压栈弹栈的规则&＃xff0c;跳过去以后&＃xff0c;以全新的状态重新开始执行。
然而&＃xff0c;发生跳转时的状态还不能丢弃&＃xff0c;因为有可能再跳回来。
因此&＃xff0c;call/cc让调用不再构成一个栈&＃xff0c;而是构成了一个调用图。

CPS

在这些复杂场景中&＃xff0c;为了能显式的表示执行过程&＃xff0c;
将程序转化为CPS&＃xff08;continuation passing style&＃xff09;是一种常用的办法&＃xff0c;
CPS是一种程序的书写风格&＃xff0c;经常作为编译器的一种中间表示。&＃xff08;IR

; 调用风格
(define (f x)(&＃43; (g x) 1))(define (g x)(* x 2))(f 1); CPS
(define (f x cont)(g x (lambda (v)(cont (&＃43; v 1)))))(define (g x cont)(cont (* x 2)))(f 1 display)

我们发现写成CPS之后&＃xff0c;每个函数多了一个cont参数&＃xff0c;
用来表示该函数调用表达式的continuation&＃xff0c;
我们调用一个函数&＃xff0c;就应该把它相应的continuation显式的传给它。
例如&＃xff0c;我们在f中调用了g&＃xff0c;那么我们就将(g x)的continuation传给了g&＃xff0c;即(lambda (v) (cont (&＃43; v 1)))。

除此之外&＃xff0c;我们还发现&＃xff0c;CPS是一个尾调用形式&＃xff0c;
因此程序的执行就变成了continuation的不断变换生长。

开始动手术

为了实现call/cc&＃xff0c;首先我们要把解释器改造成CPS形式&＃xff0c;
然后再将continuation拿出来包装一下&＃xff0c;提供给用户使用。

我们先进行第一步改造&＃xff0c;CPS&＃xff0c;
回忆一下&＃xff0c;为了实现词法作用域&＃xff0c;我们给解释器中每个函数末尾加上了参数env&＃xff0c;用于表示被求值表达式的环境。这次也相似&＃xff0c;我们给每个函数加上了新的参数cont&＃xff0c;用于表示被求值表达式的continuation&＃xff0c;这样我们就可以将解释器改造成CPS形式了。

下一步改造我们要实现call/cc了&＃xff0c;它直接使用了这些包含cont参数的函数&＃xff0c;限于篇幅&＃xff0c;CPS形式的解释器我们就略过了&＃xff0c;这里我们只是先看一下handle-decision-tree的样子吧&＃xff0c;

(define (handle-decision-tree tree exp env cont)(if (null? tree)(error &＃39;handle-decision-tree "failed to make decision")(let* ((head (car tree))(predicator (car head))(decision (cadr head)))(predicator exp env (lambda (predicate-result)(if predicate-result(if (not (list? decision))(decision exp env cont)(handle-decision-tree decision exp env cont))(handle-decision-tree (cdr tree) exp env cont)))))))

实现call/cc

将解释器转换成CPS之后&＃xff0c;我们就可以将cont进行包装了&＃xff0c;
下面的实现中&＃xff0c;我们将cont包装成了一个内部的数据结构continuation。
&＃xff08;和闭包一样&＃xff0c;continuation从实现的角度来看也是一个数据结构

然后&＃xff0c;把这个数据结构提供给用户&＃xff0c;就可以让用户代码实现自定义跳转了。
为了实现这一点&＃xff0c;我们在解释器中判断是否调用了continuation&＃xff0c;来做相应的处理。
handle-decision-tree 增加了两个分支&＃xff0c;is-continuation?&＃xff0c;is-continuation-call?。

#lang racket; tool(struct closure (param body env))(struct continuation (cont))(define (create-frame)(make-hash))(define (extend-frame frame key value)(hash-set! frame key value))(define (extend-env env frame)(cons frame env))(define (get-symbol-value env key)(let lookup-env((env env))(if (null? env)(error &＃39;get-symbol-value "failed to find symbol")(let ((head-frame (car env)))(if (hash-has-key? head-frame key)(hash-ref head-frame key &＃39;())(lookup-env (cdr env)))))))(define (handle-decision-tree tree exp env cont)(if (null? tree)(error &＃39;handle-decision-tree "failed to make decision")(let* ((head (car tree))(predicator (car head))(decision (cadr head)))(predicator exp env (lambda (predicate-result)(if predicate-result(if (not (list? decision))(decision exp env cont)(handle-decision-tree decision exp env cont))(handle-decision-tree (cdr tree) exp env cont))))))); env & cont(define *env* &＃96;(,(create-frame)))(define *cont* (lambda (v)(display v))); main(define (eval-exp exp env cont)(handle-decision-tree &＃96;((,is-symbol? ,eval-symbol)(,is-self-eval-exp? ,eval-self-eval-exp)(,is-continuation? ,eval-continuation)(,is-list?((,is-lambda? ,eval-lambda)(,is-call/cc? ,eval-call/cc)(,is-continuation-call? ,eval-continuation-call)(,is-function-call-list? ,eval-function-call-list))))exp env cont))(define (is-symbol? exp env cont)(display "is-symbol?\n")(cont (symbol? exp)))(define (eval-symbol exp env cont)(display "eval-symbol\n")(cont (get-symbol-value env exp)))(define (is-self-eval-exp? exp env cont)(display "is-self-eval-exp?\n")(cont (number? exp)))(define (eval-self-eval-exp exp env cont)(display "eval-self-eval-exp\n")(cont exp))(define (is-continuation? exp env cont)(display "is-continuation?\n")(cont (continuation? exp)))(define (eval-continuation exp env cont)(display "eval-continuation\n")(cont exp))(define (is-list? exp env cont)(display "is-list?\n")(cont (list? exp)))(define (is-lambda? exp env cont)(display "is-lambda?\n")(cont (eq? (car exp) &＃39;lambda)))(define (eval-lambda exp env cont)(display "eval-lambda\n")(let ((param (caadr exp))(body (caddr exp)))(cont (closure param body env))))(define (is-call/cc? exp env cont)(display "is-call/cc?\n")(cont (eq? (car exp) &＃39;call/cc)))(define (eval-call/cc exp env cont)(display "eval-call/cc\n")(let ((fn (cadr exp))(data-cont (continuation cont)))(eval-function-call-list &＃96;(,fn ,data-cont) env cont)))(define (is-continuation-call? exp env cont)(display "is-continuation-call?\n")(eval-exp (car exp) env(lambda (value)(cont (continuation? value)))))(define (eval-continuation-call exp env cont)(display "eval-continuation-call\n")(eval-exp (car exp) env(lambda (data-cont)(let ((wrapped-cont (continuation-cont data-cont)))(eval-exp (cadr exp) env(lambda (arg)(wrapped-cont arg)))))))(define (is-function-call-list? exp env cont)(display "is-function-call-list?\n")(cont #t))(define (eval-function-call-list exp env cont)(display "eval-function-call-list\n")(eval-exp (car exp) env(lambda (clos)(eval-exp (cadr exp) env(lambda (arg)(let ((body (closure-body clos))(lexical-env (closure-env clos))(param (closure-param clos))(frame (create-frame)))(extend-frame frame param arg)(let ((executing-env (extend-env lexical-env frame)))(eval-exp body executing-env cont))))))))

测试

(eval-exp &＃39;1 *env* *cont*)(display "\n\n")
(eval-exp &＃39;(lambda (x) x) *env* *cont*)(display "\n\n")
(eval-exp &＃39;((lambda (x) x) 1) *env* *cont*)(display "\n\n")
(eval-exp &＃39;((lambda (x)((lambda (y) x)2))1) *env* *cont*)(display "\n\n")
(eval-exp &＃39;((lambda (x)((lambda (f)((lambda (x)(f 3))2))(lambda (z) x)))1)*env* *cont*)(display "\n\n")
(eval-exp &＃39;(call/cc (lambda (k)1))*env* *cont*)(display "\n\n")
(eval-exp &＃39;(call/cc (lambda (k)(k 2)))*env* *cont*)

要点分析

&＃xff08;1&＃xff09;eval-call/cc时会创建一个continuation&＃xff0c;
然后用这个continuation作为参数调用call/cc的参数。
&＃xff08;call/cc的参数&＃xff0c;就是后面的(lambda (k) 1)&＃xff0c;因此k就是这个continuation

; (call/cc (lambda (k) 1))(define (eval-call/cc exp env cont)(display "eval-call/cc\n")(let ((fn (cadr exp))(data-cont (continuation cont)))(eval-function-call-list &＃96;(,fn ,data-cont) env cont)))

&＃xff08;2&＃xff09;eval-continuation-call会解开continuation的包装&＃xff0c;得到内部包含的cont&＃xff0c;
然后用这个cont作为参数求值表达式&＃xff0c;
这样就实现了&＃xff0c;表达式求值完以后跳转到产生cont位置的效果。

(define (eval-continuation-call exp env cont)(display "eval-continuation-call\n")(eval-exp (car exp) env(lambda (data-cont)(let ((wrapped-cont (continuation-cont data-cont)))(eval-exp (cadr exp) env(lambda (arg)(wrapped-cont arg)))))))

&＃xff08;3&＃xff09;(call/cc ...)表达式中&＃xff0c;如果k没有被调用&＃xff0c;那么(call/cc ...)的值&＃xff0c;就是call/cc参数函数的返回值&＃xff0c;即(call/cc (lambda (k) 1)) &＃61; 1。
这一点看起来很难实现&＃xff0c;实则不然。

我们只需要巧妙的指定(lambda (k) 1)的continuation&＃xff0c;
让它就是(call/cc (lambda (k) 1))的continuation即可。
这一点体现在eval-call/cc中&＃xff0c;我们直接将cont原封不动的传给了eval-function-call-list

(define (eval-call/cc exp env cont)...(eval-function-call-list &＃96;(,fn ,data-cont) env cont)))

下文

Lisp语言真是博大精深&＃xff0c;写到这里我们甚至还没有提及它最重要的语言特性——宏&＃xff0c;
Lisp宏提供了一种元编程的手段&＃xff0c;同像性让Lisp元编程异常强大&＃xff0c;
然而&＃xff0c;把宏说清楚也颇费笔墨&＃xff0c;因此&＃xff0c;我打算在适当的时候单独讨论它。

本系列标题为『柯里化的前生今世』&＃xff0c;意在通过柯里化引入种种有趣的概念&＃xff0c;
目前为止&＃xff0c;我们讨论了高阶函数&＃xff0c;闭包&＃xff0c;continuation&＃xff0c;这些可以看做『柯里化的前生』&＃xff0c;
我们不但理解了这些概念&＃xff0c;还实现了它们&＃xff0c;算是小有收获吧。

使用Racket也有一段日子了&＃xff0c;对它也逐渐从陌生到熟悉&＃xff0c;
可是偏执却容易让人误入歧途&＃xff0c;错过其他风景&＃xff0c;
下文我们将开启新的旅程了&＃xff0c;Let&＃39;s go !

参考

continuation passing style
Compiling with Continuations
An Introduction to Scheme and its Implementation