100 lines
1.9 KiB
OCaml
100 lines
1.9 KiB
OCaml
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 "}"
|