spice/lib/runtime/interp.ml

exception Runtime_error of string

module Op = struct
  let add v1 v2 =
    match v1, v2 with
    | Value.Int x, Value.Int y -> Value.Int (Int64.add x y)
    | _, _ -> raise (Runtime_error "cannot add non integer values")

  let sub v1 v2 =
    match v1, v2 with
    | Value.Int x, Value.Int y -> Value.Int (Int64.sub x y)
    | _, _ -> raise (Runtime_error "cannot sub non integer values")

  let mul v1 v2 =
    match v1, v2 with
    | Value.Int x, Value.Int y -> Value.Int (Int64.mul x y)
    | _, _ -> raise (Runtime_error "cannot mul non integer values")

  let is_true = function
    | Value.True -> true
    | _ -> false
end

type frame = {
  regs : Value.t array;
  mutable pc : Code.ins list;
}

let make_frame prog =
  {
    regs = Array.make (Code.frame_size prog) Value.Nil;
    pc = Code.instructions Code.(prog.entrypoint);
  }

let return_value fr = fr.regs.(0)

let eval fr = function
  | Code.Cst_nil -> Value.Nil
  | Code.Cst_true -> Value.Nil
  | Code.Cst_false -> Value.Nil
  | Code.Cst_int n -> Value.Int n
  | Code.Reg i -> fr.regs.(i)

let exec fr = function
  | Code.MOV (l, r) -> fr.regs.(l) <- eval fr r
  | Code.ADD (l, r) -> fr.regs.(l) <- Op.add fr.regs.(l) (eval fr r)
  | Code.SUB (l, r) -> fr.regs.(l) <- Op.add fr.regs.(l) (eval fr r)
  | Code.MUL (l, r) -> fr.regs.(l) <- Op.mul fr.regs.(l) (eval fr r)
  | Code.CON (l, vt) -> fr.regs.(l) <- Value.make_obj vt
  | Code.RET -> fr.pc <- []
  | Code.JMP l -> fr.pc <- Code.instructions l
  | Code.BRT (v, l1, l2) ->
      if Value.equal (eval fr v) True then fr.pc <- Code.instructions l1
      else fr.pc <- Code.instructions l2

let rec run fr =
  match fr.pc with
  | [] -> return_value fr
  | is :: rest ->
      fr.pc <- rest;
      exec fr is;
      run fr

let run_program pr = run (make_frame pr)