[基础软件理论与实践] 第四节作业实现採石

採石 2023-01-25 19:35:49

作业信息

课程信息：https://bbs.csdn.net/topics/608593392
第四节作业提交帖：https://bbs.csdn.net/topics/609455877

作业内容描述：

完成汇编器(assembler)中的encode函数。
使用C/C++/Rust实现支持课程中使用的指令的虚拟机。
完整实现加入函数调用机制的语言的编译器(compiler)。
实现一个支持递归函数的解释器(interpreter)。

作业实现

又一次發揮優良傳統，借鑑課程程式碼。發現已實現，故一邊思考一邊參考。不過，還是在課程程式碼基礎了，做了若干思考，與課程程式碼有所區別。

一、變量改名背後的思考

type rec expr =
  | Cst(int)
  | Var(string)
  | Let(string, expr, expr)
  | Letfn(string, list<string>, expr, expr)
  | Invoke(string, list<expr>)
  | Prim(prim, list<expr>)
  | IfZero(expr, expr, expr)

module Flat = {
  type rec expr =
    | Cst(int)
    | Var(string)
    | Let(string, expr, expr)
    | Invoke(string, list<expr>)
    | Prim(prim, list<expr>)
    | IfZero(expr, expr, expr)
}

改App爲Invoke，私以爲Invoke語義爲調用。

改If爲IfZero，因課程中的if(test, so, else)的真實意圖是if((test==0), so, else)與真實的工業語言中的if不是同樣的語義，而IfZero更符合這種語義。

type instr =
  | Cst(int)
  | Add
  | Sub
  | Mul
  | Idx(int)
  | Pop
  | Swap
  | Lable(string)
  | Call(string, int)
  | Ret(int)
  | IfNotZero(string)
  | Goto(string)
  | Exit

改Var爲Idx，Idx是索引的語義，私以爲棧數據操作與抽象樹語義的概念還是有點不一樣。

改IfZero爲IfNotZero，當從expr的IfZero編譯至instrs時，要麼將so和else改變順序編譯成[[test]];IfZero(so);[[else]];Goto(end);;Lable(so)[[so]];Lable(end)，這是課程程式碼的做法；要麼改變expr的IfZero語義爲instrs的IfNotZero語義，即可編譯成[[test]];IfNotZero(else);[[so]];Goto(end);;Lable(else)[[else]];Lable(end)

二、爲Prim，增加Sub語義，即減法，在測試案例中的if語句中使用，可讀性更好。

let fn_fact_tail = (n, acc) => Letfn(
  "fact_tail",
  list{"n", "acc"},
  IfZero(
    Var("n"),
    Var("acc"),
    Prim(Self, list{Prim(Sub, list{Var("n"), Cst(1)}), Prim(Mul, list{Var("n"), Var("acc")})}),
  ),
  Invoke("fact_tail", list{n, acc}),
)

如上面碼中的Prim(Sub, list{Var("n"), Cst(1)})

那後面開始理一下程式邏輯吧。嗯，我在函式命名也下了一定的功夫，同時註釋裏主要內容是形式化公式。

編譯至匯編碼

函式簽名爲compile_to_instrs

1、抽取[main, f1, ..., fn]
1.1、提取全部成員函式
1.2、提取main主函式
2、Prog[[main, f1, ..., fn]] = Call(main, 0); Exit; Funs[[main, f1, ..., fn]]

2.1、Funs[[main, f1, ..., fn]] = Fun[[main]]; Fun[[f1]]; ...; Fun[[fn]]]]
2.1.1、Fun[[f]] = Lable(f); Expr[[e]]{pn,...,p1}; Ret(n)

2.1.1.1、Expr[[Cst(n)]]{s} = Cst(n)
2.1.1.2、Expr[[Var(x)]]{s} = Idx(vindex(x))
2.1.1.3、Expr[[Let(x, e1, e2)]]{s} = Expr[[e1]]{s}; Expr[[e2]]{x::s}; Swap; Pop
2.1.1.4、Expr[[Invoke(f, [v1, ..., vn])]]{s} = Args[v1, ..., vn]{s}; Call(f, n)
2.1.1.5、Expr[[Prim(prim, [v1, ..., vn])]]{s} = Args[v1, ..., vn]{s}; Prim
2.1.1.6、Expr[[IfZero(test, so, else)]]{s} = Expr[[test]]{s}; IfNotZero(else); Expr[[so]]{s}; Goto(end); Lable(else); Expr[[else]]{s}; Lable(end)

2.1.1.4.1、Args[v1, v2, ...] = Expr[[v1]]{s}; Expr[[v2]]{*::s}; ...
2.1.1.5.1、Args[v1, v2, ...] = Expr[[v1]]{s}; Expr[[v2]]{*::s}; ...

編譯至二進制

又一次，發生了作業跟課程代碼相似度極高，但在處理lable的時候，是不一樣的，主要邏輯在get_lable_position函式中。

  let get_lable_position = (lable_position_map, pending_callers_map, lable, caller_addr) => {
    let append_to_entry_value_by_key = (map, key, value) => {
      let old_value = map->HashMap.String.get(key)
      let new_value = switch old_value {
      | Some(old_value) => list{value, ...old_value}
      | None => list{value}
      }
      map->HashMap.String.set(key, new_value)
    }

    let lable_position = lable_position_map->HashMap.String.get(lable)
    switch lable_position {
    | Some(lable_position) => lable_position
    | None => {
        append_to_entry_value_by_key(pending_callers_map, lable, caller_addr)
        0
      }
    }
  }

實現了反編譯代碼，終於不一樣了

測試用例

