码迷,mamicode.com
首页 > 其他好文 > 详细

CPS变换

时间:2018-12-20 14:35:37      阅读:264      评论:0      收藏:0      [点我收藏+]

标签:static   mat   表达式   一段   正是   als   溢出   man   lua   

玩弄Lisp系列第一弹:从王垠的40行CPS变换说起  

2013-12-20 18:00:37|  分类: 默认分类 |  标签:lisp   |举报 |字号 订阅

 
技术分享图片

 

为什么要写这个?

Continuation对于每一个lisper来说都不陌生,CPS相对麻烦一点,而CPS变换可能就相当麻烦了.
我 第一次接触Continuation是在Paul Graham的On Lisp一书中,当时看到那种神奇的能力真的是不明觉厉,后来我开始学习Scheme,我发现Scheme真的是一个比Common Lisp更值得学习的语言,我发现我在学习Scheme过程中取得的进步是学习Common Lisp时所不能比的,尤其是在学习EOPL一书过程中,我用多种方式实现了Continuation,对其有了近乎本质性的理解.所以现在回过头来看看 On Lisp中那坑爹的"Continuation",我只能觉得幼稚,看着那坑爹的"bind=",我只能说"这也算Continuation?"

第一次看到王垠的CPS变换时,我还不怎么了解Continuation,所以那代码对我来说就是天书.但现在情况已经不同了,再次看到这代码时,我能清楚地感觉到自己的进步,因此写一下这个作为我学习Lisp一年三个月的总决.

正文
这里我假设读者已经知道Continuation和CPS是怎么回事,不明白的可以先去看EOPL(Essentials of Programming Languages).

这里我将使用Racket实现CPS变换,因此很多细节都会和王垠的代码不同,但基本思想是一样的.

首先来看看这个cps函数

(define cps
  (lambda (sexp ctx)
    ...))

这里的sexp就是要处理的输入,我们先严格地定义一下

sexp ::= self-evaluate       ;例如数字,布尔值
          |  symbol(不能是k)     ;符号,也可以叫变量名
          |  (quote anything)    ;引用形式,大家因该很熟悉
          |  (if sexp sexp sexp) ;if语句
          |  (lambda (arg) sexp) ;lambda表达式
          |  (sexp sexp)         ;过程的调用

self-evaluate ::= number | boolean

我们把cps函数的输出叫做cps-exp,对CPS有了解的话我们不难发现对应sexp的cps-exp应该是长这个样子的

cps-exp ::= simple-exp
             | (k simple-exp)
             | (simple-exp simple-exp k-exp)
             | (if simple-exp cps-exp cps-exp)

k-exp ::= (lambda (var) cps-exp)

simple-exp ::= self-evaluate | symbol | (quote anything)
                     |  (lambda (arg k) cps-exp)

这样一来cps函数就是要实现(sexp -> cps-exp)这样的变换,
而那个ctx参数的类型则是(simple-exp -> cps-exp).
ctx 代表了evaluation context,例如在(list (a b) 1)中, (a b)的evalution context就是(list [] 1), []在这里就表示(a b)的结果要填入的洞,写成cps就是(a b (lambda (v) (list v 1))).
所以continuation是evaluation context的一种表示方式.不过在这里ctx不能当作continuation(所以也不叫作k),因为它并不总是处于尾调用的位置.
弄 清楚这个ctx是做什么的,想出要用到这个ctx就是算法中在最难的一步(尽管不用也可以,就像cl-cont那样,但是想要生成最简的结果就比较麻烦 了,cl-cont生成的代码冗余度非常大,不过在现代Common Lisp编译器的优化能力下似乎没有什么影响),但既然我们现在已经弄清楚这些东西的类型,那么要实现这个变换已经是手到擒来的了.

首先考虑前面三种情况

sexp ::= self-evaluate       ;例如数字,布尔值
          |  symbol                 ;符号,也可以叫变量名
          | (quote anything)  ;引用形式,大家因该很熟悉

注意到
cps-exp ::= simple-exp
simple-exp ::= self-evaluate | symbol | (quote anything)

