純粋関数型言語の処理系を作ってみることにした (その3 : Mark-1 G-machine)

puref

純粋関数型言語の処理系を作ってみることにした (その2)の続き。
今日は教科書の第3章P75-P94(Mark1: A MINIMAL G-MACHINE)の実装をしました。
現状では関数適用しかできません。遅延評価はまだ扱っていなくて、次回Mark2で扱うことになると思います。
ただ、現時点で普通のスタックマシンと大分違っているので出来る限りの説明を試みます。

http://github.com/nineties/puref/
minimal G-machineの主要なソースコード

type instruction =
    | ScI of string
    | NumI of int
    | MkappI
    | PushI of int
    | SlideI of int
    | UnwindI

type node =
    | NumN of int
    | AppN of node * node
    | ScN of int * instruction list

let sctable = Hashtbl.create 0

let arg = function
    | AppN(f,arg) -> arg
    | _ -> failwith "arg: not reachable"

let rec drop ls n = if n == 0 then ls else drop (List.tl ls) (n - 1)

let rec interpret seq stack =
    match (seq, stack) with
    | [], NumN n::_ -> n
    | ScI name::is, _ -> begin
        try
            let m = Hashtbl.find sctable name in
            interpret is (m::stack)
        with Not_found -> failwith ("undefined super combinator: " ^ name)
    end
    | NumI n::is, _ -> interpret is (NumN n::stack)
    | MkappI::is, a0::a1::ss -> interpret is (AppN(a0, a1)::ss)
    | PushI n::is, _ ->
            let app = List.nth stack (n + 1) in
            interpret is (arg app::stack)
    | SlideI n::is, a0::ss  -> interpret is (a0::drop ss n)
    | UnwindI::_, NumN n::_ -> n
    | UnwindI::_, AppN(f,arg)::_ -> interpret seq (f::stack)
    | UnwindI::is, ScN(n,sc_seq)::s -> interpret sc_seq stack
    | _ -> failwith "interpret: not reachable"

let register_sc (name,narg,seq) = Hashtbl.add sctable name (ScN(narg,seq))
let register_scs scs = ignore( List.map register_sc scs )
let run_main () = interpret [ScI "main"; UnwindI] []

抽象構文木からインストラクション列へのコンパイラ

open Syntax
open Gmachine

let argpos name args =
    let rec f i ls = match ls with
        | [] -> failwith ("unknown variable: " ^ name)
        | v::_ when name = v -> i
        | _ -> f (i+1) (List.tl ls)
    in f 0 args

let rec compileC base args = function
    | VarE name when List.mem name args -> [PushI (base + argpos name args)]
    | VarE name -> [ScI name]
    | NumE num -> [NumI num]
    | AppE(e1,e2) -> compileC base args e2 @ compileC (base + 1) args e1 @ [MkappI]
    | _ -> failwith "not implemented"

let compileR args body =
    compileC 0 args body @ [SlideI (List.length args + 1); UnwindI]

let compileSC (name,args,body) =
    (name, List.length args, compileR args body)

let f prog = List.map compileSC prog

まず具体例。

nineties% cat test.pf
main = K 1 2;
K x y = x
nineties% ./puref < test.pf
main = K 1 2;
K x y = x
=== main [0] ===
   1: Num 2
   2: Num 1
   3: SC K
   4: Mkapp
   5: Mkapp
   6: Slide 1
   7: Unwind
=== K [2] ===
   1: Push 0
   2: Slide 3
   3: Unwind
result: 1

出力は抽象構文木・インストラクション・結果(整数値)です。普通の仮想マシンでは見慣れない命令が並んでいますが、その挙動を図解で説明します。図の左側が命令列(左端が先頭)、右側がスタック(右端がスタックトップ)です。
G-machineとは項書き換えシステムの実現方法の一つで、Unwindという命令が書き換えを実行する命令です。
まず、一番最初にスタックに"main"という項を積みます(SC main)。次のUnwindで、命令列がmainに束縛された物へと置き換えられます。

次にmainを右辺であるK 1 2に書き換えます。
まず引数を右から順番に積んで、Mkappによって関数適用ノードを作っていきます(1〜3行目)。
カリー化されているので、K 1 2は((K 1) 2)と2回の関数適用になります。
次にSlide命令でmainを取り除きます(4行目)。
最後に、関数適用ノードを展開して書き換え完了です(5〜7行目)。

最後の時点でのスタックの状態は下図のようになっています。従って、スタックをi+1個戻ったとこのAppノードの二番目の子供がi番目の引数になります。

K 1 2はまだ書き換えられるので続きます。Push nはn番目の引数をスタックに積む命令です。
最終的にスタックトップは1となり、これ以上書き換えられないのでこれで実行が完了となります。

以上のように、関数適用ノードを組み立てた後にUnwindで書き換えができなくなるまで書き換えて行くという事を繰り返します。
Unwindの規則を簡単にまとめると、

  • スタックトップが定数 : 終了
  • スタックトップがスーパーコンビネータ : 命令列を置き換える
  • スタックトップが関数適用(f aの形) : スタックトップにfを積む

となります。

後の章でもっと効率の良い実装が出てくると思いますが、基本的な考え方は同じになると思います。