code:
let a = 2 { let cube = [x] => { let square = [x] => x × x { square(x) × x } } { cube(a) } } -> 8

instrs:
[Call main 0, Exit,
Lable main, Cst(2), Idx(0), Call cube 1, Swap, Pop, Ret 0,
Lable cube, Idx(0), Call square 1, Idx(1), Mul, Ret 1,
Lable square, Idx(0), Idx(1), Mul, Ret 1]

bin:
[
7, 4, 0, 11, 0, 2, 4, 0, 7,
7, 1, 6, 5, 8, 0, 4, 0, 7,
8, 1, 4, 1, 3, 8, 1, 4, 0,
4, 1, 3, 8, 1
]

decode:
[Call __lable_4__ 0, Exit,
Lable __lable_4__, Cst(2), Idx(0), Call __lable_15__ 1, Swap, Pop, Ret 0,
Lable __lable_15__, Idx(0), Call __lable_25__ 1, Idx(1), Mul, Ret 1,
Lable __lable_25__, Idx(0), Idx(1), Mul, Ret 1]

bin_by_dex:
[
7, 4, 0, 11, 0, 2, 4, 0, 7,
7, 1, 6, 5, 8, 0, 4, 0, 7,
8, 1, 4, 1, 3, 8, 1, 4, 0,
4, 1, 3, 8, 1
]

code:
let fib = [n] => { if_zero n { 1 } else { { if_zero n - 1 { 1 } else { self(n - 1) + self(n - 2) } } } } { fib(7) } -> 21

instrs:
[Call main 0, Exit,
Lable main, Cst(7), Call fib 1, Ret 0,
Lable fib, Idx(0), IfNotZero __else1__, Cst(1), Goto __end1__,
Lable __else1__, Idx(0), Cst(1), Sub, IfNotZero __else2__, Cst(1), Goto __end2__,
Lable __else2__, Idx(0), Cst(1), Sub, Call fib 1, Idx(1), Cst(2), Sub, Call fib 1, Add,
Lable __end2__,
Lable __end1__, Ret 1]

bin:
[
7, 4, 0, 11, 0, 7, 7, 5, 1, 8, 0,
4, 0, 9, 6, 0, 1, 10, 30, 4, 0, 0,
1, 2, 9, 6, 0, 1, 10, 19, 4, 0, 0,
1, 2, 7, -24, 1, 4, 1, 0, 2, 2, 7,
-32, 1, 1, 8, 1
]

decode:
[Call __lable_4__ 0, Exit,
Lable __lable_4__, Cst(7), Call __lable_11__ 1, Ret 0,
Lable __lable_11__, Idx(0), IfNotZero __lable_19__, Cst(1), Goto __lable_47__,
Lable __lable_19__, Idx(0), Cst(1), Sub, IfNotZero __lable_30__, Cst(1), Goto __lable_47__,
Lable __lable_30__, Idx(0), Cst(1), Sub, Call __lable_11__ 1, Idx(1), Cst(2), Sub, Call __lable_11__ 1, Add,
Lable __lable_47__, Ret 1]

bin_by_dex:
[
7, 4, 0, 11, 0, 7, 7, 5, 1, 8, 0,
4, 0, 9, 6, 0, 1, 10, 30, 4, 0, 0,
1, 2, 9, 6, 0, 1, 10, 19, 4, 0, 0,
1, 2, 7, -24, 1, 4, 1, 0, 2, 2, 7,
-32, 1, 1, 8, 1
]

code:
let fact = [n] => { if_zero n { 1 } else { n × self(n - 1) } } { fact(5) } -> 120

instrs:
[Call main 0, Exit,
Lable main, Cst(5), Call fact 1, Ret 0,
Lable fact, Idx(0), IfNotZero __else1__, Cst(1), Goto __end1__,
Lable __else1__, Idx(0), Idx(1), Cst(1), Sub, Call fact 1, Mul,
Lable __end1__, Ret 1]

bin:
[
7, 4, 0, 11, 0, 5, 7, 5, 1,
8, 0, 4, 0, 9, 6, 0, 1, 10,
13, 4, 0, 4, 1, 0, 1, 2, 7,
-15, 1, 3, 8, 1
]

decode:
[Call __lable_4__ 0, Exit,
Lable __lable_4__, Cst(5), Call __lable_11__ 1, Ret 0,
Lable __lable_11__, Idx(0), IfNotZero __lable_19__, Cst(1), Goto __lable_30__,
Lable __lable_19__, Idx(0), Idx(1), Cst(1), Sub, Call __lable_11__ 1, Mul,
Lable __lable_30__, Ret 1]

bin_by_dex:
[
7, 4, 0, 11, 0, 5, 7, 5, 1,
8, 0, 4, 0, 9, 6, 0, 1, 10,
13, 4, 0, 4, 1, 0, 1, 2, 7,
-15, 1, 3, 8, 1
]

code:
let sum_a1_to_an = [n, step] => { if_zero n { 0 } else { n + self(n - step, step) } } { sum_a1_to_an(5, 1) } -> 15

instrs:
[Call main 0, Exit,
Lable main, Cst(5), Cst(1), Call sum_a1_to_an 2, Ret 0,
Lable sum_a1_to_an, Idx(1), IfNotZero __else1__, Cst(0), Goto __end1__,
Lable __else1__, Idx(1), Idx(2), Idx(2), Sub, Idx(2), Call sum_a1_to_an 2, Add,
Lable __end1__, Ret 2]

bin:
[
7, 4, 0, 11, 0, 5, 0, 1, 7,
5, 2, 8, 0, 4, 1, 9, 6, 0,
0, 10, 15, 4, 1, 4, 2, 4, 2,
2, 4, 2, 7, -17, 2, 1, 8, 2
]