这个sexp直接对应simple-exp,
实际上我们不用做任何事,但是要记清楚simple-exp不能直接返回,因为(simple-exp -> cps-exp)由ctx完成,所以我们把sexp传递给ctx.

(define cps
  (lambda (sexp ctx)
    (match sexp
      [(? self-evaluate?) (ctx sexp)]
      [(? symbol?) (ctx sexp)]
      [`(quote ,thing) (ctx sexp)])))

大家应该看出来了如果我们要(cps 1 _) => 1,那我们要在 _ 填入的就是identity函数,即
(define id (lambda (v) v))



下面开始考虑过程的调用

sexp ::= (sexp sexp)

对应的cps-exp是

cps-exp ::= (simple-exp simple-exp k-exp)

k-exp ::= (lambda (var) cps-exp)

simple-exp ::= self-evaluate | symbol | (quote anything)

那么对应的代码应该是长这样子的:
[`(,rator ,rand) ...]
因为rator和rand都是sexp,因此都必须递归调用cps函数对他们进行处理,而ctx参数就对应简化后的simple-exp
[`(,rator ,rand) (cps rator
                      (lambda (simple-rator)
                        (cps rand
                                (lambda (simple-rand)
                                  ...))))]
由于
cps-exp ::= (simple-exp simple-exp k-exp)
结果很自然就是
[`(,rator ,rand) (cps rator
                                   (lambda (simple-rator)
                                      (cps rand
                                              (lambda (simple-rand)
                                                 `(,simple-rator ,simple-rand ...)))))]
我们再来看看这个...中的k-exp是什么东西,由于
k-exp ::= (lambda (var) cps-exp)
所以
[`(,rator ,rand) (cps rator
               
                    (lambda (simple-rator)
       
                               (cps rand
                     
                         (lambda (simple-rand)
                      
                          `(,simple-rator ,simple-rand
                                  
                   (lambda (var) ...))))))]
我们来看一下, ...中应该填入一个cps-exp,而rator,rand已经进行过变换了,没有需要做cps变换的部分的,不能用cps函数得到cps-exp了,剩下的能产生cps-exp的就只有ctx了,那ctx的参数又是什么呢
看看这个例子,
(a (b c)) -> (b c (lambda (var) (a var (lambda (var) var))))
很明显我们不应该再做多余的事,ctx的参数就是‘var,多余的事就交给ctx来完成.
[`(,rator ,rand) (cps rator
                 
                  (lambda (simple-rator)
       
                               (cps rand
                     
                         (lambda (simple-rand)
                              
                  `(,simple-rator ,simple-rand
                          
                           (lambda (var) ,(ctx ‘var)))))))]
但是注意!如果就这样结束,我们在处理((a b) (c d))这样的式子时,将会出现(a b (lambda (var) (c d (lambda (var) (var var)))))这样的结果,这肯定是有问题的.
我们可以利用gensym来生成不同的名字.
[`(,rator ,rand) (cps rator
                
                   (lambda (simple-rator)
         
                             (cps rand
                      
                        (lambda (simple-rand)
                      
                           (let ([var (gensym)])
                           
               `(,simple-rator ,simple-rand
                                    (lambda (,var) ,(ctx var))))))))]


下面加入lambda表达式
sexp ::= (lambda (arg) sexp)

对应的cps-exp是
cps-exp ::= simple-exp
        | (k simple-exp)
        | (simple-exp simple-exp k-exp)

simple-exp ::= (lambda (arg k) cps-exp)
所以
[`(lambda (,arg) ,sexp) ...]
外面这层(lambda (arg k) ...)是一个simple-exp,所以把它交给ctx
[`(lambda (,arg) ,sexpe)
       (ctx `(lambda (,arg k) ...))]
而(lambda (arg) sexp)中的sexp必须用cps函数递归地变换
[`(lambda (,arg) ,sexp)
       (ctx `(lambda (,arg k) ,(cps sexp ...)))]
我们再来看几个例子
((lambda (a) a) 1) => ((lambda (a k) (k a)) 1)

(lambda (a) (f (g a))) => (lambda (a k) (g a (lambda (v) (f v (lambda (v) (k v))))))
lambda表达式里面的过程不管多么复杂,最后的结果都要用k来返回,所以
[`(lambda (,arg) ,sexp)
       (ctx `(lambda (,arg k) ,(cps sexp (lambda (v) `(k ,v)))))]
而(k simple-exp)也正是CPS程序中经常看到的语句
我们可以把这个ctx记下来,叫做ctx0
(define ctx0
  (lambda (v)
    `(k ,v)))
最后
[`(lambda (,arg) ,sexp)
       (ctx `(lambda (,arg k) ,(cps sexp ctx0)))]


下面我们再加入if表达式
[`(if ,test ,then ,else) ...]
注意到
sexp ::= (if sexp sexp sexp)

cps-exp ::= (if simple-exp cps-exp cps-exp)
经过前面的尝试,现在这个变换关系已经很明显了
[`(if ,test ,then ,else) (cps test 
                              (lambda (simple-test)
                                `(if ,simple-test
                                     ,(cps then ctx)
                                     ,(cps else ctx))))]

至此,这个程序的骨架已经完成,我们把他们组装起来.
#lang racket

(define self-evaluate?
  (lambda (thing)
    (or (number? thing) (boolean? thing))))

(define id
  (lambda (v) v))

(define ctx0
  (lambda (v)
    `(k ,v)))

(define cps
  (lambda (sexp ctx)
    (match sexp
      [(? self-evaluate?) (ctx sexp)]
      [(? symbol?) (ctx sexp)]
      [`(quote ,anything) (ctx sexp)]
      [`(if ,test ,then ,else) (cps test 
                              (lambda (simple-test)
                                `(if ,simple-test
                                     ,(cps then ctx)
                                     ,(cps else ctx))))]
      [`(lambda (,arg) ,sexp) (ctx `(lambda (,arg k) ,(cps sexp ctx0)))]
      [`(,rator ,rand) (cps rator
                      (lambda (simple-rator)
                        (cps rand
                             (lambda (simple-rand)
                               (let ([var (gensym)])
                                 `(,simple-rator ,simple-rand
                                    (lambda (,var) ,(ctx var))))))))])))



下面我们可以对其进行改进,以便于生成更简洁易读的结果

首先我们看
> (cps ‘(lambda (v) (f a)) id)
‘(lambda (v k) (f a (lambda (var) (k var))))

很明显,这个(lambda (var) (k var))可以做一个beta-归约变成k,此时ctx是ctx0,
所以
[`(,rator ,rand) (cps rator
                      (lambda (simple-rator)
                        (cps rand
                             (lambda (simple-rand)
                               (if (eq? ctx ctx0)
                                   `(,simple-rator ,simple-rand k)
                                   (let ([var (gensym)])
                                     `(,simple-rator ,simple-rand
                                        (lambda (,var) ,(ctx var)))))))))]


下面开始加入一些原语,也就是接受单一参数,不接受k参数的过程,像zero?这样
增加定义
simple-exp |= (primitive-rator simple-exp)
先定义一些这样的过程
(define primitive-rator?
  (lambda (x)
    (memq x ‘(add1 sub1 zero? car cdr))))

这样(car v) => (car v), (f (car x)) => (f (car x) (lambda (var) var)),不需要k,
我们要在[`(,rator ,rand) ...]里处理这种情况
显然最终结果`(,simple-rator ,simple-rand)是一个simple-exp,对于一个simple-exp我们只需直接交给ctx

 [`(,rator ,rand) (cps rator
                       (lambda (simple-rator)
                         (cps rand
                              (lambda (simple-rand)
                                (cond [(primitive-rator? simple-rator)     
                                       (ctx `(,simple-rator ,simple-rand))] ;就是这样
                                      [(eq? ctx ctx0)
                                       `(,simple-rator ,simple-rand k)]
                                      [else (let ([var (gensym)])
                                              `(,simple-rator ,simple-rand
                                                 (lambda (,var) ,(ctx var))))])))))]


同理,如果要再加入一些二元操作符作为原语
[`(,op ,a ,b) (cps a
                   (lambda (a)
                     (cps b
                          (lambda (b)
                            (ctx `(,op ,a ,b))))))]

还有一个情况就是
> (cps ‘(f (if a b c)) id)
‘(if a (f b (lambda (v61460) (v61460)) (f c (lambda (v61461) v61461))))

注意到这里的(f _ (lambda (var) var))出现了两次,为了减少重复,我们可以把它变成

(let ([k (lambda (v) (f v (lambda (v) v)))]) 
  (if a (k b) (k c)))

追加定义

cps-exp |= (let ([k k-exp])
             cps-exp)

不过当ctx是ctx0时,结果会
(let ((k (lambda (v) (k v))))
  (if a (k b) (k c)))
没有必要

当ctx是id时
(let ((k (lambda (v) v))) (if a (k b) (k c)))
也没有必要

所以最终结果就是
[`(if ,test ,then ,else) (cps test 
                              (lambda (simple-test)
                                (if (memq ctx `(,ctx0 ,id))
                                    `(if ,simple-test
                                         ,(cps then ctx)
                                         ,(cps else ctx))
                                    `(let ([k (lambda (v) ,(ctx ‘v))])
                                          (if ,simple-test
                                              ,(cps then ctx0)
                                              ,(cps else ctx0))))))]

这样基本上就等同于王垠的算法了.如果再弄个大过程包装起来,就一样了.

最终得到的代码就是

#lang racket

(define self-evaluate?
  (lambda (thing)
    (or (number? thing) (boolean? thing))))

(define id
  (lambda (v) v))

(define ctx0
  (lambda (v)
    `(k ,v)))

(define primitive-rator?
  (lambda (x)
    (memq x ‘(add1 sub1 zero? car cdr))))

(define cps
  (lambda (sexp ctx)
    (match sexp
      [(? self-evaluate?) (ctx sexp)]
      [(? symbol?) (ctx sexp)]
      [`(quote ,thing) (ctx sexp)]
      [`(if ,test ,then ,else) (cps test 
                                    (lambda (simple-test)
                                      (if (memq ctx `(,ctx0 ,id))
                                          `(if ,simple-test
                                               ,(cps then ctx)
                                               ,(cps else ctx))
                                          `(let ([k (lambda (v) ,(ctx ‘v))])
                                             (if ,simple-test
                                                 ,(cps then ctx0)
                                                 ,(cps else ctx0))))))]
      [`(lambda (,arg) ,sexp) 
       (ctx `(lambda (,arg k) ,(cps sexp ctx0)))]
      [`(,rator ,rand) (cps rator
                            (lambda (simple-rator)
                              (cps rand
                                   (lambda (simple-rand)
                                     (cond [(primitive-rator? simple-rator)     
                                            (ctx `(,simple-rator ,simple-rand))]
                                           [(eq? ctx ctx0)
                                            `(,simple-rator ,simple-rand k)]
                                           [else (let ([var (gensym)])
                                                   `(,simple-rator ,simple-rand
                                                      (lambda (,var) ,(ctx var))))])))))]
      [`(,op ,a ,b) (cps a
                         (lambda (a)
                           (cps b
                                (lambda (b)
                                  (ctx `(,op ,a ,b))))))])))

