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

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

作业信息

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

作业内容描述：

  1. 完成汇编器(assembler)中的encode函数。
  2. 使用C/C++/Rust实现支持课程中使用的指令的虚拟机。
  3. 完整实现加入函数调用机制的语言的编译器(compiler)。
  4. 实现一个支持递归函数的解释器(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()
}

 

...全文
700 回复 打赏 收藏 举报
写回复
用AI写文章
回复
切换为时间正序
请发表友善的回复…
发表回复
Python 寄存器位域解析与 JSON 配置工具（芯片开发+寄存器/位域+解析源码+寄存器转储分析）
根据 JSON 指定位宽和字段起止位，解析寄存器数值并显示枚举含义。包含重叠字段、重复名称、位范围和输入数值检查。 适用于嵌入式软件开发人员、驱动开发入门者及相关技术学习者。资源包含源码或模板、使用说明及验证范围说明。Python 3.10+，仅使用标准库；寄存器宽度 1 至 64 位。 功能边界见 README.md，实际验证情况见 TESTING.md。
MATLAB实现的两级OPF与电动车充电调度，用于配电网络.zip
1.版本：matlab2014a/2019b/2024b 2.附赠案例数据可直接运行。 3.代码特点：参数化编程、参数可方便更改、代码编程思路清晰、注释明细。 4.适用对象：计算机，电子信息工程、数学等专业的大学生课程设计、期末大作业和毕业设计。
UAC白名单设置-软件使用
代码下载链接： https://pan.quark.cn/s/a4b39357ea24 用户账户控制(UAC)白名单的配置 Windows7环境中 UAC(User Account Control，用户帐户控制)是由微软在Windows Vista版本中推出的一项旨在增强系统安全性的创新技术，该技术强制要求用户在执行可能干扰计算机正常运作的操作或进行更改会波及其他用户设置的变动前，必须提供相应的权限或管理员密码进行验证。通过对这些操作启动前进行授权确认，UAC能够有效阻止恶意软件及间谍软件在未获授权的状态下于计算机内进行安装或实施修改。 自从Vista版本问世以来，微软便开始推行这一全新的安全机制，可视为对系统安全防护的显著提升。尽管UAC确实能够在一定程度上对某些非法程序起到防御作用，但与此同时，这一功能也给众多用户带来了诸多不便。 因此，许多用户开始探寻是否存在类似于白名单的功能，以便将那些值得信赖的程序直接赋予运行权限。事实上，这类功能确实存在，不过微软并未将其作为标准配置提供。 网络上关于此问题的绝大多数建议都是建议禁用UAC，这种说法显然缺乏针对性，因为若用户希望禁用此功能，本就不会提出相关疑问。 通过运用微软官方发布的Microsoft Application Compatibility Toolkit 5.6版本，可以将信任的程序纳入系统白名单范畴。 获取Application Compatibility Toolkit 安装程序成功后会出现三个可执行文件 以管理员身份启动Compatibility Administrator 在Custom DataBases部分创建新的数据库，并添加一个Application Fix（在下方空白处点击右键，选择...
DELL服务器操作系统安装
下载代码方式：https://pan.quark.cn/s/a4b39357ea24 DELL服务器的操作系统部署流程包含一系列细致的环节，其适用范围涵盖多种操作系统类型，例如Windows Server与Red Hat Linux等。在启动部署之前，必须确认服务器的光驱设备为DVD驱动器，并且需准备对应的系统安装媒介。下面将详细列出完整的部署步骤： 1. **启动准备**：将随服务器提供的Systems Management Tools and Documentation version 6.0光盘置入服务器光驱，随后设定服务器以光驱作为启动设备。此环节旨在确保服务器在启动阶段能够读取安装光盘内容。 2. **语言设定**：服务器启动后，选定简体中文作为部署语言，并确认接受许可协议条款。 3. **时区选择**：在部署期间，需设定时区为北京、香港、重庆或乌鲁木齐，依据实际地理位置进行适配选择。 4. **系统类型选择**：随后，需选定计划部署的操作系统，支持的版本包括Server 2003 SP2、Server 2003 SP2 64位版本、Windows 2003 SBS SP2、Server 2008、Windows 2008 SBS/EBS x64版本等，以及多种Red Hat和SUSE Linux版本。 5. **RAID设定**：若服务器出厂时已预设RAID配置，则可选择跳过此步骤。若需重新设定RAID，操作时需格外小心，因为这一过程可能引发硬盘数据遗失。 6. **引导分区规划**：设定引导分区的大小，通常C盘建议预留至少20GB的空间，具体容量需根据系统需求进行调整。 7. **网络设定**：网络设定可在系统部署完成后执行，部署期间建议暂时拔除...
老人自动接视频appp
老人自动接视频app的
raelidea

231

社区成员

35

社区内容

发帖
与我相关
我的任务
社区描述
日程：https://bbs.csdn.net/topics/608593392 主页：https://bobzhang.github.io/courses/ B站: “张宏波的基础软件课程”
rescript开发语言 个人社区 广东省·深圳市
社区管理员
  • raelidea
  • MoonBit月兔
  • 幻灰龙
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章