關(guān)于

本文是系列文章中的第八篇，
在上一篇中，我們介紹了continuation的概念，還介紹了Lisp中威力強大的call/cc，它提供了first-class continuation，最后我們用call/cc實現(xiàn)了python中的generator和yield。

call/cc賦予了我們很強的表達能力，Lisp中的異常處理機制也很人性化。
例如，Common Lisp: Condition_system，
由于call/cc可以捕捉到異常處的continuation，
我們就可以手動調(diào)用這個continuation，
讓程序從錯誤的位置以給定狀態(tài)重新開始執(zhí)行，
甚至結(jié)合REPL還可以詢問用戶，讓用戶輸入這個狀態(tài)。

其他語言的try/catch是無法做到這一點的，
我們拿到錯誤時，出現(xiàn)錯誤的那個環(huán)境已經(jīng)被丟棄了，無法恢復(fù)，
那么除了提示用戶程序崩潰了就沒有別的辦法了。

call/cc這么強大，更堅定了我們實現(xiàn)它的想法，
本文就從實現(xiàn)的角度來看call/cc。

尾調(diào)用

In computer science, a tail call is a subroutine call performed as the final action of a procedure.

如果在某個函數(shù)的末尾調(diào)用了另一個函數(shù)，這個調(diào)用就稱為尾調(diào)用。
我們舉個例子吧，

(define (f a)
  (display a)
  (g 2))

(define (g b)
  (display b))

(f 1)

我們看到，函數(shù)f的末尾調(diào)用了函數(shù)g，(g 2)。

尾調(diào)用有什么好處呢？
一個基本的事實是，如果g是f的尾調(diào)用，g就可以不返回到f中，
而直接返回到f該返回的地方。

因為g是f的尾調(diào)用，g后面沒有其他調(diào)用了，
(g 2)調(diào)用結(jié)束后就可以不必返回到f的函數(shù)體中了，而是直接返回到(f 1)處。
因此，調(diào)用g的時候，調(diào)用?？梢圆辉黾?，而是直接廢棄f的調(diào)用環(huán)境即可。

注意，我們上面提到的是『不必返回到f的函數(shù)體中』，
因為不是每個語言都可以做到這一點，
這個語言特性，稱為尾調(diào)用優(yōu)化（tail call optimization）。

調(diào)用棧和調(diào)用圖

調(diào)用棧對我們來說是一個耳熟能詳?shù)拿~，
可是我們有沒有考慮過，為什么調(diào)用構(gòu)成了一個『棧』呢？
有這么多的數(shù)據(jù)結(jié)構(gòu)，為什么不是一個隊列，不是一個樹，不是一個圖呢？

是因為函數(shù)的調(diào)用和返回機制，恰好可以用幀（frame）的壓棧和彈棧來描述。
可是，尾調(diào)用優(yōu)化，開始動搖了這一點，
為了能返回到調(diào)用者該返回的地方，調(diào)用棧有的時候可能會彈出兩次，或者彈出更多次。

進一步，我們再來看call/cc的場景，它使得程序可以直接跳轉(zhuǎn)到之前的某個狀態(tài)，
根本上改變了壓棧彈棧的規(guī)則，跳過去以后，以全新的狀態(tài)重新開始執(zhí)行。
然而，發(fā)生跳轉(zhuǎn)時的狀態(tài)還不能丟棄，因為有可能再跳回來。
因此，call/cc讓調(diào)用不再構(gòu)成一個棧，而是構(gòu)成了一個調(diào)用圖。

CPS

在這些復(fù)雜場景中，為了能顯式的表示執(zhí)行過程，
將程序轉(zhuǎn)化為CPS（continuation passing style）是一種常用的辦法，
CPS是一種程序的書寫風(fēng)格，經(jīng)常作為編譯器的一種中間表示。（IR

; 調(diào)用風(fēng)格
(define (f x)
  (+ (g x) 1))

(define (g x)
  (* x 2))

(f 1)

; CPS
(define (f x cont)
  (g x (lambda (v)
         (cont (+ v 1)))))

(define (g x cont)
  (cont (* x 2)))

(f 1 display)

我們發(fā)現(xiàn)寫成CPS之后，每個函數(shù)多了一個cont參數(shù)，
用來表示該函數(shù)調(diào)用表達式的continuation，
我們調(diào)用一個函數(shù)，就應(yīng)該把它相應(yīng)的continuation顯式的傳給它。
例如，我們在f中調(diào)用了g，那么我們就將(g x)的continuation傳給了g，即(lambda (v) (cont (+ v 1)))。

除此之外，我們還發(fā)現(xiàn)，CPS是一個尾調(diào)用形式，
因此程序的執(zhí)行就變成了continuation的不斷變換生長。

開始動手術(shù)

為了實現(xiàn)call/cc，首先我們要把解釋器改造成CPS形式，
然后再將continuation拿出來包裝一下，提供給用戶使用。