我们掌握了这个ctx的用法之后,可以把它应用到许多的场合,例如对lambda演算的ANF变换

(define anf 
  (lambda (lc-exp)
    (define var? symbol?)
    (define val?
      (lambda (v)
        (match v
          [(? var?) #t]
          [`(lambda (,x) ,bd) #t]
          [_ #f])))
    (define id (lambda (x) x))
    (define anf1
      (lambda (lc-exp ctx)
        (match lc-exp
          [(? var?) (ctx lc-exp)]
          [`(lambda (,arg) ,lc-exp) (ctx `(lambda (,arg) ,(anf1 lc-exp id)))]
          [`(,rator ,rand) 
           (anf1 rator
                 (lambda (simple-rator)
                   (anf1 rand 
                         (lambda (simple-rand)
                           (if (val? simple-rator)
                               (if (val? simple-rand)
                                   (ctx `(,simple-rator ,simple-rand))
                                   (let ([rand-var (gensym "rand")])
                                     `(let ([,rand-var ,simple-rand])
                                        ,(ctx `(,simple-rator ,rand-var)))))
                               (let ([rator-var (gensym "rator")])
                                 `(let ([,rator-var ,simple-rator])
                                    ,(anf1 `(,rator-var ,simple-rand) ctx))))))))])))
    (anf1 lc-exp id)))


示例:
> (anf ‘(f (lambda (a) (f (b a)))))
‘(f (lambda (a) (let ((rand526 (b a))) (f rand526))))
相信大家已经能很容易看懂了
 
技术分享图片
 

 

 

 
 

玩弄Lisp系列第1.5弹?CPS逆变换  

2013-12-24 15:11:51|  分类: 默认分类 |  标签:lisp   |举报 |字号 订阅

 
 
    闲得无聊弄了这么个玩意,原理和前面的CPS变换一模一样,不重复说明了。

#lang racket
(require "cps.rkt")

(define lookup
  (lambda (s env)
    (cond [(assq s env) => cdr]
          [else s])))

(define ext
  (lambda (k v env)
    (cons (cons k v) env)))

(define env0 ‘())

(define expand-k
  (lambda (sexp k-exp env ctx)
    (match k-exp
      [‘k (ctx sexp)]
      [`(lambda (,v) ,cps-exp)
       (uncps cps-exp (ext v sexp env) ctx)])))

(define uncps
  (lambda (cps-exp [env env0] [ctx id])
    (match cps-exp
      ;;simple-exp
      [(? self-evaluate? self) (ctx self)]
      [(? symbol? sym) (ctx (lookup sym env))]
      [`(quote ,x) (ctx cps-exp)]
      [`(lambda (,a k) ,cps-exp) (ctx `(lambda (,a) ,(uncps cps-exp env id)))]
      [`(,(? unary-op? rator) ,simp-rand)
       (uncps simp-rand env
              (lambda (rand)
                (ctx `(,rator ,rand))))]
      [`(,(? bin-op? rator) ,simp-v1 ,simp-v2)
       (uncps simp-v1 env
              (lambda (v1)
                (uncps simp-v2 env
                       (lambda (v2)
                         (ctx `(,rator ,v1 ,v2))))))]
      
      ;;cps-exp
      [`(if ,simp-test ,cps-then ,cps-else)
       (uncps simp-test env
              (lambda (test)
                `(if ,test
                     ,(uncps cps-then env ctx)
                     ,(uncps cps-else env ctx))))]
      [`(let ([k ,k-exp]) ,e)
       (expand-k (uncps e env id) k-exp env ctx)]
      [`(k ,simp) (uncps simp env ctx)]
      [`(,simp-rator ,simp-rand ,k-exp)
       (uncps simp-rator env
              (lambda (rator)
                (uncps simp-rand env
                       (lambda (rand)
                         (expand-k `(,rator ,rand) k-exp env ctx)))))])))

修改了一点的CPS变换代码:
#lang racket
(provide cps self-evaluate? id bin-op? unary-op?)

(define self-evaluate?
  (lambda (thing)
    (or (number? thing) (boolean? thing))))

(define id
  (lambda (v) v))

(define ctx0
  (lambda (v)
    `(k ,v)))

(define unary-op?
  (lambda (x)
    (memq x ‘(add1 sub1 zero? car cdr))))

(define bin-op?
  (lambda (x)
    (memq x ‘(cons + - * / < > = <= >=))))

(define cps
  (lambda (sexp [ctx id])
    (match sexp
      [(? self-evaluate?) (ctx sexp)]
      [(? symbol?) (ctx sexp)]
      [`(quote ,thing) (ctx sexp)]
      [`(if ,test ,then ,else) (cps test 
                                    (lambda (simple-test)
                                      (if (memq ctx `(,ctx0 ,id))
                                          `(if ,simple-test
                                               ,(cps then ctx)
                                               ,(cps else ctx))
                                          `(let ([k (lambda (v) ,(ctx ‘v))])
                                             (if ,simple-test
                                                 ,(cps then ctx0)
                                                 ,(cps else ctx0))))))]
      [`(lambda (,a) ,e) 
       (ctx `(lambda (,a k) ,(cps e ctx0)))]
      [`(,rator ,rand) (cps rator
                            (lambda (simple-rator)
                              (cps rand
                                   (lambda (simple-rand)
                                     (cond [(unary-op? simple-rator)
                                            (ctx `(,simple-rator ,simple-rand))]
                                           [(eq? ctx ctx0)
                                            (list simple-rator simple-rand ‘k)]
                                           [else 
                                            (let ([v (gensym "v")])
                                              (list simple-rator simple-rand
                                                    `(lambda (,v)
                                                       ,(ctx v))))])))))]
      [`(,(? bin-op? op) ,a ,b) (cps a
                                     (lambda (a)
                                       (cps b
                                            (lambda (b)
                                              (ctx `(,op ,a ,b))))))])))

然后是抄来的测试案例:

(define test
  (lambda (sexp)
    (equal? (uncps (cps sexp)) sexp)))

(define test-all
  (lambda ()
    (andmap test
            ‘(
              x
              (lambda (x) x)
              (lambda (x) (x 1))
              (if (f x) a b)
              (if x (f a) b)
              (lambda (x) (if (f x) a b))
              (lambda (x) (if (if x (f a) b) c d))
              (lambda (x) (if (if x (zero? a) b) c d))
              (lambda (x) (if t (if x (f a) b) c))
              (lambda (x) (if (if t (if x (f a) b) c) e w))
              (lambda (x) (h (if x (f a) b)))
              (lambda (x) ((if x (f g) h) c))
              (((f a) (g b)) ((f c) (g d)))
              (lambda (n)
                ((lambda (fact)
                   ((fact fact) n))
                 (lambda (fact)
                   (lambda (n)
                     (if (zero? n)
                         1
                         (* n ((fact fact) (sub1 n))))))))))))

测试通过:
> (test-all)
#t
 
*****************************************************
就是將一段代碼轉換爲等價的 Continuation Passing Style。這東西不好解釋,推薦去看這本書: Essentials of Programming Languages (搞 scheme 的都應該認識本書的作者, Daniel P Friedman,這人也是王珢在 Indiana 大學的導師)
 
他自己以前说过:自动的CPS变换. 用伪C代码解释一个:
比如, 变换前的:
int sum(int* arr, int len){
if(len <= 0) return 0; else return arr[0] + sum(arr+1, len-1);
}
调用: print(sum([1,2,3,4], 4)) //输出 10;

变换后的:
void sum_cps(int sum, int* arr, int len, void (callback*)(int)){
if(len <= 0) callback(sum);
else sum_cps(sum + arr[0], arr+1, len-1, callback);
}
调用:(sum_cps, 0, [1,2,3,4], 4, print);
这样变换以后, 自动变成尾递归. sum 每次递归调用需要把arr[0] 压栈, len大时会堆栈溢出, 而sum_cps,需要的栈为0, 不会堆栈溢出.
递归调用是FP的根本, 所以自动实现这种变换意义很大.
 
 
CPS的基本思想是将普通函数的return转换为调用另一个函数(即这个函数的continuation),由于函数永远都不会返回,我们也就不需要调用栈。举例来说呢,Chicken Scheme这样的编译器就会利用CPS来消除调用栈。
另外,如果一个程序写成了CPS形式的话,call/cc这个special form可以用一个普通函数来实现:

(lambda (f k) (f (lambda (v k0) (k v)) k))

由于call/cc一直是解释器性能优化的一个难点,不难理解CPS转换对于现代函数式语言的编译器、解释器的重要意义了。
 
************************************************************
http://www.cppblog.com/vczh/
http://zhuanlan.zhihu.com/dummydigit
****************************************

 

 

=============== End

 

CPS变换

标签:static   mat   表达式   一段   正是   als   溢出   man   lua   

原文地址:https://www.cnblogs.com/lsgxeva/p/10148511.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!