CPS

CPS

什么是递归？

(define (foo n) 
  (if (zero? n) 0
      (+ n (foo (- n 1)))))
(foo 5) ; print 15

什么是尾递归？

(define (bar m [n 0])
  (if (zero? m) n
      (bar (- m 1) (+ m n))))
(bar 5) ; print 15

那么有什么不同呢？请看下面的图片。

如你所见，foo的调用达到了内存限制。那么区别在哪儿呢？
显然两个函数都是自己在调用自己，不同的是foo调用自己的时候还附带了一份n而这个n需要压入栈中保存起来，而bar在调用后没有任何需要保存的东西，原来的这个栈帧就可以进行复用（这个过程称为tail call elimination）。

当然，这里的两个递归都是用函数式语言编写的，如果换成其他语言比如C/C++，并且不开优化的话第二个就算尾递归也一样会造成栈溢出。

什么是CPS？

#lang racket

(define (foo n)
  (if (zero? n) 0
      (+ n (foo (- n 1)))))

(define (cps-foo n [f (λ (x) x)])
  (if (zero? n) (f n)
      (cps-foo (- n 1) (λ (x) (f (+ x n))))))

(cps-foo 5) ; print 15

对比一下foo和cps-foo以及前面的bar的话，会发现所谓的CPS就是把一个朴素的递归变成了尾递归，那么这是不是说我们再传入一个很大的值的时候也和bar一样不会出现栈溢出了呢？
先看看尾递归的CPS版本

#lang racket

(define (bar m [n 0])
  (if (zero? m) n
      (bar (- m 1) (+ m n))))

(define (cps-bar m [f (λ (x) x)])
  (if (zero? m) (f m)
      (cps-bar (- m 1) (λ (x) (f (+ x m))))))

(cps-bar 5) ; print 15

咋一看，和前面的foo-cps没啥区别，再仔细一看，发现这两个是一摸一样的！那么会出现栈溢出吗？
不会，虽然不会出现栈溢出了，但是却会出现OOM！因为，虽然尾递归优化掉了，但是递归过程中的创建lambda会不断地消耗内存，直到计算结束或者内存耗尽。

那么，这个CPS有啥用呢？

CPS全称Continuation Passing Style，很明显这是一种风格。再结合上面的例子，可以想象CPS的递归就是把一个一个的递归个连接起来，就像一条链一环扣着一环。对上面的例子来说，通过CPS变换，我们可以将递归的过程（节点）暴露出来，这样我们就可以对这些过程做一些的修改了。

下面这个例子可能缺乏说服力（请看后续的call/cc)

上面说的都是函数式语言，那么C/C++呢？如果是C语言的话，我选择死亡，C++的话至少从11开始还有lambda啊！

从图里面可以看出同样一个CPS_SUM不同的编译器差距还真大！再看看内存使用，若不是及时的发送SIGINT就导致内存耗尽了！

call/cc

call/cc 在scheme中是call-with-current-continuation的一个binding。所以，你又见到了这个词continuation，这到底是个啥？
举个例子：

(+ 1 (+ 1 1))  
;; 这个表达式的演算过程是这样的  
(+ 1 (+ 1 1)) -> (+ 1 2) -> 3

可以发现上面的表达式可以分成两个部分： redex和continuation，这里redex指的是当前演算的部分(+ 1 1)，而continuation指的是接下来要演算的部分(+ 1 _)这里_指代前面的redex，所以continuation表达的是“在得到redex演算的值后怎么继续”。

A continuation is a value that encapsulates a piece of an expression’s evaluation context.

下面是几个例子：

(define (foo x)
  (x 1)
  2)
(foo (λ (x) x)) ;; print 2
(call/cc foo) ;; print 1

如你所见，这里面出现了call/cc，毫无疑问，第一个foo的调用打印出2, 但是怎么第二个就打印出1呢？先不做解释，接着看下面这个例子

(define point empty)
(+ 1 (+ 2 (call/cc (λ (cc) (set! point cc) 0)))) ;; print 3
(point 1) ;; print 4
(* 2 (* 3 (point 1))) ;; print 4

好了，又出现奇怪的问题了是不是？下面是call/cc的定义

(call/cc proc [prompt-tag]) → any
  proc : (continuation? . -> . any)
  	prompt-tag	 	:	 	continuation-prompt-tag?
 	 	 	=	 	(default-continuation-prompt-tag)