我們先進行第一步改造，CPS，
回憶一下，為了實現(xiàn)詞法作用域，我們給解釋器中每個函數(shù)末尾加上了參數(shù)env，用于表示被求值表達式的環(huán)境。這次也相似，我們給每個函數(shù)加上了新的參數(shù)cont，用于表示被求值表達式的continuation，這樣我們就可以將解釋器改造成CPS形式了。

下一步改造我們要實現(xiàn)call/cc了，它直接使用了這些包含cont參數(shù)的函數(shù)，限于篇幅，CPS形式的解釋器我們就略過了，這里我們只是先看一下handle-decision-tree的樣子吧，

(define (handle-decision-tree tree exp env cont)
  (if (null? tree)
      (error 'handle-decision-tree "failed to make decision")
      (let* ((head (car tree))
             (predicator (car head))
             (decision (cadr head)))
        
        (predicator exp env 
                    (lambda (predicate-result)
                      (if predicate-result
                          (if (not (list? decision))
                              (decision exp env cont)
                              (handle-decision-tree decision exp env cont))
                          (handle-decision-tree (cdr tree) exp env cont)))))))

實現(xiàn)call/cc

將解釋器轉(zhuǎn)換成CPS之后，我們就可以將cont進行包裝了，
下面的實現(xiàn)中，我們將cont包裝成了一個內(nèi)部的數(shù)據(jù)結(jié)構(gòu)continuation。
（和閉包一樣，continuation從實現(xiàn)的角度來看也是一個數(shù)據(jù)結(jié)構(gòu)

然后，把這個數(shù)據(jù)結(jié)構(gòu)提供給用戶，就可以讓用戶代碼實現(xiàn)自定義跳轉(zhuǎn)了。
為了實現(xiàn)這一點，我們在解釋器中判斷是否調(diào)用了continuation，來做相應(yīng)的處理。
handle-decision-tree增加了兩個分支，is-continuation?，is-continuation-call?。

#lang racket

; tool

(struct closure 
  (param body env))

(struct continuation 
  (cont))

(define (create-frame)
  (make-hash))

(define (extend-frame frame key value)
  (hash-set! frame key value))

(define (extend-env env frame)
  (cons frame env))

(define (get-symbol-value env key)
  (let lookup-env
    ((env env))
    (if (null? env)
        (error 'get-symbol-value "failed to find symbol")
        (let ((head-frame (car env)))
          (if (hash-has-key? head-frame key)
              (hash-ref head-frame key '())
              (lookup-env (cdr env)))))))

(define (handle-decision-tree tree exp env cont)
  (if (null? tree)
      (error 'handle-decision-tree "failed to make decision")
      (let* ((head (car tree))
             (predicator (car head))
             (decision (cadr head)))
        
        (predicator exp env 
                    (lambda (predicate-result)
                      (if predicate-result
                          (if (not (list? decision))
                              (decision exp env cont)
                              (handle-decision-tree decision exp env cont))
                          (handle-decision-tree (cdr tree) exp env cont)))))))

; env & cont

(define *env* `(,(create-frame)))

(define *cont* (lambda (v)
                 (display v)))

; main

(define (eval-exp exp env cont)
  (handle-decision-tree 
   `((,is-symbol? ,eval-symbol)
     (,is-self-eval-exp? ,eval-self-eval-exp)
     (,is-continuation? ,eval-continuation)
     (,is-list?
      ((,is-lambda? ,eval-lambda)
       (,is-call/cc? ,eval-call/cc)
       (,is-continuation-call? ,eval-continuation-call)
       (,is-function-call-list? ,eval-function-call-list))))
   exp env cont))

(define (is-symbol? exp env cont)
  (display "is-symbol?\n")
  (cont (symbol? exp)))

(define (eval-symbol exp env cont)
  (display "eval-symbol\n")
  (cont (get-symbol-value env exp)))

(define (is-self-eval-exp? exp env cont)
  (display "is-self-eval-exp?\n")
  (cont (number? exp)))

(define (eval-self-eval-exp exp env cont)
  (display "eval-self-eval-exp\n")
  (cont exp))

(define (is-continuation? exp env cont)
  (display "is-continuation?\n")
  (cont (continuation? exp)))

(define (eval-continuation exp env cont)
  (display "eval-continuation\n")
  (cont exp))

(define (is-list? exp env cont)
  (display "is-list?\n")
  (cont (list? exp)))

(define (is-lambda? exp env cont)
  (display "is-lambda?\n")
  (cont (eq? (car exp) 'lambda)))

(define (eval-lambda exp env cont)
  (display "eval-lambda\n")
  (let ((param (caadr exp))
        (body (caddr exp)))
    (cont (closure param body env))))

(define (is-call/cc? exp env cont)
  (display "is-call/cc?\n")
  (cont (eq? (car exp) 'call/cc)))

(define (eval-call/cc exp env cont)
  (display "eval-call/cc\n")
  (let ((fn (cadr exp))
        (data-cont (continuation cont)))
    (eval-function-call-list `(,fn ,data-cont) env cont)))

(define (is-continuation-call? exp env cont)
  (display "is-continuation-call?\n")
  (eval-exp (car exp) env
            (lambda (value)
              (cont (continuation? value)))))

(define (eval-continuation-call exp env cont)
  (display "eval-continuation-call\n")
  (eval-exp (car exp) env
            (lambda (data-cont)
              (let ((wrapped-cont (continuation-cont data-cont)))
                (eval-exp (cadr exp) env
                          (lambda (arg)
                            (wrapped-cont arg)))))))

(define (is-function-call-list? exp env cont)
  (display "is-function-call-list?\n")
  (cont #t))

(define (eval-function-call-list exp env cont)
  (display "eval-function-call-list\n")
  (eval-exp (car exp) env
            (lambda (clos)
              (eval-exp (cadr exp) env
                        (lambda (arg)
                          (let ((body (closure-body clos))
                                (lexical-env (closure-env clos))
                                (param (closure-param clos))
                                
                                (frame (create-frame)))
                            
                            (extend-frame frame param arg)
                            
                            (let ((executing-env (extend-env lexical-env frame)))
                              (eval-exp body executing-env cont))))))))

測試

(eval-exp '1 *env* *cont*)

(display "\n\n")
(eval-exp '(lambda (x) x) 
          *env* *cont*)

(display "\n\n")
(eval-exp '((lambda (x) x) 
            1) 
          *env* *cont*)

(display "\n\n")
(eval-exp '((lambda (x)
              ((lambda (y) x)
               2))
            1) 
          *env* *cont*)

(display "\n\n")
(eval-exp '((lambda (x)
              ((lambda (f)
                 ((lambda (x)
                    (f 3))
                  2))
               (lambda (z) x)))
            1)
          *env* *cont*)

(display "\n\n")
(eval-exp '(call/cc (lambda (k)
                      1))
          *env* *cont*)

(display "\n\n")
(eval-exp '(call/cc (lambda (k)
                      (k 2)))
          *env* *cont*)

要點分析

（1）eval-call/cc時會創(chuàng)建一個continuation，
然后用這個continuation作為參數(shù)調(diào)用call/cc的參數(shù)。
（call/cc的參數(shù)，就是后面的(lambda (k) 1)，因此k就是這個continuation

; (call/cc (lambda (k) 1))

(define (eval-call/cc exp env cont)
  (display "eval-call/cc\n")
  (let ((fn (cadr exp))
        (data-cont (continuation cont)))
    (eval-function-call-list `(,fn ,data-cont) env cont)))

（2）eval-continuation-call會解開continuation的包裝，得到內(nèi)部包含的cont，
然后用這個cont作為參數(shù)求值表達式，
這樣就實現(xiàn)了，表達式求值完以后跳轉(zhuǎn)到產(chǎn)生cont位置的效果。

(define (eval-continuation-call exp env cont)
  (display "eval-continuation-call\n")
  (eval-exp (car exp) env
            (lambda (data-cont)
              (let ((wrapped-cont (continuation-cont data-cont)))
                (eval-exp (cadr exp) env
                          (lambda (arg)
                            (wrapped-cont arg)))))))

（3）(call/cc ...)表達式中，如果k沒有被調(diào)用，那么(call/cc ...)的值，就是call/cc參數(shù)函數(shù)的返回值，即(call/cc (lambda (k) 1)) = 1。
這一點看起來很難實現(xiàn)，實則不然。

我們只需要巧妙的指定(lambda (k) 1)的continuation，
讓它就是(call/cc (lambda (k) 1))的continuation即可。
這一點體現(xiàn)在eval-call/cc中，我們直接將cont原封不動的傳給了eval-function-call-list

(define (eval-call/cc exp env cont)
   ...
    (eval-function-call-list `(,fn ,data-cont) env cont)))

下文

Lisp語言真是博大精深，寫到這里我們甚至還沒有提及它最重要的語言特性——宏，
Lisp宏提供了一種元編程的手段，同像性讓Lisp元編程異常強大，
然而，把宏說清楚也頗費筆墨，因此，我打算在適當?shù)臅r候單獨討論它。

本系列標題為『柯里化的前生今世』，意在通過柯里化引入種種有趣的概念，
目前為止，我們討論了高階函數(shù)，閉包，continuation，這些可以看做『柯里化的前生』，
我們不但理解了這些概念，還實現(xiàn)了它們，算是小有收獲吧。

使用Racket也有一段日子了，對它也逐漸從陌生到熟悉，
可是偏執(zhí)卻容易讓人誤入歧途，錯過其他風(fēng)景，
下文我們將開啟新的旅程了，Let's go !

參考

continuation passing style
Compiling with Continuations
An Introduction to Scheme and its Implementation