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.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)