decode:
[Call __lable_4__ 0, Exit,
Lable __lable_4__, Cst(5), Cst(1), Call __lable_13__ 2, Ret 0,
Lable __lable_13__, Idx(1), IfNotZero __lable_21__, Cst(0), Goto __lable_34__,
Lable __lable_21__, Idx(1), Idx(2), Idx(2), Sub, Idx(2), Call __lable_13__ 2, Add,
Lable __lable_34__, Ret 2]

bin_by_dex:
[
7, 4, 0, 11, 0, 5, 0, 1, 7,
5, 2, 8, 0, 4, 1, 9, 6, 0,
0, 10, 15, 4, 1, 4, 2, 4, 2,
2, 4, 2, 7, -17, 2, 1, 8, 2
]

code:
let sum_a1_to_an = [n, step] => { if_zero n { 0 } else { n + self(n - step, step) } } { sum_a1_to_an(12, 2) } -> 42

instrs:
[Call main 0, Exit,
Lable main, Cst(12), Cst(2), Call sum_a1_to_an 2, Ret 0,
Lable sum_a1_to_an, Idx(1), IfNotZero __else1__, Cst(0), Goto __end1__,
Lable __else1__, Idx(1), Idx(2), Idx(2), Sub, Idx(2), Call sum_a1_to_an 2, Add,
Lable __end1__, Ret 2]

bin:
[
7, 4, 0, 11, 0, 12, 0, 2, 7,
5, 2, 8, 0, 4, 1, 9, 6, 0,
0, 10, 15, 4, 1, 4, 2, 4, 2,
2, 4, 2, 7, -17, 2, 1, 8, 2
]

decode:
[Call __lable_4__ 0, Exit,
Lable __lable_4__, Cst(12), Cst(2), Call __lable_13__ 2, Ret 0,
Lable __lable_13__, Idx(1), IfNotZero __lable_21__, Cst(0), Goto __lable_34__,
Lable __lable_21__, Idx(1), Idx(2), Idx(2), Sub, Idx(2), Call __lable_13__ 2, Add,
Lable __lable_34__, Ret 2]

bin_by_dex:
[
7, 4, 0, 11, 0, 12, 0, 2, 7,
5, 2, 8, 0, 4, 1, 9, 6, 0,
0, 10, 15, 4, 1, 4, 2, 4, 2,
2, 4, 2, 7, -17, 2, 1, 8, 2
]

code:
let fact_tail = [n, acc] => { if_zero n { acc } else { self(n - 1, n × acc) } } { fact_tail(4, 2) } -> 48

instrs:
[Call main 0, Exit,
Lable main, Cst(4), Cst(2), Call fact_tail 2, Ret 0,
Lable fact_tail, Idx(1), IfNotZero __else1__, Idx(0), Goto __end1__,
Lable __else1__, Idx(1), Cst(1), Sub, Idx(2), Idx(2), Mul, Call fact_tail 2,
Lable __end1__, Ret 2]

bin:
[
7, 4, 0, 11, 0, 4, 0, 2, 7,
5, 2, 8, 0, 4, 1, 9, 6, 4,
0, 10, 15, 4, 1, 0, 1, 2, 4,
2, 4, 2, 3, 7, -18, 2, 8, 2
]

decode:
[Call __lable_4__ 0, Exit,
Lable __lable_4__, Cst(4), Cst(2), Call __lable_13__ 2, Ret 0,
Lable __lable_13__, Idx(1), IfNotZero __lable_21__, Idx(0), Goto __lable_34__,
Lable __lable_21__, Idx(1), Cst(1), Sub, Idx(2), Idx(2), Mul, Call __lable_13__ 2,
Lable __lable_34__, Ret 2]

bin_by_dex:
[
7, 4, 0, 11, 0, 4, 0, 2, 7,
5, 2, 8, 0, 4, 1, 9, 6, 4,
0, 10, 15, 4, 1, 0, 1, 2, 4,
2, 4, 2, 3, 7, -18, 2, 8, 2
]

具體程式碼

共三個文件：

Common.res

open Belt

let forceGet = Option.getExn
let roundString = str => "(" ++ str ++ ")"
let curlyString = str => "{" ++ str ++ "}"
let squareString = str => "[" ++ str ++ "]"
let assoc = (x, env) => env->List.getAssoc(x, (a, b) => a == b)

let someToString = (is_parent_function, some) =>
  if is_parent_function {
    some
  } else {
    ""
  }

let eagerBracket = (test, x) =>
  if test {
    roundString(" " ++ x ++ " ")
  } else {
    x
  }

let curlyBracket = (test, x) =>
  if test {
    curlyString(" " ++ x ++ " ")
  } else {
    x
  }

let listToStringWithoutSquare = (list, itemToString, delimiter) => {
  let t = list->List.reduce("", (acc, item) => {
    let str = itemToString(item)
    if Js.String.length(acc) == 0 {
      str
    } else {
      acc ++ delimiter ++ str
    }
  })
  t
}

let listToString = (list, itemToString, delimiter) =>
  squareString(listToStringWithoutSquare(list, itemToString, delimiter))

TinyCLike.res

open Belt
open Common

type prim = Add | Sub | Mul | Self

type rec expr =
  | Cst(int)
  | Var(string)
  | Let(string, expr, expr)
  | Letfn(string, list<string>, expr, expr)
  | Invoke(string, list<expr>)
  | Prim(prim, list<expr>)
  | IfZero(expr, expr, expr)

