王垠上半生最重要的“杰作”

"我有什么资格说话呢？如果你要了解我的本事，真的很简单：我最精要的代码都放在 GitHub 上了。但是除非接受过专门的训练，你绝对不会理解它们的价值。你会很难想 象，这样一片普通人看起来像是玩具的 40 行 cps.ss 代码，融入了我一个星期的日日 夜夜的心血，数以几十计的推翻重写。这段代码，曾经耗费了一些顶尖专家十多年的研 究。一个教授告诉我，光是想看懂他们的论文就需要不止一个月。而它却被我在一个星 期之内闷头写出来了。我是在说大话吗？代码就摆在那里，自己去看看不就知道了。当 我死后，如果有人想要知道什么是我上半生最重要的“杰作”，也就是这 40 行代码了 。它蕴含的美，超越我给任何公司写的成千上万行的代码。

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

有人能解读一下这段代码吗？什么作用，精美在何处？