From 0460e6b646fe8d89f90e50520e222c8fad65d6db Mon Sep 17 00:00:00 2001 From: tali Date: Sat, 2 Dec 2023 15:31:29 -0500 Subject: [PATCH] refactor handling slot/method indices --- lib/runtime/code.ml | 1 - lib/runtime/interp.ml | 81 +++++++++++++++++++++---------------------- lib/runtime/value.ml | 21 ++++++++--- 3 files changed, 56 insertions(+), 47 deletions(-) diff --git a/lib/runtime/code.ml b/lib/runtime/code.ml index d104953..b9acf43 100644 --- a/lib/runtime/code.ml +++ b/lib/runtime/code.ml @@ -48,7 +48,6 @@ let add_ins bb is = bb.ins_list <- [] type program = { entrypoint : basic_block } - type Value.mthd += Method of program let make_program entrypoint = { entrypoint } diff --git a/lib/runtime/interp.ml b/lib/runtime/interp.ml index 1211727..cab2b87 100644 --- a/lib/runtime/interp.ml +++ b/lib/runtime/interp.ml @@ -1,20 +1,22 @@ exception Runtime_error of string +let runtime_error f = Fmt.kstr (fun s -> raise (Runtime_error s)) f + 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") + | _, _ -> 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") + | _, _ -> 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") + | _, _ -> runtime_error "cannot mul non integer values" let eql v1 v2 = match v1, v2 with @@ -24,12 +26,12 @@ module Op = struct let lst v1 v2 = match v1, v2 with | Value.Int x, Value.Int y -> Value.bool (Int64.compare x y < 0) - | _, _ -> raise (Runtime_error "cannot compare non integer values") + | _, _ -> runtime_error "cannot compare non integer values" let grt v1 v2 = match v1, v2 with | Value.Int x, Value.Int y -> Value.bool (Int64.compare x y > 0) - | _, _ -> raise (Runtime_error "cannot compare non integer values") + | _, _ -> runtime_error "cannot compare non integer values" let is_truthy = function | Value.False | Value.Nil -> false @@ -37,39 +39,35 @@ module Op = struct let not v = Value.bool (not (is_truthy v)) - let slt o nm = - match o with + let slt obj name = + match obj with | Value.Obj (vtable, _) -> ( - match Hashtbl.find vtable.elems nm with - | Value.Field i -> Value.int i - | Value.Method i -> Value.int (-succ i) - | exception Not_found -> raise (Runtime_error (Fmt.str "no method %S" nm))) - | _ -> raise (Runtime_error "get element of non-object") + try Value.of_elem (Hashtbl.find vtable.elems name) + with Not_found -> runtime_error "no such element %S" name) + | _ -> runtime_error "get element of non-object" - let get o s = - match o, s with - | Value.Obj (_, slots), Value.Int i -> - let i = Int64.to_int i in - if i < 0 then - failwith "Interp.Op.get: TODO: method reification" - else - slots.(i) - | _ -> raise (Runtime_error "get field of non-object") + let get obj el = + match obj, Value.to_elem el with + | Value.Obj (_, slots), Field i -> slots.(i) + | Value.Obj (_, _), Method _ -> failwith "Interp.Op.get: TODO: method reification" + | exception Invalid_argument _ -> runtime_error "invalid index" + | _ -> runtime_error "get field of non-object" - let set o s v = - match o, s with - | Value.Obj (_, slots), Value.Int i -> slots.(Int64.to_int i) <- v - | _ -> raise (Runtime_error "set field of non-object") + let set obj el v = + match obj, Value.to_elem el with + | Value.Obj (_, slots), Field i -> slots.(i) <- v + | Value.Obj (_, _), Method _ -> runtime_error "cannot reassign method" + | exception Invalid_argument _ -> runtime_error "invalid index" + | _ -> runtime_error "set field of non-object" - let mthd o s = - match o, s with - | Value.Obj (vtable, _), Value.Int i -> - let i = Int64.to_int i in - if i < 0 then - o, vtable.mthds.(-succ i) - else - failwith "Interp.Op.get: first class function calls" - | _ -> raise (Runtime_error "call method of non-object") + let mthd obj el = + match obj, Value.to_elem el with + | Value.Obj (vtable, _), Method i -> obj, vtable.mthds.(i) + | Value.Obj (_, _), Field _ -> failwith "Interp.Op.get: TODO: fcf calls" + | exception Invalid_argument _ -> runtime_error "invalid index" + | _ -> + (* TODO: create vtable from primitive types *) + runtime_error "call field of non-object" end type frame = { @@ -102,9 +100,9 @@ let rec exec fr = function | Code.GRT (l, r) -> fr.regs.(l) <- Op.grt fr.regs.(l) (eval fr r) | Code.NOT l -> fr.regs.(l) <- Op.not fr.regs.(l) | Code.CON (l, vt) -> fr.regs.(l) <- Value.make_obj vt - | Code.SLT (o, s, nm) -> fr.regs.(s) <- Op.slt fr.regs.(o) nm - | Code.GET (o, s) -> fr.regs.(s) <- Op.get fr.regs.(o) fr.regs.(s) - | Code.SET (o, s) -> Op.set fr.regs.(o) fr.regs.(s) fr.regs.(s + 1) + | Code.SLT (o, e, nm) -> fr.regs.(e) <- Op.slt fr.regs.(o) nm + | Code.GET (o, e) -> fr.regs.(e) <- Op.get fr.regs.(o) fr.regs.(e) + | Code.SET (o, e) -> Op.set fr.regs.(o) fr.regs.(e) fr.regs.(e + 1) | Code.RET -> fr.pc <- [] | Code.CLL (o, m, k) -> let self, mthd = Op.mthd fr.regs.(o) fr.regs.(m) in @@ -114,13 +112,12 @@ let rec exec fr = function | Code.CBR (v, l1, l2) -> fr.pc <- Code.instructions (if Op.is_truthy (eval fr v) then l1 else l2) -and call mthd self args = match mthd with +and call mthd self args = + match mthd with | Code.Method pr -> - if args <> [] then - failwith "Interp.call: TODO: method arguments"; + if args <> [] then failwith "Interp.call: TODO: method arguments"; run_program pr - | _ -> - Value.call mthd self args + | _ -> Value.call mthd self args and run fr = match fr.pc with diff --git a/lib/runtime/value.ml b/lib/runtime/value.ml index ce35f1e..5b2654e 100644 --- a/lib/runtime/value.ml +++ b/lib/runtime/value.ml @@ -21,12 +21,25 @@ type t = | Obj of vtable * t array let make_obj vtable = Obj (vtable, Array.make vtable.n_slots Nil) -let int n = Int (Int64.of_int n) let bool = function | true -> True | false -> False +let of_elem e = + let idx = + match e with + | Field i -> i + | Method i -> -succ i + in + Int (Int64.of_int idx) + +let to_elem = function + | Int idx -> + let i = Int64.to_int idx in + if i >= 0 then Field i else Method (-succ i) + | _ -> invalid_arg "to_elem: non integer value" + let rec pp ppf = function | Obj (vtable, slots) -> pp_obj ppf vtable slots | Int n -> Fmt.string ppf (Int64.to_string n) @@ -50,9 +63,9 @@ and pp_obj ppf vtable slots = vtable.elems; Fmt.pf ppf "}" -type mthd += - | Native_function of (t -> t list -> t) +type mthd += Native_function of (t -> t list -> t) -let call mthd self args = match mthd with +let call mthd self args = + match mthd with | Native_function f -> f self args | _ -> raise Not_found