let toString = expr => {
  let rec go = (parent_prior, expr) =>
    switch expr {
    | Cst(n) =>
      if n < 0 {
        roundString(n->Int.toString)
      } else {
        n->Int.toString
      }
    | Var(x) => x
    | Let(x, e1, e2) =>
      curlyBracket(
        parent_prior > 0,
        "let " ++ x ++ " = " ++ go(1, e1) ++ " " ++ curlyBracket(true, go(0, e2)),
      )
    | Letfn(x, params, body, scope) =>
      curlyBracket(
        parent_prior > 0,
        "let " ++
        x ++
        " = " ++
        listToString(params, x => x, ", ") ++
        " => " ++
        go(1, body) ++
        " " ++
        curlyBracket(true, go(0, scope)),
      )
    | Invoke(x, exprs) => x ++ roundString(listToStringWithoutSquare(exprs, go(1), ", "))
    | Prim(prim, exprs) =>
      switch prim {
      | Add => eagerBracket(parent_prior > 1, listToStringWithoutSquare(exprs, go(1), " + "))
      | Sub => eagerBracket(parent_prior > 1, listToStringWithoutSquare(exprs, go(1), " - "))
      | Mul => eagerBracket(parent_prior > 2, listToStringWithoutSquare(exprs, go(2), " × "))
      | Self => "self" ++ roundString(listToStringWithoutSquare(exprs, go(1), ", "))
      }
    | IfZero(test, so_body, else_body) =>
      curlyBracket(
        true,
        "if_zero " ++
        go(0, test) ++
        " " ++
        curlyBracket(true, go(0, so_body)) ++
        " else " ++
        curlyBracket(true, go(0, else_body)),
      )
    }

  go(0, expr)
}

module Flat = {
  type rec expr =
    | Cst(int)
    | Var(string)
    | Let(string, expr, expr)
    | Invoke(string, list<expr>)
    | Prim(prim, list<expr>)
    | IfZero(expr, expr, expr)

  type fun = (string, list<string>, expr)
}

type var =
  | Param(string)
  | Local(string)
  | Temp

type venv = list<var>

// 編譯至匯編碼
let compile_to_instrs = (expr): TinyVM.instrs => {
  let main_func_and_its_funcs = expr => {
    let rec remove_funcs = (expr): Flat.expr =>
      switch expr {
      | Cst(n) => Cst(n)
      | Var(x) => Var(x)
      | Let(x, expr1, expr2) => Let(x, remove_funcs(expr1), remove_funcs(expr2))
      | Letfn(_, _, _, scope) => remove_funcs(scope)
      | Invoke(func_name, args) => Invoke(func_name, args->List.map(remove_funcs))
      | Prim(prim, exprs) => Prim(prim, exprs->List.map(remove_funcs))
      | IfZero(test, so_block, else_block) =>
        IfZero(remove_funcs(test), remove_funcs(so_block), remove_funcs(else_block))
      }

    let rec collect_funcs = expr =>
      switch expr {
      | Cst(_) | Var(_) => list{}
      | Let(_, expr1, expr2) => List.concat(collect_funcs(expr1), collect_funcs(expr2))
      | Letfn(func_name, args, body, scope) =>
        List.concatMany([
          list{(func_name, args, remove_funcs(body))},
          collect_funcs(body),
          collect_funcs(scope),
        ])
      | Invoke(_, exprs) | Prim(_, exprs) => exprs->List.map(collect_funcs)->List.flatten
      | IfZero(test, so_block, else_block) =>
        List.concatMany([collect_funcs(test), collect_funcs(so_block), collect_funcs(else_block)])
      }

    // 提取全部成員函式
    let its_funcs = collect_funcs(expr)
    // 提取main主函式
    let main_function = ("main", list{}, remove_funcs(expr))
    list{main_function, ...its_funcs}
  }

  let compile_funcs = funcs => {
    let lable_fresher = base_lable => {
      let counter = ref(0)
      () => {
        counter := counter.contents + 1
        "__" ++ base_lable ++ counter.contents->Int.toString ++ "__"
      }
    }
    let else_lable_fresher = lable_fresher("else")
    let end_lable_fresher = lable_fresher("end")

    // Fun[[f]] = Lable(f); Expr[[e]]{pn,...,p1}; Ret(n)
    let compile_func = fun => {
      let compile_func_body = (venv, func_body, func_name, func_arity) => {
        let rec compile_flat_expr = (venv, expr: Flat.expr): TinyVM.instrs => {
          let vindex = x => {
            let rec go = (venv, x, index) => {
              exception UnboundVariable(string)

              switch venv {
              | list{} => raise(UnboundVariable(x))
              | list{Param(k), ...rest} | list{Local(k), ...rest} =>
                if k == x {
                  index
                } else {
                  go(rest, x, index + 1)
                }
              | list{Temp, ...rest} => go(rest, x, index + 1)
              }
            }
            go(venv, x, 0)
          }

          // Args[v1, v2, ...] = Expr[[v1]]{s}; Expr[[v2]]{*::s}; ...
          // 其中*表示在編譯期環境頂部位置放入Temp
          let rec compile_args = (venv, args: list<Flat.expr>) => {
            switch args {
            | list{} => []
            | list{expr, ...rest} => {
                let compiled = compile_flat_expr(venv, expr)
                Array.concat(compiled, compile_args(list{Temp, ...venv}, rest))
              }
            }
          }

          let compile_prim = (prim, args): TinyVM.instrs => {
            let arity = args->List.length
            let verified_arity = switch prim {
            | Add | Sub | Mul => Some(2)
            | Self => None
            }
            if verified_arity == None || verified_arity->forceGet == arity {
              let op: TinyVM.instr = switch prim {
              | Add => Add
              | Sub => Sub
              | Mul => Mul
              | Self =>
                switch (func_name, func_arity) {
                | (Some(func_name), Some(func_arity)) => Call(func_name, func_arity)
                | _ => assert false
                }
              }
              Array.concat(compile_args(venv, args), [op])
            } else {
              assert false
            }
          }

          let compile_if_block = (test, so_block, else_block) => {
            let else_lable = else_lable_fresher()
            let end_lable = end_lable_fresher()
            Array.concatMany([
              compile_flat_expr(venv, test),
              [IfNotZero(else_lable)],
              compile_flat_expr(venv, so_block),
              [Goto(end_lable)],
              [Lable(else_lable)],
              compile_flat_expr(venv, else_block),
              [Lable(end_lable)],
            ])
          }

          switch expr {
          // Expr[[Cst(n)]]{s} = Cst(n)
          | Cst(n) => [Cst(n)]
          // Expr[[Var(x)]]{s} = Idx(vindex(x))
          | Var(x) => [Idx(vindex(x))]
          // Expr[[Let(x, e1, e2)]]{s} = Expr[[e1]]{s}; Expr[[e2]]{x::s}; Swap; Pop
          // 其中x表示在編譯期環境頂部位置放入Local(x)
          | Let(x, e1, e2) =>
            Array.concatMany([
              compile_flat_expr(venv, e1),
              compile_flat_expr(list{Local(x), ...venv}, e2),
              [Swap, Pop],
            ])
          // Expr[[Invoke(f, [v1, ..., vn])]]{s} = Args[v1, ..., vn]{s}; Call(f, n)
          | Invoke(fn_name, args) =>
            Array.concat(compile_args(venv, args), [Call(fn_name, args->List.length)])
          // Expr[[Prim(prim, [v1, ..., vn])]]{s} = Args[v1, ..., vn]{s}; Prim
          | Prim(prim, args) => compile_prim(prim, args)
          // Expr[[IfZero(test, so, else)]]{s} = Expr[[test]]{s}; IfNotZero(else); Expr[[so]]{s};
          //   Goto(end); Lable(else); Expr[[else]]{s}; Lable(end)
          | IfZero(test, so_block, else_block) => compile_if_block(test, so_block, else_block)
          }
        }

        compile_flat_expr(venv, func_body)
      }

      let (func_name, args, body) = fun
      let arity = args->List.length
      let body_instrs = compile_func_body(
        args->List.map(x => Param(x))->List.reverse,
        body,
        Some(func_name),
        Some(arity),
      )
      Array.concatMany([[TinyVM.Lable(func_name)], body_instrs, [Ret(arity)]])
    }

    // Funs[[main, f1, ..., fn]] = Fun[[main]]; Fun[[f1]]; ...; Fun[[fn]]]]
    Array.concatMany(funcs->List.map(compile_func)->List.toArray)
  }

  // 抽取[main, f1, ..., fn]
  let funcs = main_func_and_its_funcs(expr)
  // Prog[[main, f1, ..., fn]] = Call(main, 0); Exit; Funs[[main, f1, ..., fn]]
  Array.concat([TinyVM.Call("main", 0), Exit], compile_funcs(funcs))
}