可以看到call/cc不止接受一个参数，它还有一个默认的参数prompt-tag且这个参数的默认值是(default-continuation-prompt-tag)的返回值。
首先来说说为什么第二个foo的调用打印出了1，这是因为完整的调用是这样

(call/cc foo (default-continuation-prompt-tag))

从call/cc的定义里面可以看出第一个参数是一个procedure也就是这里的foo，这个foo接受一个参数，这个参数在本次调用中是一个continuation这个continuation在(x 1)处被调用，参数是1,然后就不再继续了。为什么不再继续了呢？ 看第二个例子的最后一个表达式

;; 认为应该是这样
(* 2 (* 3 (point 1))) -> (*2 (* 3 4)) -> (* 2 12) -> 24
;; 事实是这样
(* 2 (* 3 (point 1))) -> (point 1) -> 4

原本的continuation被point个替换了，所以不再继续演算。这是call/cc的特性

If the continuation argument to proc is ever applied, then it removes the portion of the current continuation up to the nearest prompt tagged by prompt-tag (not including the prompt; if no such prompt exists, the exn:fail:contract:continuation exception is raised), or up to the nearest continuation frame (if any) shared by the current and captured continuations—whichever is first. While removing continuation frames, dynamic-wind post-thunks are executed. Finally, the (unshared portion of the) captured continuation is appended to the remaining continuation, applying dynamic-wind pre-thunks.

图中出现的call-with-composable-continuation有一点与call/cc不同，那就是它不会替换掉当前的continuation，其中(p2 1)会打印出4。

简单来讲，call/cc就是把某个continuation做个快照（这个快照包含了此时的上下文），你可以把这个快照保持起来做一些奇怪的事，比如：

生成器

;; [LISTOF X] -> ( -> X u 'you-fell-off-the-end)
(define (generate-one-element-at-a-time lst)

  ;; Hand the next item from a-list to "return" or an end-of-list marker
(define (control-state return)
  (for-each 
   (λ (element)
     (set! return (call/cc
                   (λ (resume-here)
                     ;; Grab the current continuation
                     (set! control-state resume-here)
                     (return element)))))
   lst)
  (return 'you-fell-off-the-end))
  
;; (-> X u 'you-fell-off-the-end)
;; This is the actual generator, producing one item from a-list at a time
(define (generator)
  (call-with-current-continuation control-state))

;; Return the generator 
  generator)
(define generate-digit
  (generate-one-element-at-a-time '(0 1 2)))

(generate-digit) ;; 0
(generate-digit) ;; 1
(generate-digit) ;; 2
(generate-digit) ;; you-fell-off-the-end

context 切换 (co-routine)

#lang racket

(require data/queue)

(define q (make-queue))

(define (fork)
  (display "forking\n")
  (call/cc
   (λ (cc)
     (enqueue! q (λ ()
                (cc #f)))
     (cc #t))))

(define (context-switch)
  (display "context switching\n")
  (call/cc
   (λ (cc)
     (enqueue! q
      (λ ()
        (cc 'nothing)))
     ((dequeue! q)))))
#|
(define (end-process)
  (display "ending process\n")
  (let ((proc (dequeue! q)))
    (if (eq? proc 'queue-empty)
        (display "all processes terminated\n")
        (proc))))
|#

(define (end-process)
  (display "ending process\n")
  (let ([over (queue-empty? q)]
        [proc (dequeue! q)])
    (if (eq? over #t)
        (display "all processes terminated\n")
        (proc))))

(define (test-cs)
  (display "entering test\n")
  (cond
    [(fork) (cond
              [(fork) (display "process 1\n")
                      (context-switch)
                      (display "process 1 again\n")]
              [else (display "process 2\n")
                    (end-process)
                    (display "you shouldn't see this (2)")])]
    [else (cond [(fork) (display "process 3\n")
                        (display "process 3 again\n")
                        (context-switch)]
                [else (display "process 4\n")])]))

(test-cs)
(context-switch)
(display "ending process\n")
(end-process)
(display "process ended (should only see this once)\n")

此代码是来自stack overflow经过简单修改后的可运行的版本，输出和SO给出的输出不同。

参考及引用

cps Wikipedia
by exmpale continuation passing style
王垠的「40 行代码」真如他说的那么厉害吗？
Guid Continuation
Reference Continuation
Eval-model 1.1.1 && 1.1.12
call/cc - Wikipedia
context switch