王垠是谁? 不用我说了吧!!!
别傻谈,亮码瞧!
;; A simple CPS transformer which does proper tail-call and does not;; duplicate contexts for if-expressions.;; author: Yin Wang ([email protected])(load "pmatch.scm")(define cps
(lambda (exp)
(letrec
([trivial? (lambda (x) (memq x '(zero? add1 sub1)))]
[id (lambda (v) v)]
[ctx0 (lambda (v) `(k ,v))] ; tail context
[fv (let ([n -1])
(lambda ()
(set! n (+ 1 n))
(string->symbol (string-append "v" (number->string n)))))]
[cps1
(lambda (exp ctx)
(pmatch exp
[,x (guard (not (pair? x))) (ctx x)]
[(if ,test ,conseq ,alt)
(cps1 test
(lambda (t)
(cond
[(memq ctx (list ctx0 id))
`(if ,t ,(cps1 conseq ctx) ,(cps1 alt ctx))]
[else
(let ([u (fv)])
`(let ([k (lambda (,u) ,(ctx u))])
(if ,t ,(cps1 conseq ctx0) ,(cps1 alt ctx0))))])))]
[(lambda (,x) ,body)
(ctx `(lambda (,x k) ,(cps1 body ctx0)))]
[(,op ,a ,b)
(cps1 a (lambda (v1)
(cps1 b (lambda (v2)
(ctx `(,op ,v1 ,v2))))))]
[(,rator ,rand)
(cps1 rator
(lambda (r)
(cps1 rand
(lambda (d)
(cond
[(trivial? r) (ctx `(,r ,d))]
[(eq? ctx ctx0) `(,r ,d k)] ; tail call
[else
(let ([u (fv)])
`(,r ,d (lambda (,u) ,(ctx u))))])))))]))])
(cps1 exp id))));;; tests;; var(cps 'x)(cps '(lambda (x) x))(cps '(lambda (x) (x 1)));; no lambda (will generate identity functions to return to the toplevel)(cps '(if (f x) a b))(cps '(if x (f a) b));; if stand-alone (tail)(cps '(lambda (x) (if (f x) a b)));; if inside if-test (non-tail)(cps '(lambda (x) (if (if x (f a) b) c d)));; both branches are trivial, should do some more optimizations(cps '(lambda (x) (if (if x (zero? a) b) c d)));; if inside if-branch (tail)(cps '(lambda (x) (if t (if x (f a) b) c)));; if inside if-branch, but again inside another if-test (non-tail)(cps '(lambda (x) (if (if t (if x (f a) b) c) e w)));; if as operand (non-tail)(cps '(lambda (x) (h (if x (f a) b))));; if as operator (non-tail)(cps '(lambda (x) ((if x (f g) h) c)));; why we need more than two names(cps '(((f a) (g b)) ((f c) (g d))));; factorial(define fact-cps
(cps
'(lambda (n)
((lambda (fact)
((fact fact) n))
(lambda (fact)
(lambda (n)
(if (zero? n)
1
(* n ((fact fact) (sub1 n))))))))));; print out CPSed function(pretty-print fact-cps);; =>;; '(lambda (n k);; ((lambda (fact k) (fact fact (lambda (v0) (v0 n k))));; (lambda (fact k);; (k;; (lambda (n k);; (if (zero? n);; (k 1);; (fact;; fact;; (lambda (v1) (v1 (sub1 n) (lambda (v2) (k (* n v2))))))))));; k))((eval fact-cps) 5 (lambda (v) v));; => 120
知识背景
Scheme
这个语言我也不会,不过没关系,我们看的是思想.
尾递归
什么是尾递归?
百度百科解释如下:
现代编译器如何优化的呢?
如下就是计算阶乘的一个简单尾递归例子:
function tail_fact(n,a) {
if (n == 0)
return a ;
else
return tail_fact(n-1,n*a) ;
}
CPS
学自http://matt.might.net/articles/by-example-continuation-passing-style/
什么是CPS ?
Continuation-Passing Style, 我译为连续传球风格编程,如下：
（原味）
function foo(x) {
return x ;
}
（CPS）
function cps_foo(x, return_point) {
return return_point (x) ;
}
CPS 多了一个参数 return_point，return_point 来自function的调用者 ，是调用者所在的context，调用者将这个context 传递给cps，这样cps 就无须利用额外的工具（比如堆栈）去查询调用者的环境在哪里(调用位置)，以便返回，而是直接进入这个环境：return_point (x)。
这便是 CPS 的初衷 —— 去掉层层嵌套的世界。行话讲就是 desugar（脱糖）。
Syntax sugar 是为了方便人类的表达和理解，给编程语言的核心套上的一层好吃好看的外衣，而对机器对程序的解释，需要将其还原到最本质的结构，以便机械化处理和优化，这 就是脱糖的意义。
还是那个阶乘栗子：
（原味）
function tail_fact(n,a) {
if (n == 0)
return a ;
else
return tail_fact(n-1,n*a) ;
}
（CPS）
function tail_fact(n,a,ret) {
if (n == 0)
ret(a) ;
else
tail_fact(n-1,n*a,ret) ;
}
炸一看, 没炸出来什么! 也就是多传了一个参数吗? 其实吧,说白了,就是一个回调@@@@
代码解析
这份代码, 就是用Scheme语言写了一个Scheme的解释器。通过他给出的cps函 数，我可以用Scheme这个语言的符号系统重新定义所有Scheme的关键字，并执行正确的程序语义。换言之，它可以让这个语言自己解释自己。本质上， 他的代码是在模仿当初 John McCarthy 发明 Lisp 语言时给出的代码，但用了Scheme风格重写了一遍。
这段代码里 有一些相当有技巧性的部分。主要是那个cps1函数。我承认我也没有完全看懂，但大概能理解它在保持语义的同时基本做到了语言元素的最小化。他的代吗的 31行和37行就是最关键的部分，实现了条件分支和递归调用。基本的原理并不复杂，主要是利用了Scheme的列表解构拆解元素，最终落实到条件分支和函 数调用。如果说得更Scheme风格一点，这个cps函数就是一个自己实现的eval函数。
这个cps的实现中只包含了很少的几个语言特性：定义常量，定义函数，分支（if）和递归。这是满足一个有意义的最小化描述必需的。如果任意引入语言元素，比如while，循环，则可能就会出现语言元素爆炸的情况，陷入无限自证的逻辑怪圈里去。