改自王垠的 r2 直譯器——添加惰性求值和遞迴函數

目錄
  1. 遞迴函數
    1. 為什麼無法使用遞迴函數？
    2. 不動點算子
    3. 實做
  2. 惰性求值
  3. 參考資料

（最近更新：2019-07-22）

王垠可說是中國程式語言界的網路名人。雖然有些人不喜歡他對事物的觀點或是看法，或是他展現出的價值觀，但是有些觀點卻還是很有趣的。比如他之前寫的怎樣寫一個解釋器，利用動態擴展的環境列表還有閉包的概念，將一個程式語言基本的功能簡潔的實踐出來（當然也要歸功於 Scheme 的語法）——閉包、調用變數、運算、儲存變數、環境的調整、函數調用等等，都很有趣。

在看以下的內容以前，請先仔細閱讀過王大的文章，並且了解這個解釋器原始碼的大致運作過程。也要將「#lang racket ;;; 以下三个定义…… (interp exp env0)))」這段直譯器內容下載起來，另存為 r2-orig.rkt 到一個目錄（以下稱為 r2）。

只是他的解釋器有兩個功能尚未實現出來：

  • 遞迴函數
  • 惰性求值

遞迴函數

為什麼無法使用遞迴函數？

因為遞迴函數通常需要 if 和布林判斷符號，以便說明，所以我們需要為添加 r2-orig.rkt 添加 if 和 = （等於）這兩個符號。

請將下面的 patch code 複製另存為 r2-if.patch 至 r2 目錄：

