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 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) | 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 "}" 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 let vtable = { n_slots = 0; elems; mthds } in Obj (vtable, [||])