type slotidx = int type mthdidx = int type vtable = { n_slots : int; elems : (string, elem) Hashtbl.t; mthds : mthd array; } and elem = | Field of slotidx | Method of mthdidx and mthd = .. type t = | Nil | True | False | Int of int64 | Obj of vtable * t array let make_obj vtable = Obj (vtable, Array.make vtable.n_slots Nil) let of_int n = Int (Int64.of_int n) let of_bool = function | true -> True | false -> False let truthy = function | False | Nil -> false | _ -> true let equal v1 v2 = match v1, v2 with | Int x, Int y -> Int64.equal x y | _, _ -> v1 == v2 (* TODO (?): move some Obj helpers from Interp.Prim to here *) let of_elem e = let idx = match e with | Field i -> i | Method i -> -succ i in 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" type mthd += Native_function of (t list -> t) let call mthd _self args = match mthd with | Native_function f -> f args | _ -> raise Not_found let native_lib fns = let elems = Hashtbl.create (List.length fns * 4) in List.iteri (fun i (name, _) -> Hashtbl.add elems name (Method i)) fns; let mthds = List.map (fun (_, f) -> Native_function f) fns |> Array.of_list in make_obj { n_slots = 0; elems; mthds } let rec pp ppf = function | Obj (vtable, slots) -> pp_obj ppf vtable slots | Int n -> Fmt.string ppf (Int64.to_string n) | v -> Fmt.pf ppf "%S" (to_string v) and to_string = function | Nil -> "nil" | True -> "true" | False -> "false" | v -> Fmt.str "%a" pp v and pp_obj ppf vtable slots = Fmt.pf ppf "{"; let sep = ref "" in Hashtbl.iter (fun name -> function | Method _ -> () | Field idx -> Fmt.pf ppf "%s%S:%a" !sep name pp slots.(idx); sep := ",") vtable.elems; Fmt.pf ppf "}"