关于
本文是系列文章中的第八篇，
在上一篇中，我们介绍了continuation的概念，还介绍了Lisp中威力强大的call/cc，它提供了first-class continuation，最后我们用call/cc实现了python中的generator和yield。
call/cc赋予了我们很强的表达能力，Lisp中的异常处理机制也很人性化。
例如，Common Lisp: Condition_system，
由于call/cc可以捕捉到异常处的continuation，
我们就可以手动调用这个continuation，
让程序从错误的位置以给定状态重新开始执行，
甚至结合REPL还可以询问用户，让用户输入这个状态。
其他语言的try/catch是无法做到这一点的，
我们拿到错误时，出现错误的那个环境已经被丢弃了，无法恢复，
那么除了提示用户程序崩溃了就没有别的办法了。
call/cc这么强大，更坚定了我们实现它的想法，
本文就从实现的角度来看call/cc。
尾调用
In computer science, a tail call is a subroutine call performed as the final action of a procedure.
如果在某个函数的末尾调用了另一个函数，这个调用就称为尾调用。
我们举个例子吧，
(define (f a)
(display a)
(g 2))
(define (g b)
(display b))
(f 1)
我们看到，函数f的末尾调用了函数g，(g 2)。
尾调用有什么好处呢？
一个基本的事实是，如果g是f的尾调用，g就可以不返回到f中，
而直接返回到f该返回的地方。
因为g是f的尾调用，g后面没有其他调用了，
(g 2)调用结束后就可以不必返回到f的函数体中了，而是直接返回到(f 1)处。
因此，调用g的时候，调用栈可以不增加，而是直接废弃f的调用环境即可。
注意，我们上面提到的是『不必返回到f的函数体中』，
因为不是每个语言都可以做到这一点，
这个语言特性，称为尾调用优化（tail call optimization）。
调用栈和调用图
调用栈对我们来说是一个耳熟能详的名词，
可是我们有没有考虑过，为什么调用构成了一个『栈』呢？
有这么多的数据结构，为什么不是一个队列，不是一个树，不是一个图呢？
是因为函数的调用和返回机制，恰好可以用帧（frame）的压栈和弹栈来描述。
可是，尾调用优化，开始动摇了这一点，
为了能返回到调用者该返回的地方，调用栈有的时候可能会弹出两次，或者弹出更多次。
进一步，我们再来看call/cc的场景，它使得程序可以直接跳转到之前的某个状态，
根本上改变了压栈弹栈的规则，跳过去以后，以全新的状态重新开始执行。
然而，发生跳转时的状态还不能丢弃，因为有可能再跳回来。
因此，call/cc让调用不再构成一个栈，而是构成了一个调用图。
CPS
在这些复杂场景中，为了能显式的表示执行过程，
将程序转化为CPS（continuation passing style）是一种常用的办法，
CPS是一种程序的书写风格，经常作为编译器的一种中间表示。（IR
; 调用风格
(define (f x)
(+ (g x) 1))
(define (g x)
(* x 2))
(f 1)
; CPS
(define (f x cont)
(g x (lambda (v)
(cont (+ v 1)))))
(define (g x cont)
(cont (* x 2)))
(f 1 display)
我们发现写成CPS之后，每个函数多了一个cont参数，
用来表示该函数调用表达式的continuation，
我们调用一个函数，就应该把它相应的continuation显式的传给它。
例如，我们在f中调用了g，那么我们就将(g x)的continuation传给了g，即(lambda (v) (cont (+ v 1)))。
除此之外，我们还发现，CPS是一个尾调用形式，
因此程序的执行就变成了continuation的不断变换生长。
开始动手术
为了实现call/cc，首先我们要把解释器改造成CPS形式，
然后再将continuation拿出来包装一下，提供给用户使用。
我们先进行第一步改造，CPS，
回忆一下，为了实现词法作用域，我们给解释器中每个函数末尾加上了参数env，用于表示被求值表达式的环境。这次也相似，我们给每个函数加上了新的参数cont，用于表示被求值表达式的continuation，这样我们就可以将解释器改造成CPS形式了。
下一步改造我们要实现call/cc了，它直接使用了这些包含cont参数的函数，限于篇幅，CPS形式的解释器我们就略过了，这里我们只是先看一下handle-decision-tree的样子吧，
(define (handle-decision-tree tree exp env cont)
(if (null? tree)
(error '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之后，我们就可以将cont进行包装了，
下面的实现中，我们将cont包装成了一个内部的数据结构continuation。
（和闭包一样，continuation从实现的角度来看也是一个数据结构
然后，把这个数据结构提供给用户，就可以让用户代码实现自定义跳转了。
为了实现这一点，我们在解释器中判断是否调用了continuation，来做相应的处理。
handle-decision-tree增加了两个分支，is-continuation?，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 'get-symbol-value "failed to find symbol")
(let ((head-frame (car env)))
(if (hash-has-key? head-frame key)
(hash-ref head-frame key '())
(lookup-env (cdr env)))))))
(define (handle-decision-tree tree exp env cont)
(if (null? tree)
(error '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* `(,(create-frame)))
(define *cont* (lambda (v)
(display v)))
; main
(define (eval-exp exp env cont)
(handle-decision-tree
`((,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) '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) '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 `(,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 '1 *env* *cont*)
(display "\n\n")
(eval-exp '(lambda (x) x)
*env* *cont*)
(display "\n\n")
(eval-exp '((lambda (x) x)
1)
*env* *cont*)
(display "\n\n")
(eval-exp '((lambda (x)
((lambda (y) x)
2))
1)
*env* *cont*)
(display "\n\n")
(eval-exp '((lambda (x)
((lambda (f)
((lambda (x)
(f 3))
2))
(lambda (z) x)))
1)
*env* *cont*)
(display "\n\n")
(eval-exp '(call/cc (lambda (k)
1))
*env* *cont*)
(display "\n\n")
(eval-exp '(call/cc (lambda (k)
(k 2)))
*env* *cont*)
要点分析
（1）eval-call/cc时会创建一个continuation，
然后用这个continuation作为参数调用call/cc的参数。
（call/cc的参数，就是后面的(lambda (k) 1)，因此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 `(,fn ,data-cont) env cont)))
（2）eval-continuation-call会解开continuation的包装，得到内部包含的cont，
然后用这个cont作为参数求值表达式，
这样就实现了，表达式求值完以后跳转到产生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)))))))
（3）(call/cc ...)表达式中，如果k没有被调用，那么(call/cc ...)的值，就是call/cc参数函数的返回值，即(call/cc (lambda (k) 1)) = 1。
这一点看起来很难实现，实则不然。
我们只需要巧妙的指定(lambda (k) 1)的continuation，
让它就是(call/cc (lambda (k) 1))的continuation即可。
这一点体现在eval-call/cc中，我们直接将cont原封不动的传给了eval-function-call-list
(define (eval-call/cc exp env cont)
...
(eval-function-call-list `(,fn ,data-cont) env cont)))
下文
Lisp语言真是博大精深，写到这里我们甚至还没有提及它最重要的语言特性——宏，
Lisp宏提供了一种元编程的手段，同像性让Lisp元编程异常强大，
然而，把宏说清楚也颇费笔墨，因此，我打算在适当的时候单独讨论它。
本系列标题为『柯里化的前生今世』，意在通过柯里化引入种种有趣的概念，
目前为止，我们讨论了高阶函数，闭包，continuation，这些可以看做『柯里化的前生』，
我们不但理解了这些概念，还实现了它们，算是小有收获吧。
使用Racket也有一段日子了，对它也逐渐从陌生到熟悉，
可是偏执却容易让人误入歧途，错过其他风景，
下文我们将开启新的旅程了，Let's go !
参考
continuation passing style
Compiling with Continuations
An Introduction to Scheme and its Implementation
