3imp ヒープベース VM で Henderson スタイルの letrec

Henderson の SECD マシンで作られた遅延評価 LispKit Lispコンパイラ/VM では、 VM レベルで letrec をサポートしていました。 コンパイラは、 let の実引数を let 外の環境でコンパイルし、 letrec の実引数を letrec 内の環境でコンパイルします。

; Henderson のコンパイラを先行評価で書き直したもの
(define (compile exp env next)
 (match exp
  (('let ((vars args) ...) body)
   (compile-args args env
    `(LDF ,(compile body (cons vars env) `(RTN)) AP ,@next)))
  (('letrec ((vars args) ...) body)
   `(DUM ,(compile-args args (cons vars env)
     `(LDF ,(compile body (cons vars env) `(RTN)) RAP ,@next)))) ))

実行時に、 let を通常のアプリケーション適用で処理するのに対して、 letrec は DUM/RAP 命令によるダミー環境で実引数を評価してから環境中へと破壊的に入れ替えます。 めんどくさい不動点コンビネータを使わずに関数の中からその関数自身を参照させる手軽なやりかたは、 破壊操作を使って関数オブジェクトとそれに閉じ込めてある環境とに循環参照を作れば良いわけです。 循環参照の作り方の流儀は様々で、 RAP は環境中の束縛変数フレームをすげ変えます。 R7RS Scheme では環境の中で作成した関数オブジェクトに、 その環境内の変数を束縛するよう破壊操作します。 Scheme手続き型言語なので set! にマクロ展開すればなんとかなりますが、 LispKit Lisp のような関数型言語は set! をもたないのでマクロ展開しようがどうしようもなくて、 VM レベルに破壊操作を隠し込む必要があるわけです。 同様の事情は遅延評価のためのプロミス・オブジェクトの force メソッドにもあって、 Scheme はライブラリでなんとかできるのに対して、 LispKit Lisp はこれも VM でサポートしてあります。

(let ((x1 a1) (x2 a2)) e)  ⇒  (LDC () <a2> CONS <a1> CONS LDF (<e> RTN) AP . C)

                           S  E (LDC () <a2> CONS . _) D
                   ((A2) . S) E (<a1> CONS . _)        D
                ((A1 A2) . S) E (LDF (<e> RTN) . _)    D
(((<e> RTN) . E) (A1 A2) . S) E (AP . C)               D
                           () ((A1 A2) . E) (<e> RTN)  (S E C . D)

(letrec ((x1 a1) (x2 a2)) e)  ⇒  (DUM LDC () <a2> CONS <a1> CONS LDF (<e> RTN) RAP . C)
                                  S  E (DUM)                         D
                                  S  (() . E) (LDC () <a2> CONS . _) D
                          ((A2) . S) (() . E) (<a1> CONS . _)        D
                       ((A1 A2) . S) (() . E) (LDF (<e> RTN) . _)    D
(((<e> RTN) . (() . E)) (A1 A2) . S) (() . E) (RAP . C)              D
                                  () ((A1 A2) . E) (<e> RTN)         (S E C . D)

3imp のヒープベース AXERS VM は CEK マシンに属すので継続を作るタイミングが SECD マシンとは違いますが、 環境の扱いは両方共同じです。 要するに手続きオブジェクトと環境の循環参照を作れば良いわけで、 下のやりかたは、 RAP とは異なり letrec そのもの用のクロージャを作ることなく環境を破壊操作して即座に適用先にジャンプするようにしています。

(let ((x1 a1) (x2 a2)) e)  ⇒  (<a2> (arg (<a1> (arg (extend <e>)))))

A  (<a2> (arg _)) E                  () S
A2 (<a1> (arg _)) E                (A2) S
A1 (extend <e>)   E             (A1 A2) S
A1 <e>            ((A1 A2) . E)      () S

(letrec ((x1 a1) (x2 a2)) e)  ⇒  (close-dummy 2 (<a2> (arg (<a1> (arg (close-rec <e>))))))

A  (close-dummy 2 _)  E                  () S
A  (<a2> (arg _))    ((#f #f) . E)       () S
A2 (<a1> (arg _))    ((#f #f) . E)     (A2) S
A1 (close-rec <e>)   ((#f #f) . E)  (A1 A2) S   ; A1 が手続きのとき (<a1> ((#f #f) . E)) とダミー環境を閉じ込めています。
A1 <e>               ((A1 A2) . E)       () S   ; r を環境に set-car! して、 (#f #f) を捨てます。
                                                ; そのとき、 A1 に閉じ込めた環境も (<a1> ((A1 A2) . E)) に変わります。

VM に close-dummy 命令と close-rec 命令を追加します。

 (define (VM a x e r s)
  (match x
   (('halt)                 a)
   (('constant obj x1)      (VM obj x1 e r s))
   (('refer level loc x1)   (VM (list-ref (list-ref e level) loc) x1 e r s))
   (('close n body x1)      (VM (list n body e) x1 e r s))
   (('test x1 x2)           (VM a (if a x1 x2) e r s))
   (('assign level loc x1)  (VM (list-set! (list-ref e level) loc a) x1 e r s))
   (('conti x1)             (VM `(1 (nuate ,s 0 0) ()) x1 e r s))
   (('nuate s1 level loc)   (VM (list-ref (list-ref e level) loc) '(return) e r s1))
   (('frame x1 x2)          (VM a x1 e '() (list x2 e r s)))
   (('argument x1)          (VM a x1 e (cons a r) s))
   (('apply) (match a
    ((n1 x1 e1)             (VM a x1 (extend e1 n1 r) '() s))
    ((? procedure? fn) (match s ((x1 e1 r1 s1)
                            (VM (apply fn r) x1 e1 r1 s1))))))
   (('extend n1 x1)         (VM a x1 (extend e n1 r) '() s))
   (('close-dummy n1 x1)    (VM a x1 (extend e n1 (make-list n1)) '() s))
   (('close-rec x1)         (set-car! e r)
                            (VM a x1 e '() s))
   (('return) (match s ((x1 e1 r1 s1)
                            (VM a x1 e1 r1 s1))))))

SECD VM の DUM 命令は空のダミー・フレームを環境に追加しているのに対して、 この VM の close-dummy 命令では実引数リストと同じ長さのダミー・フレームを作って環境に追加しています。 これは、 R7RS の一時変数を使った letrec の実装にあわせるためで、 ダミー・フレームが一時変数の役を果たします。 一方、 R6RS 用なら letrec の実引数評価時に束縛変数への参照・代入を禁止するセマンティクスになっているので、 DUM 命令と同じにしてダミー・フレームを nil にすることができます。

コンパイラに let と letrec を追加し、 アプリケーションともども、 compile-arg を切り出して使いまわします。 下記ではコンパイルの比較のために let を直接コンパイルしていますが、 コンパイラに最適化処理を組み込むつもりなら、 let は lambda 形式へマクロで展開しておく方が扱いやすくなります。

 (define (compile exp env next)
  (match exp
   (('let ((vars args) ...) . body)
    (compile-frame
     (compile-arg args env `(extend ,(length vars)
      ,(compile-seq body (compile-extend env vars) `(return))))
     next))
   (('letrec ((vars args) ...) . body)
    (compile-frame
     `(close-dummy ,(length vars)
       ,(compile-arg args (compile-extend env vars) `(close-rec
        ,(compile-seq body (compile-extend env vars) `(return)))))
     next))
   ((fn . args)
    (compile-frame (compile-arg args env (compile fn env `(apply))) next)) ))

 (define (compile-arg args env next)
   (fold (lambda (arg x) (compile arg env `(argument ,x))) next args))

letrec を使えるようになったので、 階乗計算も書き改めておきます。

(define (fact-demo)
 (define environment `(((= - *) . (,= ,- ,*))))

 (evaluate
  '(letrec
    ((fact (lambda (n)
      (fact-loop n 1) ))
     (fact-loop (lambda (n r)
      (if (= n 0) r (fact-loop (- n 1) (* n r))) )))
    (fact 5))
  environment)

 (evaluate '(fact 5) environment) )