3imp では、 ヒープベース VM をディスプレイ・クロージャにする段階を飛ばして、 スタックベース VM へ進んでいきます。 ここでは、 ものは試しと、 ヒープベース VM をディスプレイ・クロージャに変更することにします。

ディスプレイ・クロージャの元になっているアイデアは PASCAL の駆動フレームの最適化方法から拝借したもので、 スタティック・リンクの深いリンク先へのポインタを配列に並べて高速にアクセスできるようにしたものです。 PASCAL でこの最適化をおこなうと、 一つ深いレベルの手続きに入るとすぐにスタティック・リンクの先からポインタ配列をコピーして、 その都度ディスプレイ配列を作り替えていくコードを生成します。 なお、 x86 と x86_64 の ENTER 命令はこのコピーを自動的におこなう機能をもっています。 Scheme では、 環境の入れ子のリストを入れ子のベクタへ変更することで、 同じ仕組みにすることができます。

((val0.0 val0.1 val0.2 ...) (val1.0 val1.1 val1.2 ...) ...) ↓ #(#(val0.0 val0.1 val0.2 ...) #(val1.0 val1.1 val1.2 ...) ...)

階乗計算をおこなうには、 環境を変更し、 値リストをベクタに変更したものを使うことにします。

( define environment `((( fact ) . # ( #f )) (( = - * ) . # (, = , - , * ))) ) ( evaluate '( set! fact ( lambda ( n ) (( lambda ( loop ) ( set! loop ( lambda ( n r ) ( if ( = n 0 ) r ( loop ( - n 1 ) ( * n r ))))) ( loop n 1 )) '()))) environment ) ( evaluate '( fact 5 ) environment )

そして、 evaluate 手続きで、 環境の変数リストのリストを作ってコンパイル時環境に使い、 値ベクタのベクタを作って実行時環境に使うことにします。

( define ( evaluate exp env ) ( let (( compile-env ( map car env )) ( runtime-env ( list->vector ( map cdr env ))) ) ( VM '() ( compile exp compile-env '( halt )) runtime-env '() '()) ))

ヒープベース VM をディスプレイ・クロージャに変更するとき、 元の VM のままで実引数をリストにするか、 これもベクタにするか、 2 つのやりかたがありますが、 ここではスタックベース VM と合わせて実引数をベクタに作ることにします。 このとき、 スタックベース VM のようにスタックポインタを使っても良いのですが、 もう一つのやりかたとして引数も添字指定でベクタに書き込むように argument 命令を変更することにします。 さらに、 元のヒープベース VM では frame 命令で実引数リストを空にする動作と継続の作成の両方を兼ねていたのを、 要素数を指定して実引数ベクタを作成する命令に変更し、 新しく継続を作成する push 命令を追加することにします。

コンパイラは frame 命令と argument 命令を変更したことで、 call/cc とアプリケーションの部分が影響を受けて変わります。 他は「3imp ヒープベース compile/VM で階乗計算」と同じです。

なお、 今回は Gauche 依存で記述します。

( use srfi-1 ) ( use util.match ) ( use gauche.sequence ) ( define ( compile exp env next ) ( match exp (( ? symbol? var ) ( compile-lookup exp env ( lambda ( level loc ) `( refer , level , loc , next )))) ((' quote obj ) `( constant , obj , next )) ((' lambda vars . body ) ( let (( n ( length vars )) ( x ( compile-seq body ( compile-extend env vars ) '( return )))) ( if ( eq? ( car next ) ' apply ) `( extend , n , x ) `( close , n , x , next )))) ((' if test exp1 exp2 ) ( compile test env `( test ,( compile exp1 env next ) ,( compile exp2 env next )))) ((' set! var exp1 ) ( compile exp1 env ( compile-lookup var env ( lambda ( level loc ) `( assign , level , loc , next ))))) ((' call/cc exp1 ) ( compile-push `( frame 1 ( conti ( argument 0 ,( compile exp1 env '( apply ))))) next )) ((' begin ) `( constant #f , next )) ((' begin exp1 . _ ) ( compile-seq ( cdr exp ) env next )) (( fn . args ) ( compile-push `( frame ,( length args ) ,( fold-with-index ( lambda ( i arg x ) ( compile arg env `( argument , i , x ))) ( compile fn env '( apply )) args )) next )) ( _ `( constant , exp , next ))))

compile-seq、 compile-extend、 compile-lookup の 3 つは前と同じです。 compile-frame 手続きは compile-push へ名前を変えておきました。 これも内容は前と同じです。

( define ( compile-seq body env next ) ( if ( pair? body ) ( compile ( car body ) env ( compile-seq ( cdr body ) env next )) next )) ( define ( compile-extend env vars ) ( cons vars env )) ( define ( compile-lookup var env kont ) ( let loop-rib (( env env ) ( level 0 )) ( if ( pair? env ) ( let loop-frame (( vars ( car env )) ( loc 0 )) ( cond (( null? vars ) ( loop-rib ( cdr env ) ( + level 1 ))) (( eq? ( car vars ) var ) ( kont level loc )) ( else ( loop-frame ( cdr vars ) ( + loc 1 ))) )) ( error "HEAPBASED COMPILE -- VARIABLE NOT FOUND" var ) ))) ( define ( compile-push x next ) ( if ( eq? ( car next ) ' return ) x `( push , x , next ) ))

仮想マシンの実行時環境 e を入れ子のリストから入れ子のベクタへ変更します。 影響を受ける命令は、 変数参照 (refer)、 変数破壊 (assign)、 アプリケーション用の命令です。 プリミティブ摘要では、 今回は効率無視で vector->list でリストに作り直して apply しています。

( 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 ( vector-ref ( vector-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 ) ( vector-set! ( vector-ref e level ) loc a ) ( VM a x1 e r s )) ((' conti x1 ) ( VM `( 1 ( nuate , s 0 0 ) ()) x1 e r s )) ((' nuate s1 level loc ) ( VM ( vector-ref ( vector-ref e level ) loc ) '( return ) e r s1 )) ((' push x1 x2 ) ( VM a x1 e r ( list x2 e r s ))) ((' frame n1 x1 ) ( VM a x1 e ( make-vector n1 ) s )) ((' argument i x1 ) ( vector-set! r i a ) ( VM a x1 e 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 ( vector->list r )) x1 e1 r1 s1 )))))) ((' extend n1 x1 ) ( VM a x1 ( extend e n1 r ) '() s )) ((' return ) ( match s (( x1 e1 r1 s1 ) ( VM a x1 e1 r1 s1 ))))))

extend 手続きは、 クロージャの環境フィールドのベクタの前に実引数ベクタ・フレームを加えた新しいベクタを vector-append で作ります。

( define ( extend e n r ) ( if ( = n ( vector-length r )) ( vector-append ( vector r ) e ) ( error "HEAPBASED APPLY -- ARGUMENT?" n ( vector-lenth r )) ))

なお、 ここではベクタを使いましたが、 ヒープベースでディスプレイ・クロージャにするときは、 ゴミ集めをストップ & コピー等でおこない、 make-list とゴミ集めの copy を工夫することで、 リストのトップレベルを常に連続して配置させ、 リストをベクタのように利用するテクニックを採用する方がスマートだと思われます。