spice/lib/runtime/value.ml

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, [||])