type case = {
  accept: expr,
  expect: int,
}

let fn_cube = e => Letfn(
  "cube",
  list{"x"},
  Letfn(
    "square",
    list{"x"},
    Prim(Mul, list{Var("x"), Var("x")}),
    Prim(Mul, list{Invoke("square", list{Var("x")}), Var("x")}),
  ),
  Invoke("cube", list{e}),
)

let fn_fib = e => Letfn(
  "fib",
  list{"n"},
  IfZero(
    Var("n"),
    Cst(1),
    IfZero(
      Prim(Sub, list{Var("n"), Cst(1)}),
      Cst(1),
      Prim(
        Add,
        list{
          Prim(Self, list{Prim(Sub, list{Var("n"), Cst(1)})}),
          Prim(Self, list{Prim(Sub, list{Var("n"), Cst(2)})}),
        },
      ),
    ),
  ),
  Invoke("fib", list{e}),
)

let fn_fact = e => Letfn(
  "fact",
  list{"n"},
  IfZero(
    Var("n"),
    Cst(1),
    Prim(Mul, list{Var("n"), Prim(Self, list{Prim(Sub, list{Var("n"), Cst(1)})})}),
  ),
  Invoke("fact", list{e}),
)

let fn_fact_tail = (n, acc) => Letfn(
  "fact_tail",
  list{"n", "acc"},
  IfZero(
    Var("n"),
    Var("acc"),
    Prim(Self, list{Prim(Sub, list{Var("n"), Cst(1)}), Prim(Mul, list{Var("n"), Var("acc")})}),
  ),
  Invoke("fact_tail", list{n, acc}),
)

let fn_sum_a1_to_an = (n, step) => Letfn(
  "sum_a1_to_an",
  list{"n", "step"},
  IfZero(
    Var("n"),
    Cst(0),
    Prim(
      Add,
      list{Var("n"), Prim(Self, list{Prim(Sub, list{Var("n"), Var("step")}), Var("step")})},
    ),
  ),
  Invoke("sum_a1_to_an", list{n, step}),
)

let cases = [
  {
    accept: Let("a", Cst(2), fn_cube(Var("a"))),
    expect: 8,
  },
  {
    accept: fn_fib(Cst(7)),
    expect: 21,
  },
  {
    accept: fn_fact(Cst(5)),
    expect: 120,
  },
  {
    accept: fn_sum_a1_to_an(Cst(5), Cst(1)),
    expect: 15,
  },
  {
    accept: fn_sum_a1_to_an(Cst(12), Cst(2)),
    expect: 42,
  },
  {
    accept: fn_fact_tail(Cst(4), Cst(2)),
    expect: 48,
  },
]

