王垠的40行代码,究竟diao在哪里

王垠是谁? 不用我说了吧!!!

别傻谈,亮码瞧!

;; 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

这个语言我也不会,不过没关系,我们看的是思想.

尾递归

什么是尾递归?

百度百科解释如下:

如果一个函数中所有递归形式的调用都出现在函数的末尾，我们称这个递归函数是尾递归的。当递归调用是整个函数体中最后执行的语句且它的返回值不属于表达式的一部分时，这个递归调用就是尾递归。尾递归函数的特点是在回归过程中不用做任何操作，这个特性很重要，因为大多数现代的编译器会利用这种特点自动生成优化的代码。

现代编译器如何优化的呢?

当编译器检测到一个函数调用是尾递归的时候，它就覆盖当前的活动记录而不是在栈中去创建一个新的. 这也就是FP中不用变量和循环, 只用尾递归也能写出快速代码的重要保障.

如下就是计算阶乘的一个简单尾递归例子:

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，循环，则可能就会出现语言元素爆炸的情况，陷入无限自证的逻辑怪圈里去。

本段摘自http://blog.51cto.com/pencild/1558358