这是一个创建于 3133 天前的主题，其中的信息可能已经有所发展或是发生改变。
"我有什么资格说话呢？如果你要了解我的本事，真的很简单：我最精要的代码都放在 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))))
有人能解读一下这段代码吗？什么作用，精美在何处？
 |
1
pasturn 2016-05-21 13:09:23 +08:00 via iPhone  1
曲高和寡
|
 |
2
thinker3 2016-05-21 13:38:24 +08:00
|
 |
3
17chai 2016-05-21 13:42:24 +08:00
|
 |
4
jsyangwenjie 2016-05-21 13:42:43 +08:00
把 scheme 代码做 CPS 变换之后解释执行。
|
 |
5
guoer 2016-05-21 15:00:20 +08:00
mingge 可以一战
|
Select Language