let vm = TinyVM.create(40)

let testSuit = cases => {
  cases->Array.forEach(case => {
    let {accept, expect} = case
    let expectStr = expect->Int.toString
    Js.log("code:")
    Js.log(toString(accept) ++ " -> " ++ expectStr)
    let instrs = compile_to_instrs(accept)
    Js.log("")
    Js.log("instrs:")
    Js.log(TinyVM.toString(instrs))
    let ret_by_asm = TinyVM.run_asm(vm, instrs)
    assert (ret_by_asm == expect)
    let bin = TinyVM.encode_instrs(instrs, instrs->Array.length * 2)
    Js.log("")
    Js.log("bin:")
    Js.log(bin)
    let ret_by_bin = TinyVM.run_bin(vm, bin)
    assert (ret_by_bin == expect)
    let dex_instrs = TinyVM.decode_bin(bin)
    Js.log("")
    Js.log("decode:")
    Js.log(TinyVM.toString(dex_instrs))
    let ret_by_dex = TinyVM.run_asm(vm, dex_instrs)
    assert (ret_by_dex == expect)
    let bin_by_dex = TinyVM.encode_instrs(dex_instrs, dex_instrs->Array.length * 2)
    Js.log("")
    Js.log("bin_by_dex:")
    Js.log(bin_by_dex)
    Js.log("")
    Js.log("")
  })
}

testSuit(cases)

TinyVM.res

open Belt
open Common

type instr =
  | Cst(int)
  | Add
  | Sub
  | Mul
  | Idx(int)
  | Pop
  | Swap
  | Lable(string)
  | Call(string, int)
  | Ret(int)
  | IfNotZero(string)
  | Goto(string)
  | Exit

type instrs = array<instr>
type bin = array<int>

let toString = instrs => {
  let item_to_string = instr =>
    switch instr {
    | Cst(n) => "Cst" ++ roundString(n->Int.toString)
    | Add => "Add"
    | Sub => "Sub"
    | Mul => "Mul"
    | Idx(n) => "Idx" ++ roundString(n->Int.toString)
    | Pop => "Pop"
    | Swap => "Swap"
    | Lable(x) => "\nLable " ++ x
    | Call(x, n) => "Call " ++ x ++ " " ++ n->Int.toString
    | Ret(n) => "Ret " ++ n->Int.toString
    | IfNotZero(x) => "IfNotZero " ++ x
    | Goto(x) => "Goto " ++ x
    | Exit => "Exit"
    }

  listToString(instrs->List.fromArray, item_to_string, ", ")
}

let verify_instrs = instrs => {
  let verify_instr = (index, instr) => {
    switch index {
    | 0 =>
      switch instr {
      | Add => assert false
      | Sub => assert false
      | Mul => assert false
      | Idx(_) => assert false
      | Pop => assert false
      | Swap => assert false
      | Lable(_) => assert false
      | Ret(_) => assert false
      | _ => ()
      }
    | 1 =>
      switch instr {
      | Add => assert false
      | Sub => assert false
      | Mul => assert false
      | Swap => assert false
      | Ret(_) => assert false
      | _ => ()
      }
    | 2 =>
      switch instr {
      | Ret(_) => assert false
      | _ => ()
      }
    | _ => ()
    }
  }

  let length = instrs->Array.length
  if length == 0 {
    assert false
  } else {
    ()
  }
  // 指令流在索引零和二之間的部分合法性檢測
  for n in 0 to 2 {
    if n < length {
      let instr = instrs->Array.getExn(n)
      verify_instr(n, instr)
    } else {
      ()
    }
  }
}

let op_code = instr =>
  switch instr {
  | Cst(_) => 0
  | Add => 1
  | Sub => 2
  | Mul => 3
  | Idx(_) => 4
  | Pop => 5
  | Swap => 6
  | Lable(_) => assert false // 僞指令，故不應當有對應的op_code
  | Call(_, _) => 7
  | Ret(_) => 8
  | IfNotZero(_) => 9
  | Goto(_) => 10
  | Exit => 11
  }

let length_of_op_code = op_code =>
  switch op_code {
  | 1 | 2 | 3 | 5 | 6 | 11 => 1
  | 0 | 4 | 8 | 9 | 10 => 2
  | 7 => 3
  | _ => assert false
  }

