3imp ヒープベース compile/VM での begin 形式

Dybvig Three Implementation Models for Scheme (以下 3imp) では、 begin 形式と lambda 形式のボディを、 入れ子の lambda 形式へ変換してコンパイルするとあります。 それでも間違いではないのですが、 一つ注意点があって、 入れ子になっている lambda 形式の束縛変数は変換時に gensym で作ったもの、 もしくはボディ中の束縛変数と自由変数の両方に一致しないようにα変換したものでなければなりません。 このことは、 ボディでは lambda 形式への変換で作られた束縛変数を決して参照できないことを意味しており、 参照されることがない変数は最適化で除去されて環境フレームが空になります。 当然、 空の環境フレームはあっても無駄なので最適化で環境から取り除かれます。 結果として、 入れ子の lambda 形式に変換したとしても、 環境はボディ開始時点のものをシーケンスの個々の式の評価に受け渡していくだけだということになります。 この結論は CEK マシンのシーケンスの遷移に一致します。

begin を実装するには、 シーケンスの並びの一つ一つを評価する前に、 その時点の環境をクローズして継続を作るようにします。 当然ながら、 この継続でシーケンスの次の式を評価をするようにジャンプ先を指定します。このような継続は 3imp VM の frame 命令で作ることができるので、 begin は frame 命令を使って実装する方が CEK マシンに合っています。
ということで、 begin と lambda ボディの並びをコンパイラに組み込むと、 次のようになります。

2017年11月29日改訂: match 形式を使って書き改めました。 call/cc のコンパイルのバグを修正しました。

(use util.match)

(define (compile-3imp-heapbased exp env next)

 (define (compile-seq exp* env next)
  (if (null? (cdr exp*))
      (compile (car exp*) env next)
      (compile (car exp*) env (compile-seq (cdr exp*) env next)) ))

 (define (extend env r) (cons r env))

 (define (lookup var env kont)
  (let loop-level ((env env) (level 0))
   (if (null? env) (error "variable not found -- compile" var)
    (let loop-loc ((frame (car env)) (loc 0))
     (cond
      ((null? frame) (loop-level (cdr env) (+ level 1)))
      ((eq? var (car frame)) (kont level loc))
      (else (loop-loc (cdr frame) (+ loc 1))) )))))

 (define (compile-frame code next)
  (if (equal? next '(return))
   code
   `(frame ,next ,code)))

 (define (compile exp env next)
  (match exp
   ((? symbol? var)
    (lookup var env (lambda (level loc) `(refer (,level ,@loc) ,next))))
   (('quote obj)
    `(constant ,obj ,next))
   (('lambda param . body)
    `(close ,(compile-seq body (extend env param) '(return)) ,next))
   (('call/cc exp1)
    (compile-frame `(conti (argument ,(compile exp1 env '(apply)))) next))
   (('set! var exp1)
    (compile exp1 env (lookup var env (lambda (level loc) `(assign (,level ,@loc) ,next)))))
   (('if pred suc)
    (compile pred env `(test ,(compile suc env next) (constant #f ,next))))
   (('if pred suc alt)
    (compile pred env `(test ,(compile suc env next) ,(compile alt env next))))
   (('begin)
    `(constant #f ,next))
   (('begin exp1 . _)
    (compile-seq (cdr exp) env next))
   ((fn . args)
    (compile-frame
     (fold (lambda (arg code) (compile arg env `(argument ,code)))
           (compile fn env '(apply))
           args)
     next))
   (_ `(constant ,exp ,next))))

 (compile exp env next))

例えば、 アプリケーションを 3 つ並べたラムダ形式をコンパイルすると次のようになります。

gosh> (compile-3imp-heapbased '((lambda (x) (f x) (g x) (h x)) 3) '((f g h)) '(halt))
(frame (halt)
  (constant 3 (argument (close
      (frame 
        (frame (refer (0 . 0) (argument (refer (1 . 2) (apply))))
          (refer (0 . 0) (argument (refer (1 . 1) (apply)))))
        (refer (0 . 0) (argument (refer (1 . 0) (apply)))))
    (apply)))))

これでは読みにくいので実行順に整理してみます。 VM の遷移を追うと環境のセーブとリストアを期待したようにおこなっています。

#C01=(frame #C20#   ; e  a         r       s
#C02=(constant 3    ; e  a         r1= ()  (#C20# e r s)
#C03=(argument      ; e  3         r1= ()  (#C20# e r s)
#C04=(close #C06#   ; e  3         r1=(3)  (#C20# e r s)
#C05=(apply)))))    ; e  (#C06# e) r1=(3)  (#C20# e r s)
;(lambda (x) (f x) (g x) (h x))
#C06=(frame #C11#   ; e1 (#C06# e) r1= ()  (#C20# e r s)
#C07=(refer (0 . 0) ; e1 (#C06# e) r2= ()  (#C11# e1 r1 (#C20# e r s))
#C08=(argument      ; e1 3         r2= ()  (#C11# e1 r1 (#C20# e r s))
#C09=(refer (1 . 0) ; e1 3         r2=(3)  (#C11# e1 r1 (#C20# e r s))
#C10=(apply)))))    ; e1 (#f# e)   r2=(3)  (#C11# e1 r1 (#C20# e r s))
#C11=(frame #C16#   ; e1 af        r1= ()  (#C20# e r s)
#C12=(refer (0 . 0) ; e1 af        r3= ()  (#C16# e1 r1 (#C20# e r s))
#C13=(argument      ; e1 3         r3= ()  (#C16# e1 r1 (#C20# e r s))
#C14=(refer (1 . 1) ; e1 3         r3=(3)  (#C16# e1 r1 (#C20# e r s))
#C15=(apply)))))    ; e1 (#g# e)   r3=(3)  (#C16# e1 r1 (#C20# e r s))
#C16=(refer (0 . 0) ; e1 ag        r1= ()  (#C20# e r s)
#C17=(argument      ; e1 3         r1= ()  (#C20# e r s)
#C18=(refer (1 . 2) ; e1 3         r1=(3)  (#C20# e r s)
#C19=(apply))))     ; e1 (#h# e)   r1=(3)  (#C20# e r s)

#C20=(halt)         ; e  ah        r       s