1
2
3
4
5
6
7
8
9
10
11
46a47,50
>     
>       [`(if ,cond ,then ,else)                          ; if
>        (if (interp cond env) (interp then env) (interp else env))]
>     
54c58,60
<            ['/ (/ v1 v2)]))])))
---
>            ['/ (/ v1 v2)]
>            ['= (= v1 v2)] ; be equal to
>            ))])))

輸入指令：

cd [/path/to/r2]
patch r2-orig.rkt r2-if.patch -o r2-if.rkt

其中的 r2-if.rkt 就是增加 if 和 = 功能的 r2。

不支援遞迴函數這點，導致你不能夠定義遞迴函數，不能在函數定義時，於其綁訂的 lambda 出現這個函數的名字。比如說一個階乘函數
$$fact(x) = \begin{cases}
0, & \text{if x = 0} \
x * fact(x - 1) & \text{elsewhere}
\end{cases}$$
因為上式右邊也出現左式的 $fact$ 函數，所以是遞迴函數。

轉成 r2 的函數定義為：

(let [(fact (lambda (x)
               (if (= x 0)
               1
               (* x (fact (- x 1))))))] ...)

但是我們用 r2-if 求算 $fact(10)$ 的時候，會有問題：

(r2 '(let [(fact (lambda (x)
               (if (= x 0)
               1
               (* x (fact (- x 1))))))] (fact 10)))
. . undefined variable fact

這是因為 fact 綁訂在 (lambda (x) ...(fact (- x 1)))))) 這個 closure，而這個 closure 包含的環境，只包含先前被綁訂成功的變數，不包含要被綁訂的 fact。當調用這個 closure 中，想取用這個 fact 閉包的時候，因為環境沒有這個變數，當然會出現錯誤 undefined variable fact。

這時候我們可以用不動點算子來解決。

不動點算子

函數的不動點，可以定義為 $∃x, s.t. f(x)=x$，這裡的 $x$ 就是不動點。

我們如果學過函數式程式設計，就會知道一個重要的概念——函數可以輸入函數，可以輸出另一個函數。

因此我們可以假設有一個函數 $Fix$ 可以輸入函數，又可以輸出函數。但其輸出的函數，等於其輸入的函數。我們將輸入函數以$f$代替，就可以得到下列式子：

$$Fix(f)= f$$

假設我們有遞迴函數如下：

$$fact(x) = if (= x0)then1else~x*fact(x - 1)$$

若要改寫為非遞迴形式，以利 r2 解釋器執行，可以將$fact$定義為另一個函數的輸入變數：

$$F(f)(x) = (if (= x0)then1else~x*f(x - 1))(x)$$

假設我們要執行 $fact(0)$，我們可以改寫為：

$$\begin{aligned}
& F(F(0))(0) \
&= (if (= x0)then1else~x*F(0)(x-1))(0) \
&= 1 \
\end{aligned}
$$

$fact(1)$為：

$$\begin{aligned}
& F(F(F(0)))(1) \
&= (if (= x0)then1else~x*F(F(0))(x-1))(1) \
&= 1 * F(F(0))(0) \
&= 1 * 1 \
&= 1
\end{aligned}
$$

$fact(2)$為：
$$\begin{aligned}
& F(F(F(F(0)))(2) \
&= (if (= x0)then1else~x*F(F(F(0)))(x-1))(2) \
&= 2 * F(F(F(0)))(1) \
&= 2 * 1 \
&= 1
\end{aligned}
$$

觀察一下，我們可以得知，$fact(n)=F(F(F(F(…))),n)$。但是我們不想要寫很多很多的 $F$，怎麼辦呢？這時候，我們需要能夠產出無限多個$F(F(F(…)))$的方式。我們可以定義$G=F(F(F(…)))$，那$fact(n)=F(G)(n)$。

我們換個角度想一下。假設$X=F(X)$，那將內部的$X$用$F(X)$替換，可以得到$X=F(X)=F(F(X))$，這樣下去，我們就可以得到$X=F(F(F(…)))$了！而這和不動點算子的定義$f=fix(f)$形狀也很相似。

假設有一個不動點算子$fix$，滿足$fix(F) = F (fix(F))$，那麼比較上面的$X=F(X)=F(F(F…)))$、$G=F(F(F(…)))$及$fact(n)=F(G)(n)$，那麼$fix(F) = F(F(F(…)))$，$fact(n)=F(fix(F))(n)$（也可因此推得$fact = fix(F)$）。$fact(n)$可展開為：

$$fact(n) = (if (= n0)then1else~x*fix(F)(n - 1))$$

因此，我們可以先定義$fix$是什麼，再定義$F$這個更高階抽象化的函數，最後定義$fact = fix(F)$就行了。

實做

我們參考 Mike Vanier 的下列的不動點算子做運用（推導可以見其網站）：

1
2
3
4
(define Y 
  (lambda (f)
    ((lambda (x) (x x))
     (lambda (x) (f (lambda (y) ((x x) y)))))))

直譯器可以新增letrec定義遞迴函數語法

(letrec ((rec-fun rec-fun-def)) inner)

並參考如下 patch 內容，在第一個 match 裡面增加 let-rec 段，將 let-rec 轉譯改寫為：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
40a41,59
>       [`(let-rec ([,f ,e1]) ,e2) ; 遞迴函數定義
>         (define Y-inner
>           `(lambda (f)
>           ((lambda (x) (x x))
>            (lambda (x) (f (lambda (y) ((x x) y))))))) ; 定義Y組合子
>          
>     
>      ; 定義新函數為 new_func = λf.λx.e1
>      (define new-func `(lambda (,f) ,e1))
>      
>      ; 將遞迴函數 f 重新定義為 Y(new-func) (Fix(f))
>      (define new-binding-pair `(,f (Y new-func)))
> 
>      ; 轉換為 let 後重新執行 interp
>      (interp
>          `(let ((Y ,Y-inner))
>                 (let ((new-func ,new-func))
>                       (let (,new-binding-pair) ,e2))) env)
>       ]

儲存上方 patch 為 r2-let-rec.patch，並套用：

patch r2-if.rkt r2-let-rec.patch -o r2-let-rec.rkt

我們在 DrRacket 用 r2執行下列遞迴函數，可得：

