Continuation
Continuation 表示一个表达式被求值之后，接下来要做的事情
call/cc(call一个continuation)
call/cc必须passed一个有 一个参数 的procedure
(call/cc
(lambda (k)
(* 5 4))) ;; => 20获得一个k的continuation，然而并没有被使用
(call/cc
(lambda (k)
(* 5 (k 4)))) ;; => 4获得一个k的continuation，(k 4)时直接到(call/cc …)外
set!的continuation
continuation被外部变量set!，调用时回到(call/cc …)外
(define k-cc #f)
(+ (call/cc (lambda (k)
(begin
(set! k-cc k)
(k (* 3 4))))) ;; k-cc run from here
5) ;; => 17
(k-cc 5) ;; => 10(set! k-cc k)后*k*就是(call/cc …)外的continuation
(k-cc 5) => (+ 5 5) => 10
非引用透明性(call/cc (lambda (x) x))
自己被用来做了什么事，它返回的continuation就对别人做同样的事
(let ([x (call/cc (lambda (k) k))])
(x (lambda (ignore) "hi"))) ; => "hi"=>
(let ([x (lambda (ignore) "hi")])
(x (lambda (ignore) "hi")))=>
((lambda (ignore) "hi") (lambda (ignore) "hi"))=>
"hi"
(define (get-cc) (call/cc (lambda (k) k)))
(set! x (get-cc)) ;; x 被set!
(x 10) ;; x 被set! (set!之后会有Error)
;; x => 10货真价实的10 已经不带任何continuations绑定
CPS
CPS 能写出更有格(nan)调(dong)的递归程序
自然递归
(define (fact n)
(cond [(zero? n) 1]
[else (* (fact (sub1 n)) n)]))APS(Accumulator-Passing Style)
使用一个值维护递归
(define (fact-aps n acc)
;; accumulator-passing style
(cond [(zero? n) acc]
[else (fact-aps (sub1 n) (* acc n))]))
(define (fact2 n) (fact-aps n 1))REPL
(trace fact-aps) ;; (require racket/trace)
(trace fact2)
(fact2 5)输出
>(fact2 5)
>(fact-aps 5 1)
>(fact-aps 4 5)
>(fact-aps 3 20)
>(fact-aps 2 60)
>(fact-aps 1 120)
>(fact-aps 0 120)
<120
120CPS(Continuation-Passing Style)
使用一个过程维护递归(需要更多的内存)
(define (fact-cps n k)
;; continuation-passing style
(cond [(zero? n) (k 1)]
[else
(fact-cps (sub1 n)
(lambda (v)
(k (* v n))))]))
(define (fact3 n)
(fact-cps n (lambda (v) v)))REPL
(trace fact-cps) ;; (require racket/trace)
(trace fact3)
(fact3 5)输出
>(fact3 5)
>(fact-cps 5 #<procedure>)
>(fact-cps 4 #<procedure>)
>(fact-cps 3 #<procedure>)
>(fact-cps 2 #<procedure>)
>(fact-cps 1 #<procedure>)
>(fact-cps 0 #<procedure>)
<120
120CPS变换
CPS变换用于desugar(zhuanbi)
符号约定
文字约定
number := 数字 boolean := 布尔值 symbol := 符号(变量名),不包括k k,arg, value lambda, if, quote
sexp为要处理的输入
sexp := self-evaluate
| symbol
| (quote anything) ; 引用形式
| (lambda (arg) sexp) ; lambda表达式
| (sexp sexp) ; 调用
| (if test then else)
self-evaluate := number | boolean
我们把CPS函数的输出叫做cps-exp,sexp对应的cps-exp它应该是这样的:
cps-exp := simple-exp
| (k simple-exp)
| (simple-exp simple-exp k-exp)
| (if simple-exp cps-exp cps-exp)
k-exp := (lambda (value) cps-exp)
simple-exp := self-evaluate | symbol | (quote anything)
| (lambda (arg k) cps-exp)
这样,CPS变换就是实现sexp到cps-exp的变换
self-evaluate, symbol, quote的处理
(define cps
(lambda (sexp)
...))考虑sexp的前几种情况
sexp := self-evaluate
| symbol
| (quote anything) ; 引用形式
而应该输出的cps-exp是这样的
cps-exp := simple-exp simple-exp := self-evaluate | symbol | (quote anything)
观察以下
(cps 1)
;; =>
1这里我们不用做任何事
(define cps
(lambda (sexp)
(match sexp
[(? self-evaluate?) sexp]
[(? symbol?) sexp]
[`(quote ,thing) sexp])))(sexp sexp)
考虑过程的调用
sexp期待的输入应该是这样的
sexp := (sexp sexp)
而应该输出的cps-exp是这样的
cps-exp := (simple-exp simple-exp k-exp) k-exp := (lambda (var) cps-exp) simple-exp := self-evaluate | symbol | (quote anything)
把前一个sexp称作rator,后一个sexp称作rand
则输入看起来应该是这样子的
`(,rator ,rand)这里的rator和rand又是sexp, 因此需要调用cps函数
(lambda (simple-rator simple-rand)
_cps-exp_)考虑到 cps-exp := (simple-exp simple-exp k-exp)
(lambda (simple-rator simple-rand)
(list simple-rator simple-rand _k-exp_))而这个 k-exp := (lambda (value) cps-exp)
(lambda (simple-rator simple-rand)
(list simple-rator simple-rand
`(lambda (var) _cps-exp_)))这里我们又遇到了 cps-exp,但我们已经完成了一个变换了
我们需要一个参数来帮助我们回到cps的开始
我们可以把这个参数放在(cps)上
(define cps
(lambda (sexp ctx) ...)现在我们可以让ctx来帮助我们做重复的事了
(cps rator
(lambda (simple-rator)
(cps rand
(lambda (simple-rand)
(list simple-rator simple-rand
`(lambda (var) ,(ctx 'var)))))))加入ctx后我们还需要修改之前的情况
(define cps
(lambda (sexp ctx)
(match sexp
[(? self-evaluate?) (ctx sexp)]
[(? symbol?) (ctx sexp)]
[`(quote ,thing) (ctx sexp)]
[`(,rator ,rand)
(cps rator
(lambda (simple-rand)
(list simple-rator simple-rand
`(lambda (var) ,(ctx 'var)))))])))显然这里的ctx都应该是identify
(define identify (lambda (v) v))Lambda表达式
期待的sexp输入
sexp-exp := (lambda (arg) exp)
对应的cps-exp
cps-exp := simple-exp
| (k simple-exp)
| (simple-exp simple-exp k-exp)
simple-exp := (lambda (arg k) cps-exp)
输入看起来应该是这样子的
`(lambda (,arg) ,sexp)(lambda (arg k) …)显然是一个simple-exp,可以让ctx来完成
(ctx `(lambda (,a k) _sexp_))这个 sexp 交给cps递归
[`(lambda (,arg) ,sexp)
(ctx `(lambda (,arg k) ,(cps sexp _?_)))]关于 ? 的内容可以先看几个例子
((lambda (a) a) 1)
;; =>
;; ((lambda (a k) (k a)) 1 _?_)(lambda (a) (f (g a)))
;; =>
;; (lambda (a k) (g a (lambda (v) (f v (lambda (v) (k v))))))看的出来,所有表达式最后都会通过(k x)来返回
我们可以把这个ctx记下来,叫做ctx0
(define ctx0
(lambda (v)
`(k ,v)))也就是我们需要的的 ?
[`(lambda (,arg) ,sexp)
(ctx `(lambda (,arg k) ,(cps sexp ctx0)))]if表达式
经过前面的推导,现在这个变换已经很明显了
[`(if ,test ,then ,else)
(cps test (lambda (simple-test)
`(if ,simple-test
,(cps then ctx)
,(cps else ctx))))]cps变换
最后，得到了我们的cps变换
(define self-evaluate?
(lambda (v)
(or (number? v) (boolean? v))))
(define identify (lambda (v) v))
(define ctx0 (lambda (v) `(k ,v)))
(define cps
(lambda (sexp ctx)
(match sexp
[(? self-evaluate?) (ctx sexp)]
[(? symbol?) (ctx sexp)]
[`(quote ,thing) (ctx sexp)]
[`(if ,test ,then ,else)
(cps test (lambda (simple-test)
`(if ,simple-test
,(cps then ctx)
,(cps else ctx))))]
[`(lambda (,arg) ,sexp)
(ctx `(lambda (,arg k) ,(cps sexp ctx0)))]
[`(,rator ,rand)
(cps rator
(lambda (simple-rator)
(cps rand
(lambda (simple-rand)
(list simple-rator simple-rand
`(lambda (var) ,(ctx 'var)))))))])))改进
一个简单的cps变换已经完成了,但是我们还可以对其进行改进以便于生成更加简洁的结果
improve-1
(cps '(lambda (v) (f a)) identify)
;; =>
;; '(lambda (v k) (f a (lambda (var) (k var))))这里的(lambda (var) (k var))可以做一个beta-规约直接变成k 所以
[`(,rator ,rand)
(cps rator
(lambda (simple-rator)
(cps rand
(lambda (simple-rand)
(if (eq? ctx ctx0)
(list simple-rator simple-rand 'k)
(list simple-rator simple-rand
`(lambda (var) ,(ctx 'var))))))))](cps '(lambda (v) (f a)) identify)
;; =>
;; '(lambda (v k) (f a k))improve-2
有些只接受单一参数而不能接受k参数的过程(原语)
我们需要在`(,ractor ,rand)里处理
simple-exp := (primitive-rator simple-exp)
枚举这些原语过程
(define primitive-rator?
(lambda (x)
(memq x '(add1 sub1 zero? car cdr))))修改cps过程
[`(,rator ,rand)
(cps rator
(lambda (simple-rator)
(cps rand
(lambda (simple-rand)
(cond [(primitive-rator? simple-rator)
(ctx `(,simple-rator ,simple-rand))]
[(eq? ctx ctx0)
(list simple-rator simple-rand 'k)]
[else
(list simple-rator simple-rand
`(lambda (var) ,(ctx 'var)))])))))]如果加入接受多个参数的过程作为原语
[`(,op ,a ,b)
(cps a (lambda (a)
(cps b (lambda (b)
(ctx `(,op ,a ,b))))))]会引起命名冲突
(cps '(+ (f a) (g b)) identify)
;; =>
;; => '(f a (lambda (var) (g b (lambda (var) (+ var var)))))修改`(,rator ,rand)的情况可以解决
(list simple-rator simple-rand
(let ([v (gensym "v")])
`(lambda (,v)
,(ctx v))))此时if的(gensym "v")显得有些浪费,可以改成
[`(if ,test ,then ,else)
(cps test (lambda (simple-test)
(if (memq ctx `(,ctx0 ,identify))
`(if ,simple-test
,(cps then ctx)
,(cps else ctx))
`(let ([k (lambda (v) , (ctx 'v))])
(if ,simple-test
,(cps then ctx0)
,(cps else ctx0))))))]现在运行
(cps '(f (if a b c)) identify)
;; =>
;; '(let ((k
;; (lambda (v)
;; (f v (lambda (v14263) v14263)))))
;; (if a (k b) (k c)))可以得到更为美观的效果
最终代码
(define self-evaluate?
(lambda (v)
(or (number? v) (boolean? v))))
(define ctx0 (lambda (v) `(k ,v)))
(define identify (lambda (x) x))
(define cps
(lambda (sexp ctx)
(match sexp
[(? self-evaluate?) (ctx sexp)]
[(? symbol?) (ctx sexp)]
[`(quote ,thing) (ctx sexp)]
[`(if ,test ,then ,else)
(cps test (lambda (simple-test)
(if (memq ctx `(,ctx0 ,identify))
`(if ,simple-test
,(cps then ctx)
,(cps else ctx))
`(let ([k (lambda (v) , (ctx 'v))])
(if ,simple-test
,(cps then ctx0)
,(cps else ctx0))))))]
[`(lambda (,arg) ,sexp)
(ctx `(lambda (,arg k) ,(cps sexp ctx0)))]
[`(,rator ,rand)
(cps rator
(lambda (simple-rator)
(cps rand
(lambda (simple-rand)
(if (eq? ctx ctx0)
(list simple-rator simple-rand 'k)
(list simple-rator simple-rand
(let ([v (gensym "v")])
`(lambda (,v)
,(ctx v)))))))))]
[`(,op ,a ,b)
(cps a (lambda (a)
(cps b (lambda (b)
(ctx `(,op ,a ,b))))))])))