let encode_instrs = (instrs, possible_code_size): bin => {
  let append_codes = (code_segment, cursor, codes) => {
    Array.blit(
      ~srcOffset=0,
      ~dst=code_segment,
      ~len=codes->Array.length,
      ~dstOffset=cursor,
      ~src=codes,
    )
  }

  let get_lable_position = (lable_position_map, pending_callers_map, lable, caller_addr) => {
    let append_to_entry_value_by_key = (map, key, value) => {
      let old_value = map->HashMap.String.get(key)
      let new_value = switch old_value {
      | Some(old_value) => list{value, ...old_value}
      | None => list{value}
      }
      map->HashMap.String.set(key, new_value)
    }

    let lable_position = lable_position_map->HashMap.String.get(lable)
    switch lable_position {
    | Some(lable_position) => lable_position
    | None => {
        append_to_entry_value_by_key(pending_callers_map, lable, caller_addr)
        0
      }
    }
  }

  verify_instrs(instrs)
  let instrs_length = instrs->Array.length
  let code_segment = Array.make(possible_code_size, 0)
  let pending_callers_map = HashMap.String.make(~hintSize=10)
  let lable_position_map = HashMap.String.make(~hintSize=10)
  let poisition = ref(0)
  for n in 0 to instrs_length - 1 {
    let instr = instrs->Array.getExn(n)
    switch instr {
    | Cst(n) | Idx(n) | Ret(n) =>
      let cursor = poisition.contents
      let codes = [op_code(instr), n]
      append_codes(code_segment, cursor, codes)
      poisition := cursor + codes->Array.length

    | Add | Sub | Mul | Pop | Swap | Exit =>
      let cursor = poisition.contents
      let codes = [op_code(instr)]
      append_codes(code_segment, cursor, codes)
      poisition := cursor + codes->Array.length

    | Lable(lable) =>
      let cursor = poisition.contents
      lable_position_map->HashMap.String.set(lable, cursor)
      let pending_callers = pending_callers_map->HashMap.String.get(lable)
      switch pending_callers {
      | Some(pending_callers) =>
        pending_callers->List.forEach(caller_addr =>
          code_segment->Array.set(caller_addr + 1, cursor - caller_addr)
        )
      | None => ()
      }

    | Call(lable, n) =>
      let cursor = poisition.contents
      let callee_addr = get_lable_position(lable_position_map, pending_callers_map, lable, cursor)
      let codes = [op_code(instr), callee_addr - cursor, n]
      append_codes(code_segment, cursor, codes)
      poisition := cursor + codes->Array.length

    | IfNotZero(lable) | Goto(lable) =>
      let cursor = poisition.contents
      let callee_addr = get_lable_position(lable_position_map, pending_callers_map, lable, cursor)
      let codes = [op_code(instr), callee_addr - cursor]
      append_codes(code_segment, cursor, codes)
      poisition := cursor + codes->Array.length
    }
    exception CodeSizeOverflow
    if poisition.contents >= possible_code_size {
      raise(CodeSizeOverflow)
    } else {
      ()
    }
  }
  code_segment->Array.slice(~offset=0, ~len=poisition.contents)
}

let decode_bin = bin => {
  let record_lable_position = (): array<int> => {
    let lable_positions = HashSet.Int.make(~hintSize=10)
    let continue = ref(true)
    let position = ref(0)
    let length = bin->Array.length
    while continue.contents {
      let cursor = position.contents
      let op_code = bin->Array.getExn(cursor)
      let new_position = switch op_code {
      | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 8 | 11 => cursor + length_of_op_code(op_code)
      | 7 | 9 | 10 =>
        let addr_pos = cursor + 1
        let offset = bin->Array.getExn(addr_pos)
        let label_position = cursor + offset
        bin->Array.setExn(addr_pos, label_position)
        lable_positions->HashSet.Int.add(label_position)
        cursor + length_of_op_code(op_code)

      | _ => assert false
      }

      continue := new_position < length
      position := new_position
    }

    let t = lable_positions->HashSet.Int.toArray
    t->SortArray.Int.stableSortInPlace
    t
  }

  let naming_label_position = lable_position => "__lable_" ++ lable_position->Int.toString ++ "__"

  let lable_positions = record_lable_position()
  let instrs = ref(MutableQueue.make())
  let lable_index = ref(0)
  let lable_positions_length = lable_positions->Array.length
  let position = ref(0)
  let bin_length = bin->Array.length
  let continue = ref(true)

  while continue.contents {
    let t = instrs.contents
    let lable_cursor = lable_index.contents
    let lable_position = if lable_cursor < lable_positions_length {
      lable_positions[lable_cursor]
    } else {
      None
    }
    let cursor = position.contents
    switch lable_position {
    | Some(lable_position) =>
      if cursor == lable_position {
        t->MutableQueue.add(Lable(naming_label_position(lable_position)))
        lable_index := lable_cursor + 1
      } else {
        ()
      }

    | None => ()
    }
    let op_code = bin->Array.getExn(cursor)
    switch op_code {
    | 0 => {
        // Cst(n)
        let n = bin->Array.getExn(cursor + 1)
        t->MutableQueue.add(Cst(n))
      }

    | 1 =>
      // Add
      t->MutableQueue.add(Add)

    | 2 =>
      // Sub
      t->MutableQueue.add(Sub)

    | 3 =>
      // Mul
      t->MutableQueue.add(Mul)

    | 4 => {
        // Idx(n)
        let n = bin->Array.getExn(cursor + 1)
        t->MutableQueue.add(Idx(n))
      }

    | 5 =>
      // Pop
      t->MutableQueue.add(Pop)

    | 6 =>
      // Swap
      t->MutableQueue.add(Swap)

    | 7 => {
        // Call(label_position, n)
        let lable_position = bin->Array.getExn(cursor + 1)
        let n = bin->Array.getExn(cursor + 2)
        t->MutableQueue.add(Call(naming_label_position(lable_position), n))
      }

    | 8 => {
        // Ret(n)
        let n = bin->Array.getExn(cursor + 1)
        t->MutableQueue.add(Ret(n))
      }

    | 9 => {
        // IfNotZero(lable_position)
        let lable_position = bin->Array.getExn(cursor + 1)
        t->MutableQueue.add(IfNotZero(naming_label_position(lable_position)))
      }

    | 10 => {
        // Goto(lable_position)
        let lable_position = bin->Array.getExn(cursor + 1)
        t->MutableQueue.add(Goto(naming_label_position(lable_position)))
      }

    | 11 =>
      // Exit
      t->MutableQueue.add(Exit)

    | _ => assert false
    }

    let new_position = cursor + length_of_op_code(op_code)
    continue := new_position < bin_length
    position := new_position
  }
  instrs.contents->MutableQueue.toArray
}

