王垠的「40 行代码」真如他说的那么厉害吗？
“我有什么资格说话呢？如果你要了解我的本事，真的很简单：我最精要的代码都放在 GitHub 上了。但是除非接受过专门的训练，你绝对不会理解它们的价值。你会很难想象，这样一片普通人看起来像是玩具的 40 行 cps.ss代码，融入了我一个星期的日日夜夜的心血，数以几十计的推翻重写。这段代码，曾经耗费了一些顶尖专家十多年的研究。一个教授告诉我，光是想看懂他们的论文就需要不止一个月。而它却被我在一
文章共19,469字 · 阅读需要大约65分钟
“我有什么资格说话呢？如果你要了解我的本事，真的很简单：我最精要的代码都放在 GitHub 上了。但是除非接受过专门的训练，你绝对不会理解它们的价值。你会很难想象，这样一片普通人看起来像是玩具的 40 行 cps.ss 代码，融入了我一个星期的日日夜夜的心血，数以几十计的推翻重写。这段代码，曾经耗费了一些顶尖专家十多年的研究。一个教授告诉我，光是想看懂他们的论文就需要不止一个月。而它却被我在一个星期之内闷头写出来了。我是在说大话吗？代码就摆在那里，自己去看看不就知道了。当我死后，如果有人想要知道什么是我上半生最重要的“杰作”，也就是这 40 行代码了。它蕴含的美，超越我给任何公司写的成千上万行的代码。”
有没有人来说说这个东西，我想知道他有没有说大话。
附代码：
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
;
;
A
simple
CPS
transformer
which
does
proper
tail
-
call
and
does
not
;
;
duplicate
contexts
for
if
-
expressions
.
;
;
author
:
Yin
Wang
(
yw21
@
cs
.
indiana
.
edu
)
(
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
|
【精彩解答1】
我不算很熟悉Scheme，只能勉力为之。我知道我的解读也许有错，我也邀请了我熟悉的朋友来回答。他比我懂得更全，应该有帮助。
=== 07/29/2013 更新 ===
当事人到场了。我毕竟是个业余搞函数式编程的。大家还是不要看我这里，看@王垠 的原版解释吧。
===================
我大概读过这段代码：https://github.com/yinwang0/gems/blob/master/cps.ss。简单地说，这段代码做了两件事，一件事是CPS，也就是自动尾递归，第二件事则是用Scheme语言写了一个Scheme的解释器。通过他给出的cps函数，我可以用Scheme这个语言的符号系统重新定义所有Scheme的关键字，并执行正确的程序语义。换言之，它可以让这个语言自己解释自己。本质上，他的代码是在模仿当初 John McCarthy 发明 Lisp 语言时给出的代码，但用了Scheme风格重写了一遍。
这段代码里有一些相当有技巧性的部分。主要是那个cps1函数。我承认我也没有完全看懂，但大概能理解它在保持语义的同时基本做到了语言元素的最小化。他的代吗的31行和37行就是最关键的部分，实现了条件分支和递归调用。基本的原理并不复杂，主要是利用了Scheme的列表解构拆解元素，最终落实到条件分支和函数调用。如果说得更Scheme风格一点，这个cps函数就是一个自己实现的eval函数。当然是简化了一些，没有实现一些更夸张的功能，比如call-with-current-continuation。
注：这个cps的实现中只包含了很少的几个语言特性：定义常量，定义函数，分支（if）和递归。这是满足一个有意义的最小化描述必需的。如果任意引入语言元素，比如while，循环，则可能就会出现语言元素爆炸的情况，陷入无限自证的逻辑怪圈里去。
对这段代码，我自己的建议是，大家可以不必太在乎王垠的宣言。能写出这段代码的人，无疑非常熟悉符号推理的一般规则，也具备相当深厚的数学功底，一般人确实是写不出来。这也符合我对王垠学识的印象。但我也得说，这段代码对多数工程师而言并没有实际价值。不懂也无妨。
======
对不熟悉编译原理和符号推理的朋友们来说，这里可能需要一些额外的说明。请参见下方。
在编译原理的世界里，自举是一个很重要的话题。一个很经典的例子：GCC语言的编译器是C语言写的，但第一个GCC编译器是用另一个编译器编译的；那么顺着这个根源向下跟踪，我们迟早必须回答这个问题，即世界上第一个编译器是什么语言写的——答案是汇编。那么这样下去，我们最终发现，任何程序设计语言都不能完全用自己描述自己。
从工程角度上说，这个问题倒不影响什么。但是从数学角度上看，这个缺陷则让很多人头疼不已，因为它破坏了所谓数学的「美」的原则。这里的「美」，实际的含义是自解释。很多符号逻辑研究者都热衷于找到一种符号体系，能够使用有限的符号系统描述自身。只要找到了这一点，整个解释器的设计可以成为一个自己证明自己的，封闭的体系。
喜欢浪漫的文科朋友们可能会记得希腊神话中的乌洛波洛斯，一条首尾相连象征无穷无尽的蛇。是的，所谓自举就是符号推演世界的乌洛波洛斯，一种纯粹的数学上的和谐和优雅。
可惜对我这个哥德尔定理的信徒而言，这种数学上的美是毫无价值的东西。因为在我的逻辑体系里，这个世界里没有可以自证自身的公理体系。
【精彩解答2】
作为学 PL 的来分析一下他的代码，顺便一说王兄的码品真烂啊，各种单字母，尤其是那个 k……我给几个变量改了名，方便阅读：
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
(
define
cps
(
lambda
(
exp
)
(
letrec
(
[
trivial
?
(
lambda
(
x
)
(
memq
x
'
(
zero
?
add1
sub1
)
)
)
]
[
program
-
end
(
lambda
(
v
)
v
)
]
[
function
-
return
(
lambda
(
v
)
`
(
return
,
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
function
-
return
program
-
end
)
)
`
(
if
,
t
,
(
cps1
conseq
ctx
)
,
(
cps1
alt
ctx
)
)
]
[
else
(
let
(
[
u
(
fv
)
]
)
`
(
let
(
[
return
(
lambda
(
,
u
)
,
(
ctx
u
)
)
]
)
(
if
,
t
,
(
cps1
conseq
function
-
return
)
,
(
cps1
alt
function
-
return
)
)
)
)
]
)
)
)
]
[
(
lambda
(
,
x
)
,
body
)
(
ctx
`
(
lambda
(
,
x
return
)
,
(
cps1
body
function
-
return
)
)
)
]
[
(
,
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
function
-
return
)
`
(
,
r
,
d
return
)
]
;
tail
call
[
else
(
let
(
[
u
(
fv
)
]
)
`
(
,
r
,
d
(
lambda
(
,
u
)
,
(
ctx
u
)
)
)
)
]
)
)
)
)
)
]
)
)
]
)
(
cps1
exp
program
-
end
)
)
)
)
|
这一小段代码非常的了不起，它利用 cps 变换的过程完成了一次编译，这或许就是所谓 Compile with Continuation 吧。代码的主要部件是 cps1 函数，它使用了模式匹配来处理不同算式的 cps 变换，fv 用于生成临时变量，program-end 和 function-return 是两个「后端」，下面会说它们的作用。
这一小段代码应当用了 Danvy 和 Filinski 等在他们的论文（Representing control: a study of the CPS transformation）里的技术。cps1 的入口参数，第一个是将被「编译」的表达式，另一个则很特殊，它并不是续体（一般 cps 变换传入的第二个参数都是续体），而是一个「后端」，一个代码生成器。当这个后端被调用时，它会产生等效于「给续体传值」的表达式出来（值就是入口参数啦）。此处 program-end 后端传入任意表达式之后都返回——呃，表达式自身，它实际上和「将表达式传递给『恒等』续体」等价。类似地，function-return 后端则生成一段代表函数返回的「代码」。
在模式匹配的各个分支中，只看重要的：
- 第一项，变量引用直接丢后端绝不留情，(ctx x)
- lambda 的分支，将 (lambda (x) body) 处理成 (lambda (x return) …) 的形式，也就是说每个函数都要显示传入返回它所用的续体（所谓 Continuation passing），body 部分则经过变换称为 lambda 的身体，用「函数返回」后端「编译」body 表达式。
- 最后一个分支表示函数调用（倒数第二个似乎是二元算符？怎不加过滤啊……），两重嵌套和一般 cps 没有什么区别，而它的「后端」，如果去掉优化的部分，生成的代码是类似这种：
12( < r > < d > ( lambda ( u1 ) <关于 u1 的表达式 > ) )
还记得 lambda 变换之后第二个参数是 Continuation 吗？看，Continuation 就在这里。尾调用优化则是在之前，消除了一层 (lambda)。
看完之后感觉这段代码写的真是有水平，利用构造器可以方便地对 continuation 进行有效分类，并进行各种优化，在仔细分析过后不得不感到佩服。
下面这是一个等效但稍强的 JavaScript 版，它支持多参函数，并会做作用域分析。
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
var
cpstfm
=
function
(
expression
)
{
var
newscope
=
(
function
(
)
{
var
n
=
0
;
return
function
(
parent
)
{
return
{
id
:
's'
+
(
++
n
)
,
hash
:
Object
.
create
(
parent
.
hash
)
,
declare
:
function
(
varid
)
{
return
this
.
hash
[
varid
]
=
this
.
id
;
}
}
}
}
(
)
)
;
var
varquote
=
function
(
scope
,
varid
)
{
return
(
scope
.
hash
[
varid
]
?
scope
.
hash
[
varid
]
:
's?'
)
+
'/'
+
varid
}
var
Id
=
function
(
scope
,
x
)
{
return
x
}
var
FunctionReturn
=
function
(
scope
,
x
)
{
return
[
varquote
(
scope
,
'return'
)
,
x
]
}
var
temp
=
(
function
(
)
{
var
n
=
0
;
return
function
(
)
{
return
'_t'
+
(
++
n
)
}
}
)
(
)
;
var
Continuation
=
function
(
u
,
s
,
Body
)
{
return
[
'.fn'
,
[
u
]
,
Body
(
s
,
u
)
]
}
;
var
stdcps
=
function
(
nMin
,
expression
,
scope
,
backend
)
{
var
finalBackend
=
function
(
s
)
{
if
(
typeof
terms
[
0
]
===
'string'
&&
/
^
[
^
a
-
zA
-
Z_
]
/
.
test
(
terms
[
0
]
)
)
{
return
backend
(
s
,
terms
)
}
else
if
(
backend
===
FunctionReturn
)
return
terms
.
concat
(
[
varquote
(
scope
,
'return'
)
]
)
else
{
var
u
=
temp
(
)
;
return
terms
.
concat
(
[
Continuation
(
u
,
s
,
backend
)
]
)
}
}
;
var
terms
=
expression
.
slice
(
0
,
nMin
)
;
var
b
=
function
(
s
,
x
)
{
terms
[
expression
.
length
-
1
]
=
x
;
return
finalBackend
(
s
)
;
}
;
for
(
var
j
=
expression
.
length
-
2
;
j
>=
nMin
;
j
--
)
(
function
(
j
,
piece
,
b1
)
{
b
=
function
(
s
,
x
)
{
terms
[
j
]
=
x
;
return
cps
(
piece
,
s
,
b1
)
}
}
(
j
,
expression
[
j
+
1
]
,
b
)
)
;
return
cps
(
expression
[
nMin
]
,
scope
,
b
)
;
}
;
var
cps
=
function
(
expression
,
scope
,
backend
)
{
if
(
typeof
expression
===
'string'
)
return
backend
(
scope
,
varquote
(
scope
,
expression
)
)
if
(
typeof
expression
===
'number'
)
return
backend
(
scope
,
expression
)
else
if
(
typeof
expression
[
0
]
===
'string'
&&
/
^
[
^
a
-
zA
-
Z_
$
]
/
.
test
(
expression
[
0
]
)
)
{
switch
(
expression
[
0
]
)
{
case
'.fn'
:
{
var
subscope
=
newscope
(
scope
)
;
var
parameters
=
[
]
;
for
(
var
j
=
0
;
j
<
expression
[
1
]
.
length
;
j
++
)
{
subscope
.
declare
(
expression
[
1
]
[
j
]
)
parameters
[
j
]
=
varquote
(
subscope
,
expression
[
1
]
[
j
]
)
}
subscope
.
declare
(
'return'
)
parameters
.
push
(
varquote
(
subscope
,
'return'
)
)
return
backend
(
scope
,
[
'.fn#'
+
subscope
.
id
,
parameters
,
cps
(
expression
[
2
]
,
subscope
,
FunctionReturn
)
]
)
;
}
case
'.if'
:
{
if
(
!
expression
[
3
]
)
return
cps
(
[
expression
[
0
]
,
expression
[
1
]
,
expression
[
2
]
,
'.undef'
]
,
scope
,
backend
)
else
return
cps
(
expression
[
1
]
,
scope
,
function
(
scope
,
t
)
{
if
(
backend
===
Id
||
backend
===
FunctionReturn
)
{
return
[
'.if'
,
t
,
cps
(
expression
[
2
]
,
scope
,
backend
)
,
cps
(
expression
[
3
]
,
scope
,
backend
)
]
}
else
{
var
subscope
=
newscope
(
scope
)
;
subscope
.
declare
(
'return'
)
;
return
[
[
'.fn#'
+
subscope
.
id
,
[
varquote
(
subscope
,
'return'
)
]
,
[
'.if'
,
t
,
cps
(
expression
[
2
]
,
subscope
,
FunctionReturn
)
,
cps
(
expression
[
3
]
,
subscope
,
FunctionReturn
)
]
]
,
Continuation
(
temp
(
)
,
scope
,
backend
)
]
}
}
)
;
}
;
default
:
return
stdcps
(
1
,
expression
,
scope
,
backend
)
;
}
}
else
{
return
stdcps
(
0
,
expression
,
scope
,
backend
)
;
}
}
return
cps
(
expression
,
{
id
:
's0'
,
hash
:
{
}
}
,
Id
)
}
var
util
=
require
(
'util'
)
;
var
test
=
function
(
expr
)
{
return
console
.
log
(
util
.
inspect
(
cpstfm
(
expr
)
,
{
depth
:
null
,
color
:
true
}
)
)
}
test
(
[
'.fn'
,
[
'n'
]
,
[
[
'.fn'
,
[
'fact'
]
,
[
[
'fact'
,
'fact'
]
,
'n'
]
]
,
[
'.fn'
,
[
'fact'
]
,
[
'.fn'
,
[
'n'
]
,
[
'.if'
,
[
'='
,
'n'
,
0
]
,
1
,
[
'*'
,
'n'
,
[
[
'fact'
,
'fact'
]
,
[
'-'
,
'n'
,
1
]
]
]
]
]
]
]
]
)
|
ps. 其实啊 Flangan 等在他们的论文里已经把这个算法给写了一遍了，只不过没加尾递归优化罢了。
PS：快课教程的酱油王子表示，代码高大上，不评论！
旨在为数千万中国开发者提供一个无缝且高效的云端环境，以支持学习、使用和贡献开源项目。
5w
7
0- 0
扫一扫分享内容
- 分享
已为社区贡献3条内容
顶部
所有评论(0)