> (r2 '(let-rec ([fact (lambda (x) (if (= x 0) 1 (* x (fact (- x 1)))))]) (fact 10)))
3628800

惰性求值

惰性求值的意思是，當我們定義變數的時候，不要把右式的運算式計算出來，而是要把計算式樹狀圖保存起來。等到我們在別的運算式需要取用變數的時候，再計算這個運算式。

因為定義閉包的時候，我們並沒有拿來計算裡面的內容，而是將它用 Closure 包起來，不需要另外處理，所以我們在用 let 定義變數或函數時：

  • 遇到閉包，則照原來方式處理。
  • 其他運算式、變數、常數，則用另一個 struct Promise 包起來。Promise 包含運算式 thunk，還有定義時的環境 exp（日後計算運算式查找變數值時用到）。

因此我們需要新增新的 struct 定義：

; 定義惰性求值用的待算 promise
(struct Promise (thunk env)
  #:transparent) ; 為取用 Promise 裡面各項的內容，故指定 transparent

let 部份也需要改寫：

[`(let ([,x ,e1]) ,e2)                            ; 绑定（惰性求值）
  (if (and (pair? e1) (eq? (car e1) 'lambda))     ; 如果 e1 是 lambda
      (let ([e1-closure (interp e1 env)])         ; 製作閉包
        (interp e2 (ext-env x e1-closure env)))   ; 綁訂 x 為閉包 e1，執行 e2

      ; 其他情況，將 e1 表達式與環境包為 Promise
      (let ([e1-promise (Promise e1 env)])
        (interp e2 (ext-env x e1-promise env))))]   ; 將 x 綁訂到 promise e1，執行 e2

調查變數值部份也需要改寫，以便於調查時運算 thunk：

[(? symbol? x)                                    ; 变量（配合惰性求值修改）
       (let ([v (lookup x env)])  ; 調查 x 這個變數有沒有值，存到 v 
         (cond
          ; 如果變數不存在丟出錯誤
          [(not v)
            (error "undefined variable" x)]

          ; 如果是 promise，則求出值並回傳結果。
          [(Promise? v) (interp (Promise-thunk v) (Promise-env v))]

          ; 否則丟出 v。
          [else v]))]

以上內容可以寫為以下 patch：

23a24,27
> ; 定義惰性求值用的待算 promise
> (struct Promise (thunk env)
>   #:transparent) ; 為取用 Promise 裡面各項的內容，故指定 transparent
> 
29,34c33,44
<       [(? symbol? x)                                    ; 变量
<        (let ([v (lookup x env)])
<          (cond
<           [(not v)
<            (error "undefined variable" x)]
<           [else v]))]      
---
>       [(? symbol? x)                                    ; 变量（配合惰性求值修改）
>         (let ([v (lookup x env)])  ; 調查 x 這個變數有沒有值,存到 v 
>           (cond
>             ; 如果變數不存在丟出錯誤
>             [(not v)
>               (error "undefined variable" x)]
> 
>             ; 如果是 promise，則求出值並回傳結果。
>             [(Promise? v) (interp (Promise-thunk v) (Promise-env v))]
> 
>             ; 否則丟出 v。
>             [else v]))]      
38,40c48,57
<       [`(let ([,x ,e1]) ,e2)                            ; 绑定
<        (let ([v1 (interp e1 env)])
<          (interp e2 (ext-env x v1 env)))]
---
>       
>       [`(let ([,x ,e1]) ,e2)                            ; 绑定（惰性求值）
>         (if (and (pair? e1) (eq? (car e1) 'lambda))     ; 如果 e1 是 lambda
>           (let ([e1-closure (interp e1 env)])         ; 製作閉包
>             (interp e2 (ext-env x e1-closure env)))   ; 綁訂 x 為閉包 e1,執行 e2
> 
>           ; 其他情況，將 e1 表達式與環境包為 Promise
>           (let ([e1-promise (Promise e1 env)])
>             (interp e2 (ext-env x e1-promise env))))]   ; 將 x 綁訂到 promise e1，執行 e2
>

儲存上方 patch 為 r2-lazy-eval.patch，並套用：

patch r2-let-rec.rkt r2-lazy-eval.patch -o r2-lazy-eval.rkt

參考資料