type vm = {
  stack: array<int>,
  mutable pc: int,
  mutable sp: int,
}

let create = max_stack_size => {
  stack: Array.make(max_stack_size, 0),
  pc: 0,
  sp: 0,
}

let initVm = vm => {
  vm.pc = 0
  vm.sp = 0
}

let push = (vm, v) => {
  exception StackOverFlow

  if vm.sp >= vm.stack->Array.length {
    raise(StackOverFlow)
  }
  let _ = vm.stack->Array.set(vm.sp, v)
  vm.sp = vm.sp + 1
}

let pop = (vm, ()) => {
  vm.sp = vm.sp - 1
  vm.stack->Array.getExn(vm.sp)
}

let run_asm = (vm, instrs) => {
  let get_lable_pc = lable => {
    let lable_pc = instrs->Array.getIndexBy(instr => instr == Lable(lable))
    lable_pc->forceGet
  }

  let push = push(vm)
  let pop = pop(vm)

  verify_instrs(instrs)
  initVm(vm)
  let continue = ref(true)
  let next_pc = ref(0)
  while continue.contents {
    let instr = instrs->Array.getExn(vm.pc)
    next_pc := vm.pc + 1
    switch instr {
    | Cst(n) => push(n)
    | Add =>
      let n = pop()
      let m = pop()
      push(m + n)

    | Sub =>
      let n = pop()
      let m = pop()
      push(m - n)

    | Mul =>
      let n = pop()
      let m = pop()
      push(m * n)

    | Idx(n) =>
      let v = vm.stack->Array.getExn(vm.sp - n - 1)
      push(v)

    | Pop =>
      let _ = pop()

    | Swap =>
      let n = pop()
      let m = pop()
      let _ = push(n)
      let _ = push(m)

    | Lable(_) => ()
    | Call(lable, n) =>
      let rec pop_n_times = n =>
        switch n {
        | 0 => list{}
        | _ =>
          let v = pop()
          List.concat(pop_n_times(n - 1), list{v})
        }

      let nv = pop_n_times(n)
      push(next_pc.contents)
      nv->List.forEach(v => push(v))
      next_pc := get_lable_pc(lable)

    | Ret(n) =>
      let rec pop_n_times = n =>
        switch n {
        | 0 => ()
        | _ =>
          let _ = pop()
          pop_n_times(n - 1)
        }

      let ret = pop()
      pop_n_times(n)
      next_pc := pop()
      push(ret)

    | IfNotZero(lable) =>
      let test = pop()
      if test != 0 {
        next_pc := get_lable_pc(lable)
      } else {
        ()
      }

    | Goto(lable) => next_pc := get_lable_pc(lable)
    | Exit => continue := false
    }
    vm.pc = next_pc.contents
  }
  pop()
}

let run_bin = (vm, bin: bin) => {
  let push = push(vm)
  let pop = pop(vm)

  initVm(vm)
  let continue = ref(true)
  while continue.contents {
    let op_code = bin->Array.getExn(vm.pc)
    switch op_code {
    | 0 =>
      // Cst(n)
      let n = bin->Array.getExn(vm.pc + 1)
      push(n)
      vm.pc = vm.pc + length_of_op_code(op_code)

    | 1 =>
      // Add
      let n = pop()
      let m = pop()
      push(m + n)
      vm.pc = vm.pc + length_of_op_code(op_code)

    | 2 =>
      // Sub
      let n = pop()
      let m = pop()
      push(m - n)
      vm.pc = vm.pc + length_of_op_code(op_code)

    | 3 =>
      // Mul
      let n = pop()
      let m = pop()
      push(m * n)
      vm.pc = vm.pc + length_of_op_code(op_code)

    | 4 =>
      // Idx(n)
      let n = bin->Array.getExn(vm.pc + 1)
      let v = vm.stack->Array.getExn(vm.sp - n - 1)
      push(v)
      vm.pc = vm.pc + length_of_op_code(op_code)

    | 5 =>
      // Pop
      let _ = pop()
      vm.pc = vm.pc + length_of_op_code(op_code)

    | 6 =>
      // Swap
      let n = pop()
      let m = pop()
      let _ = push(n)
      let _ = push(m)
      vm.pc = vm.pc + length_of_op_code(op_code)

    | 7 =>
      // Call(offset, n)
      let rec pop_n_times = n =>
        switch n {
        | 0 => list{}
        | _ =>
          let v = pop()
          List.concat(pop_n_times(n - 1), list{v})
        }

      let n = bin->Array.getExn(vm.pc + 2)
      let nv = pop_n_times(n)
      push(vm.pc + 3)
      nv->List.forEach(v => push(v))
      vm.pc = vm.pc + bin->Array.getExn(vm.pc + 1)

    | 8 =>
      // Ret(n)
      let rec pop_n_times = n =>
        switch n {
        | 0 => ()
        | _ =>
          let _ = pop()
          pop_n_times(n - 1)
        }

      let n = bin->Array.getExn(vm.pc + 1)
      let ret = pop()
      pop_n_times(n)
      let next_pc = pop()
      push(ret)
      vm.pc = next_pc

    | 9 =>
      // IfNotZero(offset)
      let offset = bin->Array.getExn(vm.pc + 1)
      let test = pop()
      if test != 0 {
        vm.pc = vm.pc + offset
      } else {
        vm.pc = vm.pc + length_of_op_code(op_code)
      }

    | 10 =>
      // Goto(offset)
      let offset = bin->Array.getExn(vm.pc + 1)
      vm.pc = vm.pc + offset

    | 11 => continue := false
    | _ => assert false
    }
  }
  pop()
}

...全文