解密自动CPS变换
1 前言
我最一开始听到 CPS 变换这个词是在王垠的博客里
(请求不要喷我),就是那篇他第一次宣传他的40行代码的文章。
我当时什么都看不懂,所以没太注意,不过我也正在学程序语言方面的东西,
不久我就在 EOPL 和 The Little Schemer 里面又见到了 CPS。
我有点不服气,知道了 CPS 不过就是这么个东西,
于是我也开始想自己重造王垠40行代码,然后我很惊讶地也花了
刚好一个星期写了出来,而且还基本上跟他的一模一样......
(注意,我不是引战)
毕竟可能每个人有自己的思考方式,我在这里只是分享一下我自己的思路,
我写出这个 CPS 程序的经历。当然为了显得我稍微强一点的样子,
我把中间许多非常蠢的错误都省略了。
其实我也不知道我怎么就把这段代码写出来了。
我写出这个程序以后,又去看了那篇经典论文
Representing Control,
这里有一个更友好一点的版本
How to compile with continuations,
发现我的思路和他的完全不同,我反倒觉得我的思路很清楚,
他的思路我要绕个弯才能看懂,虽然实质上是一样的。
这篇文章不涉及什么是 CPS 变换,CPS 变换入门请参考 The Little Schemer,
我直接就开始写 cps 函数了,我们的目标就是王垠的那40行代码,
我也把我自己的程序的变量名什么的都改成了跟那段代码一样的格式,方便对照,
当然也有一些地方不一样,懒得改了。
我采用 Racket 语言,就是因为用起来方便一些。就这样了。
2 简单的CPS变换
其实一个正确的CPS变换程序,只要学过一点点写解释器的人都会写,
所以我就不细讲了,只是提供一个回忆,你如果要看下去的话最好是这个会自己写。
我们先只考虑λ-calculus的语法,就只有3个分支,变量,λ,函数调用。
先把最简单,没有经过优化的程序写出来。
主要的函数是cps1,它有两个参数expr和ctx,
expr就是一个s-expression,
ctx是当前的context,是一个symbol或'(λ...),
比如(cps1 '(f x) '(λ (x) x))的值为
'(f x (λ (x) x))。所以(cps expr)函数
就是(cps1 expr 'id)或(cps1 expr '(λ (x) x)),
我暂且用前者。
(define (cps expr) (define (atom? x) (not (pair? x))) (define n -1) (define (fv) (set! n (add1 n)) (string->symbol (string-append "v" (number->string n)))) (define (cps1 expr ctx) ....) (cps1 expr 'id))
(define (cps1 expr ctx) (match expr [(? atom? expr) ....] [`(λ(,x) ,body) ....] [`(,rator ,rand) ....]))
或一个原始类型(比如123)时,
我们就直接把它返回,比方说,
(cps1 'x 'k) ==> '(k x) (cps1 'x '(λ(x) ....)) ==> '((λ(x) ....) x)
[(? atom? expr) `(,ctx ,expr)]
只是先递归进函数体内,把函数体进行CPS变换。
每个λ的continuation都为'k,比如,
(cps1 '(λ(x) x) 'id) ==> '(id (λ(x k) (k x)))
[`(λ(,x) ,body) `(,ctx (λ(,x k) ,(cps1 body 'k)))]
然后调用,举个例子,在我们最终要完成的代码里,应该大致是这样的,
(cps1 '((f a) (g b)) 'id) ==> '(f a (λ(v0) (g b (λ(v1) (v0 v1 id)))))
v1是(g b)的结果,然后调用。
(cps1 '(f x) 'id) ==> '((λ(v0) ((λ(v1) (v0 v1 id)) x)) f) <=> '(let ([v0 f]) (let ([v1 x]) (v0 v1 id)))
[`(,rator ,rand) (define v-rator (fv)) (define v-rand (fv)) (cps1 rator `(λ (,v-rator) ,(cps1 rand `(λ (,v-rand) (,v-rator ,v-rand ,ctx)))))]
(cps '((f a) (g b))) ==> '((λ (v4) ((λ (v5) (v4 v5 (λ (v0) ((λ (v2) ((λ (v3) (v2 v3 (λ (v1) (v0 v1 id)))) b)) g)))) a)) f)
不过算作是个很好的开头吧。
3 最简CPS输出
其实下面才开始真正的任务,上面一节只是因为,
市面上的程序都是分好几个函数,我要把它们合在一起。
上面的程序的问题就在于,当ctx是'(λ (v) ...v...),
而且expr是一个'x之类时,输出应该为
'...x...而不是'((λ (v) ...v...) x),
照λ-calculus的术语说就是产生了一个beta-redex。
我们来观察一下现在我们的CPS程序的3个分支产生的ctx
case 1:如果是一个atom,就产生`(,ctx ,expr),这时ctx在函数的位置。
case 2:如果是λ表达式,ctx也在函数的位置。
case 3:但如果是函数调用,这时ctx在参数的位置((vf vx ctx))
很显然,在参数位置时ctx是不可能被化简的,因为结果必须是
(vf vx k/id)或(vf vx (λ (v?) ???))
的形式。而在函数位置时是有可能化简的,当它是λ函数的时候。
为了化简,我们把`(λ (v?) ???)
的quasiquote直接去掉,改成一个函数
(λ (v?) `???),调用它就相当于直接把函数体里面的
v?替换掉了,比如
;; 原来的输出 '((λ(v0) (f v0)) x) ;; 现在变成 ((λ(v) `(f ,v)) 'x) ==> '(f x)
第二,如果ctx是'k/id,
就改成(λ (out) `(k/id ,out))
因为总共就两种情况:ctx在函数位置和参数位置。
我们不妨把cps1函数的ctx参数改成两个,
一个叫ctx-f在函数位置,一个叫ctx-a在参数位置。
;; ctx-f : symbol -> s-exp
;; ctx-a : s-exp(define (cps1 expr ctx-f ctx-a) (match expr ....)) (cps1 expr (λ(out) out) 'id)
(λ (out) out)就是id这个函数。因为原来的slideshow
'id可以看成是`(λ (v?) v?),所以化简后
就变成了(λ (out) out)
[(? atom?) (ctx-f expr)] [`(λ(,x) ,body) (ctx-f `(λ(,x k) ,(cps1 body (λ(out) `(k ,out)) 'k)))]
其中有大量重复的代码,但是不管怎么说,先把代码写出来才是正道
(以下代码会需要一点耐心)
[`(,rator ,rand) (define v-rator (fv)) (define v-rand (fv)) (cps1 rator (λ(out-rator) (cps1 rand (λ(out-rand) `(,out-rator ,out-rand ,ctx-a)) `(λ(,v-rand) (,out-rator ,v-rand ,ctx-a)))) `(λ(,v-rator) ,(cps1 rand (λ(out-rand) `(,v-rator ,out-rand ,ctx-a)) `(λ(,v-rand) (,v-rator ,v-rand ,ctx-a)))))]
跟前面的结果对照一下就会看出明显区别了。
它不但可以处理beta-redex,还能正确处理尾递归。
这段代码应该也不难理解,只是分别讨论了函数和参数分别处于函数位置和参数位置的情况。
大致思路就是,首先,cps1要根据rator和rand
是否为一个atom来决定如何输出,其次,我们不愿意在递归进去之前就判断一次,
递归进去之后又要match expr(开头提到的那篇论文的方法就有这个问题)。
所以我们把现在的状态分成了两个参数,也一起递归进去。
它有唯一一个但很好修复的缺陷,就是v-rator和v-rand
定义地太早了,所以有时候会出现vn不连续的情况,
如果不嫌麻烦的话可以在每次第一次出现v-?的地方再
(let ([v-? (fv)]) ....),当然这个代码看起来就......
另外,做出了下面一道习题后也会很好修复这个缺陷。
在判断出不是atom以后用'vn调用ctx-f,
把它转换成ctx-a,这其实更接近王垠的版本。
甚至还有一个写法,就是利用多返回值,再返回一个布尔值表示当前的选择,
这个方法看起来会有些麻烦。就不提了。
(cps '(f x)) ==> (cps1 'f ctx-f ctx-a) ==> (ctx-f 'f) ==> (cps1 'x .... ....)where[out-rator='f] ==> `(,out-rator ,out-rand id)where[out-rator='f out-rand='x] ==> '(f x id)
(cps '((f a) b)) ==> (cps1 '(f a) ctx-f ctx-a) ==> `(f a ,ctx-a)where[ctx-a='(λ(v0) (v0 b id))] ==> '(f a (λ(v0) (v0 b id)))
现在可以来看一下这段代码对我们有什么启发。
所谓的continuation-passing style多用一个参数k来告诉
我们要调用的函数当前的状态是什么,就是这个函数运行完了以后
应该干什么。但这里的cps函数也有一个参数ctx,
它也表示一个状态,它表示的是现在的状态,让更深层递归的函数能得知一些外部信息。
很多时候我们发现就传一个死的数据(比如第一个版本里的ctx)
是不够的,不但递归进去的函数需要这个数据,而这个数据也要随着当前的情况而变化。
在简单的情况下我们可以传好几个参数,或者一个对象进去,里面的函数
选择性地使用这些数据。但是在支持高阶函数的语言里很多时候方便很多,
因为我们可以传一个函数进去。
其中ctx是这样的,
这种模式更广泛的应用之处在于ctx的参数不是一个用来选择的符号,
而是一个连续数值或对象的时候。我一下子想不出实际的例子,
有了我会补充。
习题:请扩展这个程序以支持多参数的λ和函数调用。
令我惊讶的是,支持多参数就不用分4类讨论了!
因为只要分两类讨论,依次遍历整个列表就可以,
不用区分函数和参数,所以代码反倒简单多了。
推荐做一下这个习题。
4 简化 cps1 函数
这一节,我们把ctx-f和ctx-a合并成一个ctx
观察所有产生的ctx-f/a参数,总结一下总共有这些:
1. λ (out) `(k ,out)
2. 'k
3. λ (out) .... `(.... ,out ....)
4. `(λ (,vn) .... (.... ,vn ....))
如果要只传一个参数的话,我们会发现,由2可以推出1,
因为我们只要给它包一个λ就可以了。
由3可以推出4,如果3是ctx,4就是
`(λ (,vn) ,(ctx vn))
问题就在于,13是一个形式的,24是一个形式的,
我们要选择的就是只传13还是只传24.
我们发现,13是两个固定的值,而24里面是有一堆省略号的,
也就是说,如果采用一点类似作弊的策略,从1也可以推出2,
只要判断ctx是否等于(λ (out) `(k ,out))。
但是无论如何也不可能从任意的4推出3(当然你如果使用eval
的话,我就没话说了,按理来说是可以的,你可以自己尝试一下,
成功了记得偷偷告诉我一声。
于是,我们决定采用13型的ctx。
就是把ctx-f转成ctx-a
就是不直接写出(λ (out) `(k ,out)),而是定义
只要改为(ctx-f->a ctx-f)就可以了。
因为能这样直接转化,所以也没有必要传两个ctx参数了,
我们在需要用到ctx-a时现转化就可以,于是,我们最终得到了这样的代码。
(define (cps1 expr ctx) (match expr [(? atom? expr) (ctx expr)] [`(λ(,x) ,body) (ctx `(λ(,x k) ,(cps1 body ctx1)))] [`(,rator ,rand) (cps1 rator (λ (out-rator) (cps1 rand (λ (out-rand) `(,out-rator ,out-rand ,(ctx-f->a ctx))))))]))
如果对照一下王垠的CPS变换的最后几行,你会发现我的这个版本甚至更清晰一些,
因为我用ctx-f->a这个函数避免了`(,out-rator ,out-rand ....)
这样重复的代码,并把判断也放进了这个辅助函数中。
你现在可以自己随意试验这个程序了。
下面我们对它进行一些扩展,先增加多参数的λ和函数调用,
然后是原生的几个函数(比如+,-,zero?等),
最后添加if语句。
5 多参数和原生函数
都已经到这一步了,支持多参数其实很简单。
[(? atom? expr) (ctx expr)]
[`(λ ,args ,body) (ctx `(λ(,@args k) ,(cps1 body ctx1)))]
[_ ; else : expr = ‘(,rator . ,rands) (let recur ([exprs expr] [acc '()]) (if (null? exprs) `(,@acc ,(ctx-f->a ctx)) (cps1 (car exprs) (λ(v) (recur (cdr exprs) `(,@acc ,v))))))]
思路就是这样,首先最后返回值肯定是
(cps1 (car exprs) (λ (v) ....))
然后省略号要填的是,递归遍历(cdr exprs),所以结构必须是这样的,
(let recur ([exprs expr]) (cps1 (car exprs) ; when exprs is not null (λ (v) (recur (cdr exprs)) (process-v))))
我们需要把之前所有的v : v1 v2 v3 ....收集起来,
返回`(,v1 ,v2 ,v3 .... ,vn ,(ctx-f->a ctx)),
因此再多一个变量acc,用来收集这些v。
这个程序就完成了。你可以自己试验一下确保它正确。
(cps '(+ x y)) ;; instead of (+ x y id) ==> '(+ x y) (cps '(+ (f x) y)) ==> '(f x (λ(v0) (+ v0 y))) (cps '(+ (* x y) z)) ==> '(+ (* x y) z) ;; when used as higher order procedure (cps '(((λ(m) +) n) ; returns + x y)) ==> '((λ(m k) (k +)) n (λ(v0) (v0 x y id)))
[_ (let recur ([exprs expr] [acc '()]) (if (null? exprs) (if (trivial? (car acc)) .... `(,@acc ,(ctx-f->a ctx))) (cps1 (car exprs) (λ(v) (recur (cdr exprs) `(,@acc ,v))))))]
6 if语句
比如,
(cps '(λ(x) (if a b (f c)))) ==> '(λ(x k) (if a (k b) (f c k)))
[`(if ,test ,conseq ,alt) (cps1 test (λ(t) `(if ,t ,(cps1 conseq ctx) ,(cps1 alt ctx))))]
结果发现,这里的ctx是会被翻倍的。
(cps '(λ(x) (f (if a b c)))) ==> '(λ (x k) (if a (f b k) (f c k)))
(cps '(λ(x) (f (g (h (if a b c)))))) ==> '(λ (x k) (if a (h b (λ (v0) (g v0 (λ (v1) (f v1 k))))) (h c (λ (v2) (g v2 (λ (v3) (f v3 k))))))) (cps '(λ(x) (if (if a b c) d e))) ==> '(λ (x k) (if a (if b (k d) (k e)) (if c (k d) (k e))))
第一个例子里面,(h b/c ....)就只有b和c不同,
后面完全一样,第二个例子也是这样。
包住当前的ctx,最终结果变成这样,
(cps '(λ(x) (f (if a b c)))) ==> '(λ(x k) (let ([k (λ(v0) (f v0 k))]) (if a (k b) (k c)))) (cps '(λ(x) (if (if a b c) d e))) ==> '(λ(x k) (let ([k (λ(v0) (if v0 (k d) (k e)))]) (if a (k b) (k c))))
[`(if ,test ,conseq ,alt) (define (if-body ctx) (cps1 test (λ(t) `(if ,t ,(cps1 conseq ctx) ,(cps1 alt ctx))))) (if (ctx1? ctx) (if-body ctx) `(let ([k ,(ctx-f->a ctx)]) ,(if-body ctx1)))]
(cps '(if a b c)) ==> '(let ([k (λ(v0) v0)]) (if a (k b) (k c)))
(define (cps expr) .... (cps1 expr id))
感觉不爽的话,可以这么改一下,
(define (ctx-f->a ctx) (cond [(ctx1? ctx) 'k] [(id? ctx) 'id] [else (define v (fv)) `(λ(,v) ,(ctx v))])) ;; 话说这里用 case 语句会更舒服一点的...
7 总结
这么多代码看下来,其实你会发现,就只有几个关键点,
只要想到了,其实也没有多难。我自己想这个程序的时候,手头上没有电脑,
我是写在纸上的(好痛苦啊),但是放到电脑上测试,一次性就全是对的,
毕竟不是很大的工程,也没有各种复杂的角角落落需要考虑,思路还是很简单的。
这个程序还有升级空间,就是 begin 和 set! 语句,提示一下,
东西越来越复杂的时候,可能不得不回归到第3节中的方式,把各种 ctx 拆开,
否则处理 set! 的时候会产生一堆嵌套的 begin 语句。
另外,如果是Common Lisp里的那种有返回值的赋值语句,处理起来会简单一些,
因为可以简单地看作一个表达式。
最后就随便说说,其实这段代码也没有特别的高级,只是自己写出来了,那就开心一下就好。
代码里倒是有几个挺特别的想法值得学习。
没得写了,就打个广告吧,本文章用 scribble 生成,
不过用它只是因为,它是唯一一个支持racket代码高亮的......
文笔不好请见谅,有任何错误或写的不好的地方欢迎指出。
(define (cps expr) (define (atom? x) (not (pair? x))) (define n -1) (define (fv) (set! n (add1 n)) (string->symbol (string-append "v" (number->string n)))) (define ctx1 (λ(out) `(k ,out))) (define (ctx1? ctx) (eq? ctx ctx1)) (define (ctx-f->a ctx) (if (ctx1? ctx) 'k (let ([v (fv)]) `(λ(,v) ,(ctx v))))) (define (trivial? x) (memq x '(zero? add1 sub1 + - * /))) (define id (λ(x) x)) (define (id? x) (eq? x id)) (define (cps1 expr ctx) (match expr [(? atom?) (ctx expr)] [`(if ,test ,conseq ,alt) (define (if-body ctx) (cps1 test (λ(t) `(if ,t ,(cps1 conseq ctx) ,(cps1 alt ctx))))) (if (or (ctx1? ctx) (id? ctx)) (if-body ctx) `(let ([k ,(ctx-f->a ctx)]) ,(if-body ctx1)))] [`(λ ,args ,body) (ctx `(λ(,@args k) ,(cps1 body ctx1)))] [_ (let recur ([exprs expr] [acc '()]) (if (null? exprs) (if (trivial? (car acc)) (ctx acc) `(,@acc ,(ctx-f->a ctx))) (cps1 (car exprs) (λ(v) (recur (cdr exprs) `(,@acc ,v))))))])) (cps1 expr id))
解密自动CPS变换的更多相关文章
- 基于CPS变换的尾递归转换算法
前言 众所周知,递归函数容易爆栈,究其原因,便是函数调用前需要先将参数.运行状态压栈,而递归则会导致函数的多次无返回调用,参数.状态积压在栈上,最终耗尽栈空间. 一个解决的办法是从算法上解决,把递归算 ...
- cps变换
网上看了很多内容,很少有给出一个准确的概念,它的英文全称是continuous passing style, 直译为连续传递样式,那么cps transform就是将一些原本不是continuous ...
- 如何设计一门语言(八)——异步编程和CPS变换
关于这个话题,其实在(六)里面已经讨论了一半了.学过Haskell的都知道,这个世界上很多东西都可以用monad和comonad来把一些复杂的代码给抽象成简单的.一看就懂的形式.他们的区别,就像用js ...
- 探索c#之递归APS和CPS
接上篇探索c#之尾递归编译器优化 累加器传递模式(APS) CPS函数 CPS变换 CPS尾递归 总结 累加器传递模式(Accumulator passing style) 尾递归优化在于使堆栈可以不 ...
- CPS冥想 - 1 重新审视CPS
这篇文章是在阅读Eric Lippert大神的MSDN Blog文章时同步写成的,其中主要是各种翻译,同时还混杂自己阅读文章的笔记和感想. 原博文地址 http://blogs.msdn.com/b/ ...
- MindSpore:自动微分
MindSpore:自动微分 作为一款「全场景 AI 框架」,MindSpore 是人工智能解决方案的重要组成部分,与 TensorFlow.PyTorch.PaddlePaddle 等流行深度学习框 ...
- 栈编程和函数控制流: 从 continuation 与 CPS 讲到 call/cc 与协程
原标题:尾递归优化 快速排序优化 CPS 变换 call/cc setjmp/longjmp coroutine 协程 栈编程和控制流 讲解 本文为部分函数式编程的扩展及最近接触编程语言控制流的学习和 ...
- 最新的JavaScript核心语言标准——ES6,彻底改变你编写JS代码的方式!【转载+整理】
原文地址 本文内容 ECMAScript 发生了什么变化? 新标准 版本号6 兑现承诺 迭代器和for-of循环 生成器 Generators 模板字符串 不定参数和默认参数 解构 Destructu ...
- 聊聊 Linux 中的五种 IO 模型
本文转载自: http://mp.weixin.qq.com/s?__biz=MzAxODI5ODMwOA==&mid=2666538919&idx=1&sn=6013c451 ...
随机推荐
- 数据层的多租户浅谈(SAAS多租户数据库设计)
在上一篇“浅析多租户在 Java 平台和某些 PaaS 上的实现”中我们谈到了应用层面的多租户架构,涉及到 PaaS.JVM.OS 等,与之相应的是数据层也有多租户的支持. 数据层的多租户综述 多租户 ...
- SQL PLUS的语句执行Commit
oracle 中有个commit,是用来提交事务的.今天发现sql developer和sql plus的数据查询不一样. 如果我们对数据库进行增删改查,在提交sql语句之后,如果不点击commit, ...
- 高通 sensor 从native到HAL
app注册传感器监听 Android Sensor Framework 的整体架构如下图所示: 前几篇sensor相关的文章介绍了sensor的hal的知识,以press_sensor实时显示气压坐标 ...
- mysql ANSI_QUOTES 这个sql_mode的作用(字段可以使用双引号)
首先sql_mode用于mysql的行为,sql_mode的多个值之间用','分隔: 如果想使用双引号就这样做: 1. 修改/etc/my.cnf文件 , 双引号模式是ANSI_QUOTES 或 ...
- nginx ssl 自签证书实验
两台服务器 11.11.11.3 (生成证书然后到CA服务上注册) 11.11.11.4 (nginx服务.CA证书签发) 1.建立CA服务器(11.3) .在CA上生成私钥文件 在/e ...
- ELK-kibana-6.3.2部署
1. 生产实践 .每个ES上面都启动一个Kibana .Kibana都连自己的ES .前端Nginx负载均衡.ip_hash + 验证 + ACL 2. kibana部署 2.1. 软件部署 [yun ...
- 计算机基础-BIOS
BIOS--硬件和软件的纽带(Basic Input Output System) 1.含义:基本的输入输出系统,它是一组固化到计算机内主板上的一个ROM存储芯片上的程序 2.性质:它保存着计算机最重 ...
- Oracle数据库里面查询字符串类型的字段不为空和为空的SQL语句:
一:查询字符串类型的字段的值不为空的SQL: select * from TB_CMS_FLGTINFO_A t where (t.fsta is not null and t.fsta <&g ...
- 洛谷P2342-叠积木
Problem 洛谷P2342-叠积木 Accept: 373 Submit: 1.1k Time Limit: 1000 mSec Memory Limit : 128MB Problem ...
- P1218 [USACO1.5]特殊的质数肋骨 Superprime Rib (数论—素数 + DFS)
这大概是我写的第一个DFS 题目描述 农民约翰的母牛总是产生最好的肋骨.你能通过农民约翰和美国农业部标记在每根肋骨上的数字认出它们.农民约翰确定他卖给买方的是真正的质数肋骨,是因为从右边开始切下肋骨, ...